R将带有if语句的函数应用于列表中的每个元素

Question

I have a huge list, below is a sample of trboot6

UPDATE: I do not want to delete the extra "1" or "-1". Instead I want to change it to zero. I am so sorry

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"))

Putting the below for illustration purpose only

$ 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 ...

What I want to do is check if in each list every pair has 1 and -1. Pairs are represented in brackets in the following:

$ 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) ...

If the pair does not have 1 and -1 then, I want to change the second same number to zero, that is if the pair is (1 1) , I change the second 1 to zero to get '(1 0)'. If there is 1 again, I change this 1 too. Then if there is a -1, it will pair with the first 1.

To better code, I used the logic that the sum should always remain between -2 and 2 for the pairs to exist. Pair cant be (1,-1) (-1,1) or (1,-1) (1,-1). So if the balance goes <-2 or >2, the latest number has to be deleted.

Here is my code for the above logic:

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)

After running this, I get the warning:

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

Expected Output:

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

thank you for your help in advance.

Answer 1

SInce I haven't got 50 points of reputation I can't comment, what if you shift your vector from one element and always check that the sum of the vector and the shifted vector is always equal to 0 ?

You won't use apply, but a while condition, it is not really a good looking code but it should work for each vector inside your list.

I created a vector x which is just as a vector from your list (composed of -1 and 1 only)

 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]
}

Now if I print x I indeed removed all the elements which didn't form a pair of (-1,1) or (1,-1) with the precedent element.

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

I'm not sure this was what you asked, but I hope it will help you at least a little.

Answer 2

We can define a function that takes in a vector x , and checks for "pairs". If the pair doesn't sum to 0, it replaces the second item of the pair with 0, and then keeps checking along the vector. We use i and j as our iterators.

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