There is no need to test that a logical equals TRUE: 'logicalVector==TRUE'
is the
same as just 'logicalVector'.
There is no need to convert logical vectors to numeric, since rle() works
on both
types.
There is no need to use length(subset(x, logicalVector)) to count how many
elements
in logicalVector are TRUE, just use sum(logicalVector).
There is no need to make a variable, 'ans', then immediately return it.
Hence your
b[b == TRUE] = 1
y <- rle(b)
ans <- length(subset(y$lengths[y$values == 1], y$lengths[y$values == 1]
>= 2))
return(ans)
could be replaced by
y <- rle(b)
sum(y$lengths[y$values] >= 2)
This gives some speedup, mainly for long vectors, but I find it more
understandable.
E.g., if f1 is your original function and f2 has the above replacement I
get:
> d <- -sin(1:10000+sqrt(1:4))
> system.time(for(i in 1:10000)f1(d,.3))
user system elapsed
5.19 0.00 5.19
> system.time(for(i in 1:10000)f2(d,.3))
user system elapsed
3.65 0.00 3.65
> c(f1(d,.3), f2(d,.3))
[1] 1492 1492
> length(d)
[1] 10000
If it were my function, I would also get rid of the part that deals with
the threshhold
and direction of the inequality and tell the user to to use f(data <= 0.3)
instead of
f(data, .3, "below"). I would also make the spell length an argument
instead of
fixing it at 2. E.g.
> f3 <- function (condition, spellLength = 2)
{
stopifnot(is.logical(condition), !anyNA(condition))
y <- rle(condition)
sum(y$lengths[y$values] >= spellLength)
}
> f3( d >= .3 )
[1] 1492
Bill Dunlap
TIBCO Software
wdunlap tibco.com
On Sun, Jul 10, 2016 at 11:58 AM, Debasish Pai Mazumder <pai1...@gmail.com>
wrote:
> Hi Everyone,
> Thanks for your help. It works. I have similar problem when I am
> calculating number of spell.
> I am also calculation spell (definition: period of two or more days where x
> exceeds 70) using similar way:
>
> *new = apply(x,c(1,2,4),FUN=function(y) {fun.spell.deb(y, 70)})*
>
> where fun.spell.deb.R:
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> *## Calculate spell durationfun.spell.deb <- function(data, threshold = 1,
> direction = c("above", "below")){ #coln <- grep(weather, names(data))#
> var <- data[,8] if(missing(direction)) {direction <- "above"}
> if(direction=="below") {b <- (data <= threshold)} else {b <- (data >=
> threshold)} b[b==TRUE] = 1 y <-rle(b) ans
> <-length(subset((y$lengths[y$values==1]), (y$lengths[y$values==1])>=2))
> return(ans)}*
>
> Do you have any idea how to make the "apply" faster here?
>
> -Deb
>
>
> On Sat, Jul 9, 2016 at 3:46 PM, Charles C. Berry <ccbe...@ucsd.edu> wrote:
>
> > On Sat, 9 Jul 2016, Debasish Pai Mazumder wrote:
> >
> > I have 4-dimension array x(lat,lon,time,var)
> >>
> >> I am using "apply" to calculate over time
> >> new = apply(x,c(1,2,4),FUN=function(y) {length(which(y>=70))})
> >>
> >> This is very slow. Is there anyway make it faster?
> >>
> >
> > If dim(x)[3] << prod(dim(x)[-3]),
> >
> > new <- Reduce("+",lapply(1:dim(x)[3],function(z) x[,,z,]>=70))
> >
> > will be faster.
> >
> > However, if you can follow Peter Langfelder's suggestion to use rowSums,
> > that would be best. Even using rowSums(aperm(x,c(1,2,4,3)>=70,dims=3) and
> > paying the price of aperm() might be better.
> >
> > Chuck
> >
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
