简体   繁体   中英

Highest value since - finding the interval in R

I'm working right now at Forex project and I found a problem on my way. I'm trying to find when was the last time when current value was this high or this low.

At the beginning I was trying to do that this way:

length(c(1:10)) - max(which(c(1:10) <= 6))

ie if we consider vector c(1:10,6) the output of the function above would be 4. Which would mean that 6 is the highest value since 4 intervals.

So my goal now was to implement above function into dplyr::mutate method. That's where things got out of hand... With the runner function from runner package I was able to create tibble with values and their lags:

# A tibble: 11 x 2
   value `runner(value, lag = 1)`
   <dbl> <list>                  
 1     9 <dbl [0]>               
 2     7 <dbl [1]>               
 3     4 <dbl [2]>               
 4     1 <dbl [3]>               
 5     5 <dbl [4]>               
 6     2 <dbl [5]>               
 7     5 <dbl [6]>               
 8     4 <dbl [7]>               
 9     1 <dbl [8]>               
10     6 <dbl [9]>               
11     6 <dbl [10]>  

But then no matter what I have tried I can't relate value number at current list to a runner column. I was trying things like purrr:map or sapply but is still would refer to whole column. I also trying to implement dplyr::rowWise but it didn't help me either.

I feel like I am going around the solution and that it can clearly be done easily. If there is some magic package that would help me to solve my issue quickly I would be more than thankful for help. But I would still like to know if there is a way to relate in that kind of situation to the current row value instead of whole column.

I was also trying to close this into one tidy user made function so that would be another plus if you could point me in that direction.

Perhaps your looking for something like this?

last_below <- function(x)
{
  sapply(seq(x), function(i) {
    y <- i - rev(which(x[i] >= cummax(x)))[1]
    if(y < 0) 0 else y
  })
}

So you can do

library(dplyr)

df <- data.frame(x = c(1:10, 6, 4, 5, 2))
df %>% mutate(y = last_below(x))
#>     x  y
#> 1   1  0
#> 2   2  0
#> 3   3  0
#> 4   4  0
#> 5   5  0
#> 6   6  0
#> 7   7  0
#> 8   8  0
#> 9   9  0
#> 10 10  0
#> 11  6  5
#> 12  4  8
#> 13  5  8
#> 14  2 12

Created on 2020-08-24 by the reprex package (v0.3.0)

it can be definitely done with runner . Be aware that function(x) in runner is evaluated for each cumulation - try runner(vec) to see the result (list). Imagine that each element of this list is one step, and function(x) is executed for each step.

Imagine that for one step (for example 10'th) you need to find how many observation before current had matched condition.

library(runner)
set.seed(1)

# dummy data
x <- round(cumsum(rnorm(10)))

current_idx <- 10
current_x <- x[current_idx]
up_to_current <- x[-current_idx]
current_idx - which(up_to_current == current_x)
# [1] 2 5

Above code can be body of the function(x) - how "far ago" were matching condition before current

runner(
  vec,
  function(x) {
    # current index
    current_idx <- length(x)
    
    # current value
    current_x <- x[current_idx]
    
    # values up to current
    up_to_current <- x[-current_idx]
        
    # how many observations since last condition matching 
    current_idx - which(up_to_current == current_x)       
  }  
)

Above returns a list, because output of the function(x) varies in length. If it returns single value - it will return a vector.


PS to find the index of matching condition after current observation you will need to include rev(vec) and play around with indices difference.

Enjoy!

I have found the solution thanks to the @allan-cameron 's answer:

last_below <- function(x) {
  sapply(
    seq(x), 
    function(i) {
      (i - tail(which(x[0:(i-1)] <= x[i]),1))[1]
    }
  )
}

By calling:

a %>% 
  mutate(b = last_below(value)) 

I get the output:

# A tibble: 11 x 2
   value     b
   <dbl> <int>
 1     9    NA
 2     7    NA
 3     4    NA
 4     1    NA
 5     5     1
 6     2     2
 7     5     1
 8     4     2
 9     1     5
10     6     1
11     6     1

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM