Re: [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
[EMAIL PROTECTED]
______________________________________________
[EMAIL PROTECTED] 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
 

______________________________________________
[EMAIL PROTECTED] 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