Как создать столбец на основе значений в строках выше / ниже строки в другом столбце в R

Question

Я долго думал об этом и не могу найти решение.У меня есть данные в столбце X, которые я хочу использовать для создания данных в столбце Z. Я хочу, чтобы Z равнялся всем 1 до точки, где в X есть два 0 в строке, а затем все нули после этого.Кроме того, в столбце W я хочу, чтобы конечные элементы были единицами, если смотреть на Y снизу вверх, Y содержит два ноля подряд.Надеюсь, что это имеет смысл.Я указал в колонке Z и колонке W, как они должны выглядеть в итоге.Я пытаюсь использовать индексирование, но мне трудно понять, как ссылаться на строки из столбца X, которые идут после строки, где будет значение для Z (потому что значение в строке 1 Z основано на значенияхстрок 2 и 3 в X).Это должны быть две отдельные функции: одна для просмотра в начале и одна для просмотра в конце.Они оба будут применены к каждой строке отдельно, поэтому столбец X будет содержать два столбца, Z, как показано ниже, а также другой столбец, который в этом случае будет иметь все 0.Спасибо за любую помощь!

****** Я изменил имена столбцов с ABCD на XYZWчтобы избежать путаницы.Извините, не думал об этом, когда я набрал его!

********** Мне бы очень хотелось сделать это без функций или циклов, просто используя индексацию.Я думаю, что я мог бы понять это с помощью функции, но так как это большой набор данных, я хочу, чтобы он был максимально быстрым.

code    X   Y   Z   W
A   1   0   1   0
A   1   0   1   0
A   0   0   1   0
A   1   0   1   0
A   1   0   1   0
A   1   0   1   0
A   1   0   1   0
A   0   0   1   0
A   1   0   1   0
A   0   0   0   0
A   0   0   0   0
A   1   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   1   1   0   0
B   0   0   0   0
B   1   0   0   0
B   0   0   0   0
B   1   0   0   0
B   0   0   0   0
B   0   0   0   0
B   1   0   0   0
B   0   1   0   0
B   0   0   0   0
B   0   0   0   0
B   0   1   0   1
B   0   1   0   1
B   0   1   0   1
B   0   0   0   1
B   0   1   0   1
B   0   1   0   1

Следующая функция, используемая с агрегатом, должна дать результаты, которые янаходясь в поиске.Спасибо Тайлеру за начало работы.Я все еще чувствую, что должен быть более простой способ сделать это, но сейчас это должно сделать.Спасибо всем за ваш вклад!

Думаю, я понял это, основываясь на коде Тайлера, всего лишь с несколькими изменениями.Я просто применю эту функцию, используя агрегат, и все должно получиться.Спасибо за все вклады!

pat.finder <- function(var, value=0, fill1=1, fill2=0, rev=FALSE, seq=2){

 if(var[1]==0 & rev==FALSE){

 j<- rep(0,length(var))} else if(var[length(var)]==0 & rev == TRUE){

 j<- rep(0,length(var))} else{

 x <- if(rev) rle(rev(var)) else rle(var)
 n <- which(x[[1]]>(seq-1) & x[[2]]==value)[1]-1
 i <- sum(x[[1]][1:n])
 j <- if(rev){
            rev(c(rep(fill1, i), rep(fill2, length(var)-i)))
       } else {
            c(rep(fill1, i), rep(fill2, length(var)-i))
       }
}

 return(j)
} 

Answer 1

Предположим, что фрейм данных, показанный в вопросе, равен DF.Тогда i-й элемент результата pmax равен 0, если i-й и последующие элементы x равны 0, а i-й элемент результата равен 1 в противном случае.Мы добавляем 1 в конце, так как последний элемент 'x' не имеет следующего элемента.Затем мы сравниваем это с 0 и cummin, затем перемещаем первые 0, найденные этим процессом, вперед.

two0 <- function(x) cummin(c(pmax(x[-1], x[-length(x)]), 1) != 0)
DF.out <- transform(DF, Z = two0(X), W = rev(two0(rev(Y))))

!=0 дает результат two0 integer.Если мы хотим, мы можем удалить его, и в этом случае результат будет numeric.

РЕДАКТИРОВАТЬ: уточненный целочисленный / числовой аспект.

Answer 2

Рассмотрим sum(dat$A[i:(i+1)]).Это ноль, если у вас есть два ноля подряд.Либо используйте цикл (или lapply), либо одну из этих запущенных функций, чтобы найти минимальное «i», которое возвращает ноль, и вы нашли, где «переключать» столбец C с 1 на ноль.

Но я действительно должен спросить: «Какую проблему вы пытаетесь решить?»Я почти гарантирую, если вы сообщите нам, откуда поступили данные в столбцах A и B, мы сможем показать вам гораздо более прямой способ определения точек останова, которые вы устанавливаете в столбцах C и D.

PS:как только решение настроено на dat$C, просто сделайте то же самое, но с циклом вниз от «imax» до 1, чтобы получить dat$D

Answer 3

Это может работать для ваших нужд (только для столбца A).Если вы можете более точно определить, что именно вы ищете, совет может помочь вам в дальнейшем.

## read in your data
df1 = read.table(text="code    A   B   C   D 
A   1   0   1   0
A   1   0   1   0
...
")

## create forward-lagged A column
require(taRifx)
df1$lagA = shift(df1$A,wrap=F,pad=T)

myfun1 = function(x,y) {
     BB = x + y
     BB = ifelse(BB > 0, 1, 0)
     BB
}

df1$A2 = apply(df1[,c(2,6)], 1, function(x,y) myfun1(x[1],x[2]))
tvec = rep(1,which(df1$A2 == 0)[1] -1)
bvec = vector(length = nrow(df1) - which(df1$A2 == 0)[1] + 1, mode="numeric")

## the column you are looking for:
df1$nA = c(tvec,bvec)

Answer 4

Вероятно, есть более быстрый путь, но вот что я придумал:

dat <- read.table(text="code    A   B   C   D #read in your data
A   1   0   1   0
A   1   0   1   0
A   0   0   1   0
A   1   0   1   0
A   1   0   1   0
A   1   0   1   0
A   1   0   1   0
A   0   0   1   0
A   1   0   1   0
A   0   0   0   0
A   0   0   0   0
A   1   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
A   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   0   0   0   0
B   1   1   0   0
B   0   0   0   0
B   1   0   0   0
B   0   0   0   0
B   1   0   0   0
B   0   0   0   0
B   0   0   0   0
B   1   0   0   0
B   0   1   0   0
B   0   0   0   0
B   0   0   0   0
B   0   1   0   1
B   0   1   0   1
B   0   1   0   1
B   0   0   0   1
B   0   1   0   1
B   0   1   0   1", header=T)

Теперь код:

A.rle <- rle(dat$A)
n <- which(A.rle[[1]]>1 & A.rle[[2]]==0)[1]-1
i <- sum(A.rle[[1]][1:n])
dat$C <- c(rep(1, i), rep(0, nrow(dat)-i))

B.rle <- rle(rev(dat$B))
n2 <- which(B.rle[[1]]>1 & B.rle[[2]]==0)[1]-1
i2 <- sum(B.rle[[1]][1:n2])
dat$D <- rev(c(rep(1, i2), rep(0, nrow(dat)-i2)))

РЕДАКТИРОВАТЬ: Я не совсем понимаю, что вы хотите, я думаю, поэтому я попытался создать функцию, которая будет универсальной для ваших нужд. Используйте rev=TRUE, чтобы посмотреть в конец:

pat.finder <- function(var, value=0, fill1=1, fill2=0, rev=FALSE, seq=2){
    x <- if(rev) rle(rev(var)) else rle(var)
    n <- which(x[[1]]>(seq-1) & x[[2]]==value)[1]-1
    i <- sum(x[[1]][1:n])
    j <- if(rev){
               rev(c(rep(fill1, i), rep(fill2, length(var)-i)))
          } else {
               c(rep(fill1, i), rep(fill2, length(var)-i))
          }
    return(j)
}

#TRY IT OUT
pat.finder(dat$B, rev=TRUE)

transform(dat, C=pat.finder(A), D = pat.finder(B, rev=TRUE)) #what I think you want

transform(dat, C=pat.finder(A, fill1='foo', fill2='bar'), 
    D = pat.finder(A, rev=TRUE))

transform(dat, C=pat.finder(A, value=1), D = pat.finder(B, rev=TRUE))