R Применить функцию с тем, если заявления на каждые элементы в списке

Question

У меня есть огромный список, ниже приведен пример trboot6

UPDATE: Я не хочу, чтобы удалить лишние «1» или «-1». Вместо этого я хочу изменить его на ноль. Мне так жаль

dput() 
structure(list(`1` = c(-1, 1, -1, -1, -1, -1, -1, -1, -1, 1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1), `2` = c(-1, 
-1, -1, 1, 1, 1, -1, -1, -1, -1, -1, -1, 1, 1, -1, -1, -1, -1, 
-1, 1, 1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, 1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1), `3` = c(1, -1, -1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, -1, -1, -1, -1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
-1, -1, -1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1), `4` = c(-1, 
-1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 
-1, -1, -1, -1, -1, -1, -1, 1, 1, -1, -1, -1, -1, 1, -1, -1, 
-1, -1, -1, -1, -1, -1, -1, -1, -1, 1), .Names = c("1", "2", "3", "4")) 

Ввод ниже для иллюстрации только

$ 1 : num [1:39] -1 1 -1 -1 -1 -1 -1 -1 -1 1 ... 
$ 2 : num [1:46] -1 -1 -1 1 1 1 -1 -1 -1 -1 ... 
$ 3 : num [1:48] 1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ... 
$ 4 : num [1:43] -1 -1 1 -1 -1 -1 -1 -1 -1 -1 ... 

То, что я хочу сделать, это проверить, если в каждом списке каждая пара имеет 1 и -1. Пары представлены в скобках в следующем:

$ 1 : num [1:39] (-1 1) (-1 -1) (-1 -1) (-1 -1) (-1 1) ... 
$ 2 : num [1:46] (-1 -1) (-1 1) (1 1) (-1 -1) (-1 -1) ... 
$ 3 : num [1:48] (1 -1) (-1 -1) (-1 -1) (-1 -1) (-1 -1) ... 
$ 4 : num [1:43] (-1 -1) (1 -1) (-1 -1) (-1 -1) (-1 -1) ... 

Если пара не 1 и -1, то, я хочу изменить второе такое же число к нулю, то есть, если пара (1 1), я изменю второй 1 до нуля, чтобы получить '(1 0)'. Если снова 1, я тоже изменил это значение 1. Тогда, если есть -1, он будет паре с первым 1.

Для лучшего кода я использовал логику, что сумма должна всегда оставаться между -2 и 2 для существования пар. Пара не может быть (1, -1) (-1,1) или (1, -1) (1, -1). Поэтому, если баланс равен < -2 или> 2, последний номер необходимо удалить.

Вот мой код выше логики:

balboot<-0 
fboot<- function(x) { 
    ifelse(x==-1,balboot<-balbbot-1,balboot<-balboot+1) 
    if(balboot==-2){x<-0 
    balboot=-1} 
    if(balboot==2){x<-0 
    balboot=1} 
    return(fboot) 
} 
rdtp<-lapply(trboot6, FUN=fboot) 

После запуска этого я получаю предупреждение:

In if (x == 1) { ... : 
    the condition has length > 1 and only the first element will be used 

Ожидаемый результат:

list '1': -1, 1, -1, 0, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 
list '2': -1, 0, 0, 1, 1, 0, -1, -1,0, 0, 0, 0, 1, 1, -1, -1, 0, 0, 0, 1, 1, 0, -1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, -1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0 

поблагодарить Вас за помогите заранее.

Answer 1

SInce У меня нет 50 баллов репутации Я не могу комментировать, что, если вы смещаете вектор из одного элемента и всегда проверяете, что сумма вектора и сдвинутого вектора всегда равна 0?

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

Я создал вектор х, который так же, как вектор из вашего списка (состоящий из -1 и только 1)

x <- c(-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,1,1,-1,-1,1,1,-1,1,-1,-1,1,-1,1,-1,1) 

x1 <- x[-length(x)] 
x2 <- x[-1] 

y <- x1 + x2 

while (length(which((x1+x2)!=0))>0) { 
    x <- x[- which((x1+x2)!=0)[1]] 
    x1 <- x[-length(x)] 
    x2 <- x[-1] 
} 

Теперь, если я печатаю x я действительно удалены все элементы, которые не образуют пара (-1,1) или (1, -1) с элементом-предшественником.

x 
[1] -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 

Я не уверен, что это было то, о чем вы просили, но я надеюсь, что это поможет вам хотя бы немного.

Answer 2

Мы можем определить функцию, которая принимает вектор x, и проверяет наличие «пар». Если пара не суммируется с 0, она заменяет второй элемент пары на 0, а затем продолжает проверять вдоль вектора. В качестве наших итераторов мы используем i и j.

good_pairs <- function(x){ 

    i <- 1 
    j <- 2 
    keepgoing <- TRUE 

    while(keepgoing){ 
     #grab a pair and sum it 
     pair <- x[c(i, j)] 
     pair_sum <- sum(pair) 

     while(pair_sum != 0){ #continue iterating until sum == 0 
      #replace i + 1 element with 0 
      x[j] <- 0 
      j <- j + 1 
      #break if we've run out of elements 
      if(is.na(x[j])){ 
       break 
      }else{ 
      #check the pair 
      pair <- x[c(i, j)] 
      pair_sum <- sum(pair) 
      } 

     } 
     #increment 
     i <- j + 1 
     j <- j + 2 
     keepgoing <- (length(x) > i) 

    } 
    x 
} 

lapply(trboot6, good_pairs) 
[[1]] 
[1] -1 1 -1 0 0 0 0 0 0 1 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 

[[2]] 
[1] -1 0 0 1 1 0 -1 -1 0 0 0 0 1 1 -1 -1 0 0 0 1 1 0 -1 -1 0 0 0 0 0 0 0 0 0 1 1 -1 -1 0 0 0 0 0 0 0 
[45] 0 0 

[[3]] 
[1] 1 -1 -1 0 0 0 0 0 0 0 0 0 0 1 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 -1 0 0 0 0 
[45] 0 0 0 0 

[[4]] 
[1] -1 0 1 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 -1 -1 0 0 1 -1 0 0 0 0 0 0 0 0 0 0 1