Vfrdtyky

I have working code that calculates a running drawdown.duration where drawdown.duration is defined as the number of months between the current month and the previous peak. I implemented the code, however, as a for loop and it runs quite slow.

Is there a more efficient/faster way to implement this in R?

The code takes a data.frame (specifically a tibble since I have been working with dplyr) named returnsWithValues.

> structure(list(date = structure(c(789, 820, 850, 881, 911, 942

), class = "Date"), value = c(0.94031052, 0.930751624153046, 

0.926756311376762, 0.874209664097166, 0.843026010916249, 2.1), 

    peak = c(1, 1, 1, 1, 1, 2.1), drawdown = c(-0.05968948, -0.0692483758469535, 

    -0.0732436886232377, -0.125790335902834, -0.156973989083751, 

    0)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 

-6L))

# A tibble: 6 x 4

  date       value  peak drawdown

  <date>     <dbl> <dbl>    <dbl>

1 1972-02-29 0.940   1    -0.0597

2 1972-03-31 0.931   1    -0.0692

3 1972-04-30 0.927   1    -0.0732

4 1972-05-31 0.874   1    -0.126 

5 1972-06-30 0.843   1    -0.157 

6 1972-07-31 2.1     2.1   0   

I have implemented drawdown.duration using a for loop:

returnsWithValues <- returnsWithValues %>% mutate(drawdown.duration = NA)



    # add drawdown.duration col

    for (row in 1:nrow(returnsWithValues)) {

        if(returnsWithValues[row,"value"] == returnsWithValues[row,"peak"]) {

            returnsWithValues[row,"drawdown.duration"] = 0

        } else {

            if(row == 1){

                returnsWithValues[row,"drawdown.duration"] = 1

            } else {

                returnsWithValues[row,"drawdown.duration"] = returnsWithValues[row - 1,"drawdown.duration"] + 1

            }

        }

    }

Which gives the correct answer as:

> returnsWithValues

# A tibble: 6 x 5

  date       value  peak drawdown drawdown.duration

  <date>     <dbl> <dbl>    <dbl>             <dbl>

1 1972-02-29 0.940   1    -0.0597                 1

2 1972-03-31 0.931   1    -0.0692                 2

3 1972-04-30 0.927   1    -0.0732                 3

4 1972-05-31 0.874   1    -0.126                  4

5 1972-06-30 0.843   1    -0.157                  5

6 1972-07-31 2.1     2.1   0                      0

I think this will do it, as long as each peak value is unique and not repeated in another group later on:

returnsWithValues %>%

    group_by(peak) %>%

    mutate(drawdown.duration = cumsum(value != peak))

If you do have repeated peak values, you might need a way to group just within consecutive peak values, e.g.

returns %>%

    # Start counting the number of groups at 1, and every time

    #   peak changes compared to the previous row, add 1

    mutate(peak_group = cumsum(c(1, peak[-1] != head(peak, -1)))) %>%

    group_by(peak_group) %>%

    mutate(drawdown.duration = cumsum(value != peak))

I will remove the for loop as you want and I will use the idea of indexing.

indices <- function(returnsWithValues){

    indices_logical<-(returnsWithValues[["value"]] == returnsWithValues[["peak"]]) #return a logical vector where true values are for equal and false for not.

    indices_to_zero<-which(indices_logical) # which values are true

    indices_drawdpwn<-which(!indices_logical) # which values are false

    returnsWithValues[indices_to_zero,"drawdown.duration"] <- 0

    returnsWithValues[indices_drawdpwn,"drawdown.duration"] <- 1:length(indices_drawdpwn) #basically you compute this if I understand correctly

    returnsWithValues

Here is you for loop wrapped in a function.

for_loop<-function(returnsWithValues){

    # add drawdown.duration col

    for (row in 1:nrow(returnsWithValues)) {

        if(returnsWithValues[row,"value"] == returnsWithValues[row,"peak"]) {

            returnsWithValues[row,"drawdown.duration"] = 0

        } else {

            if(row == 1){

                returnsWithValues[row,"drawdown.duration"] = 1

            } else {

                returnsWithValues[row,"drawdown.duration"] = returnsWithValues[row - 1,"drawdown.duration"] + 1

            }

        }

    }

    returnsWithValues

}

Here is a benchmark compared to your for loop.

microbenchmark::microbenchmark(

      "for loop" = flp<-for_loop(returnsWithValues),

      indices = ind<-indices(returnsWithValues),

      times = 10

)



Unit: microseconds

        expr      min       lq     mean    median       uq      max neval

    for loop 8671.228 8699.555 8857.198 8826.8185 8967.631 9196.708    10

     indices   92.781   99.349  106.328  102.8385  115.360  122.749    10

all.equal(ind,flp)

[1] TRUE