I've created the following loop but would like to write it as a lapply function.
Is this possible? I'm trying to get my head around apply functions but haven't quite got the hang of it yet.
Decay <- function(x, decay=y) stats::filter(x, decay, method = "recursive")
d<-iris[,c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width")]
DecayX <- c(0.1,0.3,0.6,0.8,0.95)
DecVars = c("Sepal.Length","Petal.Width")
for (j in DecVars){
for (i in DecayX){
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]]<-Decay(d[j],i)
}
}
I don't see any reason to use the apply family here.
You could use mapply
vars <- c(expand.grid(DecayX,DecVars,stringsAsFactors = F))
invisible(
mapply(function(x,DecV){VarName <- paste(colnames(d[DecV]),x*100,"DEC",sep="_");
d[[VarName]]<<-Decay(d[DecV],x)},x=vars[[1]],DecV=vars[[2]])
)
I think in cases of a double loop I would not use the apply family.
Another way would be to replace each for loop with an sapply() which is faster than for loops and doesn't require the use of expand.grid().
invisible(
sapply(DecVars, function(j) {
sapply(DecayX, function(i) {
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]] <<- Decay(d[j],i)
})
})
)
You can see that this is a lot faster than using for loops and also marginally faster than the use of mapply() with grid.expand():
library(microbenchmark)
microbenchmark(
'mapply' = {
vars <- c(expand.grid(DecayX,DecVars,stringsAsFactors = F))
invisible(
mapply(function(x,DecV){VarName <- paste(colnames(d[DecV]),x*100,"DEC",sep="_");
d[[VarName]]<<-Decay(d[DecV],x)},x=vars[[1]],DecV=vars[[2]])
)},
'sapply' = {
invisible(
sapply(DecVars, function(j) {
sapply(DecayX, function(i) {
VarName <- paste(colnames(d1[j]),i*100,"DEC",sep="_")
d1[[VarName]] <<- Decay(d1[j],i)
})
})
)
},
'for-loop' = {
for (j in DecVars){
for (i in DecayX){
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]]<-Decay(d[j],i)
}
}
},
times = 1000)
Note: if you ignore the expand.grid() step, mapply() would be marginally faster.
Related
This code chunk creates a 10 objects based of length of alpha.
alpha <- seq(.1,1,by=.1)
for (i in 1:length(alpha)){
assign(paste0("list_ts_ses_tune", i),NULL)
}
How do I put each function into the new list_ts_ses_tune1 ... null objects I've created? Each function puts in a list, and works if I set list_ts_ses_tune1 <- lapply ...
for (i in 1:length(alpha))
{
list_ts_ses_tune[i] <- lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
list_ts_ses_tune[i] <- lapply(list_ts_ses_tune[i], "[", c("mean"))
}
Maybe this is a better way to do this? I need each individual output in a list of values.
Edit:
for (i in 1:length(alpha))
{
list_ts_ses_tune[[i]] <- lapply(list_ts[1:(length(list_ts)/2)],
function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
list_ts_ses_tune[[i]] <- lapply(list_ts_ses_tune[[i]], "[", c("mean"))
}
We can use mget to return all the objects into a list
mget(ls(pattern = '^list_ts_ses_tune\\d+'))
Also, the NULL list can be created more easily instead of 10 objects in the global environment
list_ts_ses_tune <- vector('list', length(alpha))
Now, we can just use the OP's code
for (i in 1:length(alpha))
{
list_ts_ses_tune[[i]] <- lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i])))
}
If we want to create a single data.frame
for(i in seq_along(alpha)) {
list_ts_ses_tune[[i]] <- data.frame(Mean = do.call(rbind, lapply(list_ts, function(x)
forecast::forecast(ses(x,h=24,alpha=alpha[i]))$mean)))
}
You could simply accomplish everything by doing:
library(forecast)
list_ts_ses_tune <- Map(function(x)
lapply(alpha, function(y)forecast(ses(x,h=24,alpha=y))['mean']), list_ts)
Is there any way to use only part of a function in R?
For example:
My.function <- function(x)
{
m = mean(x)
q.1 = quantile(x, 1/4)
q.3 = quantile(x, 3/4)
rbind(m, q.1, q.3)
}
I want to use only q.1 and q.3 and not m for any reason. Is it possible? If it is, then how?
Thanks
You could use if statements in the body of the function and add booleans in the function argument. Then the function won't evaluate if statements that are false. For your case, it would be something like
My.function <- function(x,getmean = F)
{
q.1 = quantile(x, 1/4)
q.3 = quantile(x, 3/4)
if (getmean) {
m = mean(x)
return(rbind(m, q.1, q.3))
} else {
return(rbind(q.1,q.3))
}
}
#test
My.function(rnorm(100))
My.function(rnorm(100), getmean = T)
Why would you bother? If you don't want the m in your output, just write
foo <- My.function(x)[2:3,]
Note: if you are dealing with a function which contains three seriously time-consuming subfunctions, then it makes sense to do something similar to "doubled"s answer. I would recommend full flexibility:
My.function <- function(x, dolist=c(1,1,1) )
{
result <-vector('list') # to handle any sorts of results
if(dolist[1]) { result[[1]] <- first.function(x) }
if(dolist[2]) {result[[2]] <- second.function(x) }
if(dolist[3]) {result[[3]] <- third.function(x) }
return(result)
}
I just read that vectorization increases performance and lowers significantly computation time, and in the case of if() else , best choice is ifelse().
My problem is I got some if statements inside a for loop, and each if statement contains multiple assignments, like the following:
x <- matrix(1:10,10,3)
criteria <- matrix(c(1,1,1,0,1,0,0,1,0,0,
1,1,1,1,1,0,0,1,1,0,
1,1,1,1,1,1,1,1,1,1),10,3) #criteria for the ifs
output1 <- rep(list(NA),10) #storage list for output
for (i in 1:10) {
if (criteria[i,1]>=1) {
output1[[i]] <- colMeans(x)
output1[[i]] <- output1[[i]][1] #part of the somefunction output
} else {
if(criteria[i,2]>=1) {
output1[[i]] <- colSums(x)
output1[[i]] <- output1[[i]][1] #the same
} else {
output1[[i]] <- colSums(x+1)
output1[[i]] <- output1[[i]][1] #the same
}}}
How can I translate this into ifelse?
Thanks in advance!
Note that you don't need a for loop as all operations used are vectorized:
output2 <- ifelse(criteria[, 1] >= 1,
colMeans(x)[1],
ifelse(criteria[, 2] >= 1,
colSums(x)[1],
colSums(x+1)[1]))
identical(output1, as.list(output2))
## [1] TRUE
At least you can convert two assignments into one. So instead of
output[[i]] <- somefunction(arg1,arg2,...)
output[[i]] <- output[[i]]$thing #part of the somefunction output
you can refer directly to the only part you are interested in.
output[[i]] <- somefunction(arg1,arg2,...)$thing #part of the somefunction output
Hope that it helps!
It seems I found the answer trying to build the example:
output2 <- rep(list(NA),10) #storage list for output
for (i in 1:10) {
output2[[i]] <- ifelse(criteria[i,1]>=1,
yes=colMeans(x)[1],
no=ifelse(criteria[i,2]>=1,
yes=colSums(x)[1],
no=colSums(x+1)[1]))}
I have the following function :
ExampleFunction <- function(ListNumber1, ListNumber2)
{
OutputData <- list()
OutputData[[1]] <- rbind.fill(ListNumber1[[1]], ListNumber2[[1]])
OutputData[[2]] <- rbind.fill(ListNumber1[[2]], ListNumber2[[2]])
return(OutputData)
}
I want to improve this function introducing the possibility to use a variable number of arguments (i.e. lists in my example). Here is an attempt to do this but I don't see how to fill the arguments of rbind.fill().
ExampleFunctionUpgrade <- function(...)
{
Arguments <- list(...)
OutputData <- list()
VarNames <- paste0("List", seq_along(Arguments))
for (i in 1:length(Arguments))
{
assign(VarNames[i], Arguments[[i]])
}
OutputData <- rbind.fill(???)
return(OutputData)
}
I would try to iterate over the columns within an lapply call that is to be bound together.
ExampleFunctionUpgrade <- function(...)
{
Arguments <- list(...)
OutputData <- list()
for(i in 1:length(Arguments[[1]])) {
OutputData[[i]] <- rbind.fill(lapply(Arguments, '[[', i))
}
return(OutputData)
}
If you don't like 'for loops' you can use two lapply calls.
I have a drawing function f that should not return any output.
f <- function(a=0) invisible(NULL)
f(10)
After vectorizing f, it does return NULL.
f_vec <- Vectorize(f)
f_vec(10)
[[1]]
NULL
How can I prevent this, i.e. make the output invisible here as well.
I could of course use a wrapper to suppress it.
f_wrapper <- function(a=0) {
dummy <- f_vec(a)
}
f_wrapper(10)
Is there a way to avoid the wrapper and get what I want straight away?
Yeah there is. This new version of Vectorize will do it:
Vectorize_2 <- function (FUN, vectorize.args = arg.names, SIMPLIFY = TRUE, USE.NAMES = TRUE) {
arg.names <- as.list(formals(FUN))
arg.names[["..."]] <- NULL
arg.names <- names(arg.names)
vectorize.args <- as.character(vectorize.args)
if (!length(vectorize.args))
return(FUN)
if (!all(vectorize.args %in% arg.names))
stop("must specify names of formal arguments for 'vectorize'")
FUNV <- function() {
args <- lapply(as.list(match.call())[-1L], eval, parent.frame())
names <- if (is.null(names(args)))
character(length(args))
else names(args)
dovec <- names %in% vectorize.args
invisible(do.call("mapply", c(FUN = FUN, args[dovec], MoreArgs = list(args[!dovec]),
SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES)))
}
formals(FUNV) <- formals(FUN)
FUNV
}
But, how did I know to do this? Did I spend 20 minutes writing a brand new version of Vectorize? NOPE! I just ran dput(Vectorize) to see the R code behind Vectorize and added the invisible where necessary! You can do this with all R functions. You don't even need the dput! Just run Vectorize!