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.
Related
I have to automate this sequence of functions:
for (i in c(15,17,20,24,25,26,27,28,29,45,50,52,55,60,62)) {
WBES_sf_angola_i <- subset(WBES_sf_angola, isic == i)
WBES_angola_i <- as_Spatial(WBES_sf_angola_i)
FDI_angola_i <- FDI_angola[FDI_angola$isic==i,]
dist_ao_i <- distm(WBES_angola_i,FDI_angola_i, fun = distGeo)/1000
rm(WBES_sf_angola_i,WBES_angola_i,FDI_angola_i)
}
As a result, I want a "dist_ao" for each i. The indexed values are to be found in the isic columns of the WBES_sf_angola and the FDI_angola datasets.
How can I embed the index in the various items' names?
EDIT:
I tried with following modification:
for (i in c(15,17,20,24,25,26,27,28,29,45,50,52,55,60,62)) {
WBES_sf_angola_i <- subset(WBES_sf_angola, isic == i)
WBES_angola_i <- as_Spatial(WBES_sf_angola_i)
FDI_angola_i <- FDI_angola[FDI_angola$isic==i,]
result_list <- list()
result_list[[paste0("dist_ao_", i)]] <- distm(WBES_angola_i,FDI_angola_i, fun = distGeo)/1000
rm(WBES_sf_angola_i,WBES_angola_i,FDI_angola_i)
}
and the output is just a list of 1 that contains dist_ao_62. Where do I avoid overwriting?
Untested (due to missing MRE) but should work:
result_list <- list()
for (i in c(15,17,20,24,25,26,27,28,29,45,50,52,55,60,62)) {
result_list[[paste0("dist_ao_", i)]] <- distm(as_Spatial(subset(WBES_sf_angola, isic == i)) , FDI_angola[FDI_angola$isic==i,], fun = distGeo)/1000
}
You could approach it this way. All resulting dataframes will be included in the list, which you can convert to a dataframe from the last line of the the code here. NOTE: since not reproducible, I have mostly taken the code from your question inside the loop.
WBES_sf_angola_result <- list() # renamed this, as it seems you are using a dataset with the name WBES_sf_angola
WBES_angola <- list()
FDI_angola <- list()
dist_ao <- list()
for (i in c(15,17,20,24,25,26,27,28,29,45,50,52,55,60,62)) {
WBES_sf_angola[[paste0("i_", i)]] <- subset(WBES_sf_angola, isic == i)
WBES_angola[[paste0("i_", i)] <- as_Spatial(WBES_sf_angola_i)
FDI_angola[[paste0("i_", i)] <- FDI_angola[FDI_angola$isic==i,]
dist_ao[[paste0("i_", i)] <- distm(WBES_angola_i,FDI_angola_i, fun = distGeo)/1000
rm(WBES_sf_angola_i,WBES_angola_i,FDI_angola_i)
}
WBES_sf_angola_result <- do.call(rbind, WBES_sf_angola_result) # to get a dataframe
Your subset data can also be accessed through list index. eg.
WBES_sf_angola_result[[i_15]] # for the first item.
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)
I'm struggling with determining the syntax to compare the value of a variable that contains a function as part of a conditional statement.
I've written the following function:
cv_func <- function(df, method, target, nFolds=5, seedVal=100, metrics_list=c("ACC","TPR","PRECISION","F1"), l=0.3, m=0.2, n=500, h='a', kernal='rbfdot', c=1, i=TRUE, f=TRUE, k=1, x=TRUE)
{
# create folds using the assigned values
set.seed(seedVal)
folds = createFolds(df[,target],nFolds)
# lapply loop
cv_results <- lapply(folds, function(x)
{
# data preparation:
test_target <- df[x,target]
test_input <- df[x,-target]
train_target <- df[-x,target]
train_input <- df[-x,-target]
if (method==MLP) {
pred_model <- method(train_target~., data=train_input, l=l, m=m, n=n, h=h)
}
else if (method==ksvm) {
pred_model <- method(train_target~., data=train_input, kernal=kernal, C=c)
}
else if (method==IBk) {
pred_model <- method(train_target~., data=train_input, control = Weka_control(I=i, K=k, F=f, X=x))
}
else {
pred_model <- method(train_target~., data=train_input)
}
pred_train <- predict(pred_model, train_input)
return(mmetric(train_target, pred_train, metrics_list))
})
# convert a list to a data frame using as.data.frame and convert this data frame to a matrix before using rowSds()
cv_results_m <- as.matrix(as.data.frame(cv_results))
cv_mean<- as.matrix(rowMeans(cv_results_m))
cv_sd <- as.matrix(rowSds(cv_results_m))
colnames(cv_mean) <- "Mean"
colnames(cv_sd) <- "Sd"
# Combine and show cv_results and Means and Sds
cv_all <- cbind(cv_results_m, cv_mean, cv_sd)
kable(t(cv_all),digits=3)
}
When I attempt to run the function with default parameters, I get an error:
cv_func(df=df, method=IBk, target=20)
Error: "Error in method == "MLP" : comparison (1) is possible only for atomic and list types"
Any thoughts on whether I can use a variable containing a function as part of a conditional in R?
The issue is related to the argument type. It seems like a string is needed as input and as it is a function, we can get the value of the function with get wrapped around the string. It may be better to have a default method for the last else
cv_func <- function(df=df, target=20, nFolds=5, seedVal=100, method, metrics_list=c("ACC","TPR","PRECISION","F1"), l=0.3, m=0.2, n=500, h='a', kernal='rbfdot', c=1, i=TRUE, f=TRUE, k=1, x=TRUE)
{
# create folds using the assigned values
set.seed(seedVal)
folds = createFolds(df[,target],nFolds)
# lapply loop
cv_results <- lapply(folds, function(x)
{
# data preparation:
test_target <- df[x,target]
test_input <- df[x,-target]
train_target <- df[-x,target]
train_input <- df[-x,-target]
if (method=="MLP") {
pred_model <- get(method)(train_target~., data=train_input, l=l, m=m, n=n, h=h)
}
else if (method=="ksvm") {
pred_model <- get(method)(train_target~., data=train_input, kernal=kernal, C=c)
}
else if (method=="IBk") {
pred_model <- get(method)(train_target~., data=train_input, control = Weka_control(I=i, K=k, F=f, X=x))
}
else {
pred_model <- get(method)(train_target~., data=train_input)
}
pred_train <- predict(pred_model, train_input)
return(mmetric(train_target, pred_train, metrics_list))
})
# convert a list to a data frame using as.data.frame and convert this data frame to a matrix before using rowSds()
cv_results_m <- as.matrix(as.data.frame(cv_results))
cv_mean<- as.matrix(rowMeans(cv_results_m))
cv_sd <- as.matrix(rowSds(cv_results_m))
colnames(cv_mean) <- "Mean"
colnames(cv_sd) <- "Sd"
# Combine and show cv_results and Means and Sds
cv_all <- cbind(cv_results_m, cv_mean, cv_sd)
kable(t(cv_all),digits=3)
}
and then call the function as
cv_func(method="IBk", metrics_list=metrics_list)
have the following function:
setTypes <- function(df2, ...) {
fns <- as.list(substitute(list(...)))
for(i in 1:length(df2)) {
if(fns[i] == '') {
next
}
df2[i,] <- fns[i](df2[i,])
}
return(df2)
}
want to do this:
test<-setTypes(sls,c('','as.Date','','','as.numeric','as.numeric'))
idea is to change the types of the fields in a data frame without having to do sls$field <- as.numeric(sls$field) for every field.
I had written a function like this that worked:
fn <- function(t) {
return(t("55.55000"))
}
and the output is this:
> fn(as.numeric)
[1] 55.55
however, i can't figure out why either doing variable length argument as a list and calling it as list[index](input) doesn't work. or even passing a vector of functions like c(as.Date, as.numeric, as.character) and doing c[1]('2015-10-10') # as.Date('2015-10-10')
I am receiving the error 'attempt to apply non-function'.. I've also tried using call but to no avail. Help?
The problem is that class(c[1]) is a list use c[[1]] instead
Example code
v <- c(as.numeric,as.character)
v[[1]]("1")
v[[2]](1)
EDIT
Your example should be:
setTypes <- function(df2, ...) {
fns <- list(...)
for(i in 1:NCOL(df2)) {
if(is.function(fns[[i]])) {
df2[,i] <- fns[[i]](df2[,i])
}
}
return(df2)
}
df <- data.frame(v1 = c(1,2), v2 = c("1","2"))
setTypes(df,as.character,'',as.numeric)
Certainly a very basic question but I do not have the answer:
I have a vector of function:
func1 <- function(u) u
func2 <- function(u) NA
func3 <- function(u) 1
funcs = c(func1, func2, func3)
I loop over every function using sapply, and I want to find a function command that retrieves the name of the function:
res=sapply(funcs, function(f){
command(f)
})
So that res is then:
c("func1","func2","func3")
Although there is no way to get the names if funcs is created with c, here is a convenience function for creating funcs that preserves the names:
cn <- function(...)
{
# call c() on parameters supplied, adding names
cnames <- sapply(as.list(substitute(list(...)))[-1L],as.character)
out <- c(...)
names(out) <- cnames
return(out)
}
funcs = cn(func1, func2, func3)
How about this approach:
flist<-ls(patt='func*')
flist[1]
[1] "func1"
do.call(flist[1],list(5))
# 5