[R] expanding some values in logical vector

[Peter Wolf]

Try:

 > x<-rep(FALSE,20); x[c(4,10,15)]<-TRUE
 > x
 [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE
[13] FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE
 > x[outer(which(x),-1:1,"+")]<-T
 > x
 [1] FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE  TRUE FALSE
[13] FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE
 > x<-rep(FALSE,20); x[c(4,10,15)]<-TRUE
 > x[outer(which(x),-2:2,"+")]<-T
 > x
 [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE
[13]  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE
# now we definie
 > expand.true<-function(x,span=1){
  m<-floor(span/2)
  ind<-outer(which(x),(-m):m,"+")
  ind<-ind[ind>0 & ind <= length(x)]
  x[ind]<-TRUE
  x
}
 > x<-rep(FALSE,20); x[c(4,10,19)]<-TRUE
 > expand.true(x,span=5)
 [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE
[13] FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE



Peter Wolf


Petr Pikal wrote:

>Dear all
>
>In automatic dropout evaluation function I construct an index (pointer), which 
>will be TRUE at "unusual" values. Then I need to expand these TRUE values a 
>little bit forward and backward.
>
>Example:
>
>having span=5, from vector
>
>idx<-rep(F,10)
>idx[4]<-T
>
>  
>
>>idx
>>    
>>
> [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE 
>FALSE
>
>I need
>
>  
>
>>idx
>>    
>>
> [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE 
>FALSE
>
>
>I was using embed() for this task (myfun1):
>
>idx <- rep(F,20)
>idx[c(4,11,13)] <- T
>
>  
>
>>idx
>>    
>>
> [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE 
>FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE 
>FALSE
>
>iii <- myfun1(idx)
>
>  
>
>>iii
>>    
>>
> [1]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE  TRUE  
>TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE 
>FALSE
>
>
>It is close to what I want, but it is slow and when idx vector is long enough it 
>goes short of memory. Then I tried to accomplish it with rle() and some fiddling 
>with $values and $lengths (myfun2), which works as long as the true values are 
>completely separated.
>
>idx <- rep(F,20)
>idx[c(4,12)] <- T
>
>  
>
>>idx
>>    
>>
> [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE 
>FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
>FALSE
>
>iii <- myfun2(idx)
>  
>
>>iii
>>    
>>
> [1] FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE  
>TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE 
>FALSE
>	
>But when using previous idx
>
>idx <- rep(F,20)
>idx[c(4,11,13)] <- T
>
>iii <- myfun2(idx)
>Error in rep.default(kody$values, opak) : invalid number of copies in "rep"
>
>Problem is, if TRUE values are closer than span allows. Then some values in 
>"opak" for FALSE kody$values are negative, what is not allowed. Setting them 
>to zero will expand the length of index vector. Instead number of repetitions of 
>neighbour TRUE values should be decreased accordingly. 
>
>I greatly appreciated, if somebody could give me a hint if there is some another 
>built in function which can help me or what to do with myfun2 or how to get 
>properly expanded index values by some another way.
>
>Sorry for the long post but I was not able to explain my problem and what I have 
>done yet to solve it in shorter.
>
>Thank you and best regards.
>
>Petr Pikal
>
>
>
>
>##### Here are functions used #####
>
>
>
>myfun1 <- function(idx,span=5)
>
>{
>n <- length(idx)
>s <- span%/%2
>z <- embed(idx,span)
>sumy <- rowSums(z)>0
>index <- c(rep(sumy[1],s),sumy,rep(sumy[n-span+1],s))
>}
>
>
>
>myfun2 <- function(idx,span=5)
>
>{
>n <- length(idx)
>
>kody <- rle(idx)
>test <- letters[sum(cumsum(c(kody$values[1],idx[n])))+1] ####is some of true 
>values at the end of vector idx?
>opak <- kody$values*(span-1)*2-(span-1)+kody$lengths #### enlarge number of 
>TRUE repetitions according to the span
>delka <- length(opak)
>
>#### some ifs to ensure the end points will have correct number of repetitions
>
>opak[c(1,delka)] <- opak[c(1,delka)]+span%/%2
>if (sum(kody$values)==0) opak <- n
>if (opak[1]<0) {opak[2] <- opak[2]+opak[1]; opak[1] <- 0}
>if (opak[delka]<0) {opak[delka-1] <- opak[delka-1]+opak[delka]; opak[delka] <- 
>0}
>
>switch(test,
>
>a = opak<-opak,
>b = opak[delka]<-opak[delka]-(span-1), 
>c = opak[1]<-opak[1]-(span-1), 
>d = opak[c(1,delka)]<-opak[c(1,delka)]-(span-1),
>
>)
>
>#### here should opak contain correct number of repetitions but does not
>
>index<-rep(kody$values,opak)
>
>}
>Petr Pikal
>petr.pikal at precheza.cz
>
>______________________________________________
>R-help at stat.math.ethz.ch mailing list
>https://www.stat.math.ethz.ch/mailman/listinfo/r-help
>PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
>  
>