R Apply function with if statements to every elements in list

问题

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.

回答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.

回答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

来源：https://stackoverflow.com/questions/40959858/r-apply-function-with-if-statements-to-every-elements-in-list

标签

list

if-statement

lapply