подсчет длины между чередующимися столбцами

Question

Я пытаюсь выяснить, как подсчитать количество строк, когда один столбец говорит «Истина», когда в другом столбце «Истина». Я попытался использовать кодировку длины пробега, но не мог понять, как получить переменные значения из каждого столбца.

set.seed(42) 
s<-sample(c(0,1,2,3),500,replace=T) 
isOverbought<-s==1 
isOverSold<-s==0 
head(cbind(isOverbought,isOverSold),20) 
res<-rle(isOverSold) 
tt<-res[res$values==0] #getting when Oversold is true 

> head(cbind(isOverbought,isOverSold)) 

[1,]  FALSE  FALSE 
[2,]  FALSE  FALSE 
[3,]   TRUE  FALSE <-starting condition is overbought 
[4,]  FALSE  FALSE 
[5,]  FALSE  FALSE 
[6,]  FALSE  FALSE 
[7,]  FALSE  FALSE 
[8,]  FALSE  TRUE <-is oversold. length from overbought to oversold = 5 
[9,]  FALSE  FALSE 
[10,]  FALSE  FALSE 
[11,]   TRUE  FALSE <- is overbought. length from oversold to overbought = 3 
[12,]  FALSE  FALSE 
[13,]  FALSE  FALSE 
[14,]   TRUE  FALSE 
[15,]   TRUE  FALSE 
[16,]  FALSE  FALSE 
[17,]  FALSE  FALSE 
[18,]  FALSE  TRUE <-is oversold. length from overbought to oversold = 7 
[19,]   TRUE  FALSE <- is overbought. length from oversold to overbought = 1 
[20,]  FALSE  FALSE 

ЗАДАЧА

overboughtTOoversold oversoldTOoverbought 
5      3 
7      1 

Answer 1

Этого вполне достаточно, чтобы решить вашу проблему.

## `a` to `b` 
a2b <- function (a, b) { 
    x <- which(a) ## position of `TRUE` in `a` 
    y <- which(b) ## position of `TRUE` in `b` 
    z <- which(a | b) ## position of all `TRUE` 
    end <- match(y, z) ## match for end position 
    start <- c(1L, end[-length(end)] + 1L) ## start position 
    valid <- end > start ## remove cases with `end = start` 
    z[end[valid]] - z[start[valid]] 
    } 

## cross `a` and `b` 
axb <- function (a, b) { 
    if (any(a & b)) 
    stop ("Invalid input! `a` and `b` can't have TRUE at the same time!") 
    x <- a2b(a, b); y <- a2b(b, a) 
    if (which(a)[1L] < which(b)[1L]) cbind(a2b = x, b2a = c(NA_integer_, y)) 
    else cbind(a2b = c(NA_integer_, x), b2a = y) 
    } 

---

Для вашего isOverbought и isOverSold, получим:

result <- axb(isOverbought, isOverSold) 

head(result) 
#  a2b b2a 
#[1,] 5 NA 
#[2,] 7 3 
#[3,] 3 1 
#[4,] 8 5 
#[5,] 2 6 
#[6,] 10 2 

С isOverbought имеет первый TRUE перед тем isOverSold, первый элемент 2-го столбца NA.

Answer 2

Предположение для этого ответа заключается в том, что существует, по крайней мере, один перекупленности/перепроданности перехода (в любом направлении), и, следовательно, по меньшей мере, две строки в данных. Это условие может быть легко проверено путем подсчета количества условий перекупленности и перепроданности и обеспечения того, что оба они больше одного.

Ключ должен удалить последовательные условия перекупленности и перепроданности, чтобы у нас были только переменные условия перекупленности и перепроданности. Один из способов сделать это:

## detect where we are overbought and oversold 
i1 <- which(isOverbought) 
i2 <- which(isOverSold) 
## concatenate into one vector 
i3 <- c(i1,i2) 
## sort these and get the indices from the sort 
i4 <- order(i3) 
## at this point consecutive overbought or oversold conditions 
## will be marked by a difference of 1 in i4 while alternating 
## conditions will be marked by something other than 1. So 
## filter those out to get i6. BTW, consecutive here does not mean 
## consecutive rows in the data but consecutive occurrence of 
## either overbought or oversold conditions without an intervening 
## condition of the other. The assumption for at least one transition 
## in the data is needed for this to work. 
i5 <- diff(i4) 
i6 <- i4[c(1,which(i5 != 1)+1)] 
## then recover the alternating rows of overbought and oversold conditions in i7 
i7 <- i3[i6] 
## take the difference and format the output 
## I need to credit @akrun for this part 
i8 <- diff(i7) 
## need to determine which is first 
if (i1[1] < i2[1]) { 
    overboughtTOoversold <- i8[c(TRUE, FALSE)] 
    oversoldTOoverbought <- i8[c(FALSE, TRUE)] 
} else { 
    overboughtTOoversold <- i8[c(FALSE, TRUE)] 
    oversoldTOoverbought <- i8[c(TRUE, FALSE)] 
} 
d1 <- cbind(overboughtTOoversold, oversoldTOoverbought) 
print(head(d1)) 
##  overboughtTOoversold oversoldTOoverbought 
##[1,]     5     3 
##[2,]     7     1 
##[3,]     3     5 
##[4,]     8     6 
##[5,]     2     2 
##[6,]     10     4 

cbind может генерировать предупреждение о том, что столбцы не одинаковой длины. Чтобы избавиться от этого, просто поместите с NA в конце, если необходимо.

Более компактная версия выше:

i3 <- c(which(isOverbought), which(isOverSold)) 
i4 <- order(i3) 
i8 <- diff(i3[i4[c(1,which(diff(i4) != 1)+1)]]) 
if (which(isOverbought)[1] < which(isOverSold)[1]) { 
    overboughtTOoversold <- i8[c(TRUE, FALSE)] 
    oversoldTOoverbought <- i8[c(FALSE, TRUE)] 
} else { 
    overboughtTOoversold <- i8[c(FALSE, TRUE)] 
    oversoldTOoverbought <- i8[c(TRUE, FALSE)] 
} 
d1 <- cbind(overboughtTOoversold, oversoldTOoverbought) 

Answer 3

Вот [немного долго] tidyverse версия:

library(dplyr) 
library(tidyr) 

# put vectors in a data.frame 
data.frame(isOverbought, isOverSold) %>% 
    # evaluate each row separately 
    rowwise() %>% 
    # add column with name of event for any TRUE, else NA 
    mutate(change_type = ifelse(isOverbought | isOverSold, names(.)[c(isOverbought, isOverSold)], NA)) %>% 
    # reset grouping 
    ungroup() %>% 
    # replace NA values with last non-NA value 
    fill(change_type) %>% 
    # add a column of the cumulate number of changes in change_type 
    mutate(changes = data.table::rleid(change_type)) %>% 
    # count number of rows in each changes and change_type grouping 
    count(changes, change_type) %>% 
    # remove leading NAs 
    na.omit() %>% 
    # reset grouping 
    ungroup() %>% 
    # edit change into runs of two with integer division 
    mutate(changes = changes %/% 2) %>% 
    # spread to wide form 
    spread(change_type, n) %>% 
    # get rid of extra column 
    select(-changes) 

## # A tibble: 68 x 2 
## isOverbought isOverSold 
## *   <int>  <int> 
## 1    5   3 
## 2    7   1 
## 3    3   5 
## 4    8   6 
## 5    2   2 
## 6   10   4 
## 7    7   1 
## 8    3   4 
## 9    1   3 
## 10   2   3 
## # ... with 58 more rows 

Answer 4

Вот короткая версия:

• создать вектор с именем mktState. Кодировать его с 1, если перекупленность равна TRUE, -1 если перепроданность равна TRUE и NA, если оба первых 2 столбца равны FALSE.(Вы заинтересованы только в дни, когда рынок государственных выключатели)
• использовать na.locf, чтобы заполнить NA с с последним наблюдением, перенесенным

• теперь использовать функцию rle

  mktState <- ifelse(df$overBought == TRUE,1,ifelse(df$overSold == TRUE,-1,NA)) mktState <- na.locf(mktState)

, чтобы получить «перекупленные» пробеги:

> rle(mktState)$lengths[rle(mktState)$values == 1] 
[1] 5 7 3 8 2 10 7 3 1 2 4 2 5 6 3 11 4 1 5 2 4 6 1 1 8 
[26] 7 3 1 1 1 1 3 2 3 1 6 1 1 1 3 2 4 2 1 6 8 8 1 5 15 
[51] 2 5 4 2 1 1 3 4 7 1 7 11 1 3 4 2 4 1 

, и это даст вам 'перепродан' работает:

> rle(mktState)$lengths[rle(mktState)$values == -1] 
[1] 3 1 5 6 2 4 1 4 3 3 3 5 2 4 1 14 2 2 10 3 7 1 13 1 1 
[26] 3 3 1 6 5 2 1 8 7 2 3 1 1 3 5 1 1 2 3 1 2 2 3 3 1 
[51] 8 9 4 2 1 6 2 1 3 2 4 5 1 3 7 4 2 2