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