[R] expanding some values in logical vector

[Petr Pikal]

Thank you very much. I myself thought about something similar but I was not so 
smart to use outer.

Cheers
Petr


On 15 Mar 2004 at 13:51, Peter Wolf wrote:

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

Petr Pikal
petr.pikal at precheza.cz