my code is like the following:
unemp <- c(1:10)
bsp_li <- list(c(1:10),c(11:20),c(21:30))
var_data_rep <- lapply(bsp_li, function(x) {cbind(as.numeric(x), as.numeric(unemp))} )
var_data_rep2 <- lapply(var_data_rep, function(x) {colnames(x) = c("rGDP", "U")} )
but it does not what i wanted. i would like to name always the two elements of the list var_data_rep with c("rGDP", "U"). but instead the values are overwritten by c("rGDP", "U") and becomes the sole elements of the list.. can anyone help? i need the same names because i want to estimate always the same model later.
Easy fix: put the names in as the matrices are created:
var_data_rep <- lapply(bsp_li, function(x) {
cbind(rGDP = as.numeric(x), U = as.numeric(unemp))
} )
More roundabout fix (why your attempt didn't work): functions return the last line. You want to return x, not colnames(x)
var_data_rep2 <- lapply(var_data_rep, function(x) {
colnames(x) = c("rGDP", "U")
return(x)
} )
Fancy fix: use the colnames<- function directly
var_data_rep3 = lapply(var_data_rep, `colnames<-`, c("rGDP", "U"))
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)
Given the following data:
list_A <- list(data_cars = mtcars,
data_air = AirPassengers,
data_list = list(A = 1,
B = 2))
I would like to print names of objects available across list_A.
Example:
Map(
f = function(x) {
nm <- deparse(match.call()$x)
print(nm)
# nm object is only needed to properly name flat file that may be
# produced within Map call
if (any(class(x) == "list")) {
length(x) + 1
} else {
length(x) + 1e6
saveRDS(object = x,
file = tempfile(pattern = make.names(nm), fileext = ".RDS"))
}
},
list_A
)
returns:
[1] "dots[[1L]][[1L]]"
[1] "dots[[1L]][[2L]]"
[1] "dots[[1L]][[3L]]"
$data_cars
NULL
$data_air
NULL
$data_list
[1] 3
Desired results
I would like to get:
`data_cars`
`data_air`
`data_list`
Update
Following the comments, I have modified the example to make it more reflective of my actual needs which are:
While using Map to iterate over list_A I'm performing some operations on each element of the list
Periodically I want to create a flat file with name reflecting name of object that was processed
In addition to list_A, there are also list_B, list_C and so forth. Therefore, I would like to avoid calling names(list) inside the function f of the Map as I will have to modify it n number of times. The solution I'm looking to find should lend itself for:
Map(function(l){...}, list_A)
So I can later replace list_A. It does not have to rely on Map. Any of the apply functions would do; same applied to purrr-based solutions.
Alternative example
do_stuff <- function(x) {
nm <- deparse(match.call()$x)
print(nm)
# nm object is only needed to properly name flat file that may be
# produced within Map call
if (any(class(x) == "list")) {
length(x) + 1
} else {
length(x) + 1e6
saveRDS(object = x,
file = tempfile(pattern = make.names(nm), fileext = ".RDS"))
}
}
Map(do_stuff, list_A)
As per the notes below, I want to avoid having to modify do_stuff function as I will be looking to do:
Map(do_stuff, list_A)
Map(do_stuff, list_B)
Map(do_stuff, list_...)
We could wrap it into a function, and do it in two steps:
myFun <- function(myList){
# do stuff
res <- Map(
f = function(x) {
#do stuff
head(x)
},
myList)
# write to a file, here we might add control
# if list is empty do not output to a file
for(i in names(res)){
write.table(res[[ i ]], file = paste0(i, ".txt"))
}
}
myFun(list_A)
Would something like this work ?
list_A2 <- Map(list, x = list_A,nm = names(list_A) )
trace(do_stuff, quote({ nm <- x$nm; x<- x$x}), at=3)
Map(do_stuff, list_A2)
Is it possible to scan a list of lists for elements with a certain name and change their datatype but retain their value?
As an example, the following list containing elements 'N' of class 'character' or 'numeric'
x = list(list(N=as.character(1)),
list(a=1,b=2,c="another element",N=as.character(5)),
list(a=2,b=2,N=as.character(7),c=NULL),
list(a=2,b=2,list(N=as.character(3))))
should then become:
x = list(list(N=as.numeric(1)),
list(a=1,b=2,c="another element",N=as.numeric(5)),
list(a=2,b=2,N=as.numeric(7),c=NULL),
list(a=2,b=2,list(N=as.numeric(3))))
To be clear, the solution should allow for deeper nesting, and respect the data type of fields with names other than "N". I have not been able to find a general solution that works for lists with an arbitrary structure.
I have tried something along the lines of the solution given in this post:
a <- as.relistable(x)
u <- unlist(a)
u[names(u) == "N"] <- as.numeric(u[names(u) == "N"])
relist(u, a)
Unfortunately the substitution does not work in it's current form. In addition, relist does not seem to work in case the list contains NULL elements.
Use lapply to repeat the process over the list elements with a condition to check for your element of interest, so you don't inadvertently add elements to your sublists:
x <- lapply(x, function(i) {
if(length(i$N) > 0) {
i$N <- as.numeric(i$N)
}
return(i)
})
A solution that works only on a list of lists containing numbers or strings with numbers:
x <- list(list(N=as.character(1)),
list(a=1,b=2,N=as.character(5)),
list(a=2,b=2,N=as.character(7)),
list(a=2,b=2))
y1 <- lapply(x, function(y) lapply(y, as.numeric))
y2 <- list(list(N=as.numeric(1)),
list(a=1,b=2,N=as.numeric(5)),
list(a=2,b=2,N=as.numeric(7)),
list(a=2,b=2))
identical(y1,y2)
# [1] TRUE
EDIT. Here is a more general code that works on nested lists of number and strings. It uses a recursive function as_num and the list.apply function of the rlist package.
library(rlist)
x = list(list(N=as.character(1)),
list(a=1,b=2,c="another element",N=as.character(5)),
list(a=2,b=2,N=as.character(7),c=NULL),
list(a=2,b=2,list(N=as.character(3))))
# Test if the string contains a number
is_num <- function(x) grepl("[-]?[0-9]+[.]?[0-9]*|[-]?[0-9]+[L]?|[-]?[0-9]+[.]?[0-9]*[eE][0-9]+",x)
# A recursive function for numeric convertion of strings containing numbers
as_num <- function(x) {
if (!is.null(x)) {
if (class(x)!="list") {
y <- x
if (is.character(x) & is_num(x)) y <- as.numeric(x)
} else {
y <- list.apply(x, as_num)
}
} else {
y <- x
}
return(y)
}
y <- list.apply(x, as_num)
z = list(list(N=as.numeric(1)),
list(a=1,b=2,c="another element",N=as.numeric(5)),
list(a=2,b=2,N=as.numeric(7),c=NULL),
list(a=2,b=2,list(N=as.numeric(3))))
identical(y,z)
# [1] TRUE
The answer provided by marco sandri can be further generalised to:
is_num <- function(x) grepl("^[-]?[0-9]+[.]?[0-9]*|^[-]?[0-9]+[L]?|^[-]?[0-9]+[.]?[0-9]*[eE][0-9]+",x)
as_num <- function(x) {
if (is.null(x)||length(x) == 0) return(x)
if (class(x)=="list") return(lapply(x, as_num))
if (is.character(x) & is_num(x)) return(as.numeric(x))
return(x)
}
y <- as_num(z)
identical(y,z)
This solution also allows for list elements to contain numerical(0) and mixed datatypes such as 'data2005'.
How can I write this all in one line?
mydata is a "zoo" series, limit is a numeric vector of the same size
tmp <- ave(coredata(mydata), as.Date(index(mydata)),
FUN = function(x) cummax(x)-x)
tmp <- (tmp < limit)
final <- ave(tmp, as.Date(index(mydata)),
FUN = function(x) cumprod(x))
I've tried to use two vectors as argument to ave(...) but it seems to accept just one even if I join them into a matrix.
This is just an example, but any other function could be use.
Here I need to compare the value of cummax(mydata)-mydata with a numeric vector and
once it surpasses it I'll keep zeros till the end of the day. The cummax is calculated from the beginning of each day.
If limit were a single number instead of a vector (with different possible numbers) I could write it:
ave(coredata(mydata), as.Date(index(mydata)),
FUN = function(x) cumprod((cummax(x) - x) < limit))
But I can't introduce there a vector longer than x (it should have the same length than each day) and I don't know how to introduce it as another argument in ave().
Seems like this routine imposes intraday stoploss based on maxdrawdown. So I assume you want to be able to pass in variable limit as a second argument to your aggregation function which only currently only takes 1 function due to the way ave works.
If putting all this in one line is not an absolute must, I can share a function I've written that generalizes aggregation via "cut variables". Here's the code:
mtapplylist2 <- function(t, IDX, DEF, MoreArgs=NULL, ...)
{
if(mode(DEF) != "list")
{
cat("Definition must be list type\n");
return(NULL);
}
a <- c();
colnames <- names(DEF);
for ( i in 1:length(DEF) )
{
def <- DEF[[i]];
func <- def[1];
if(mode(func) == "character") { func <- get(func); }
cols <- def[-1];
# build the argument to be called
arglist <- list();
arglist[[1]] <- func;
for( j in 1:length(cols) )
{
col <- cols[j];
grp <- split(t[,col], IDX);
arglist[[1+j]] <- grp;
}
arglist[["MoreArgs"]] <- MoreArgs;
v <- do.call("mapply", arglist);
# print(class(v)); print(v);
if(class(v) == "matrix")
{
a <- cbind(a, as.vector(v));
} else {
a <- cbind(a, v);
}
}
colnames(a) <- colnames;
return(a);
}
And you can use it like this:
# assuming you have the data in the data.frame
df <- data.frame(date=rep(1:10,10), ret=rnorm(100), limit=rep(c(0.25,0.50),50))
dfunc <- function(x, ...) { return(cummax(x)-x ) }
pfunc <- function(x,y, ...) { return((cummax(x)-x) < y) }
# assumes you have the function declared in the same namespace
def <- list(
"drawdown" = c("dfunc", "ret"),
"hasdrawdown" = c("pfunc", "ret", "limit")
);
# from R console
> def <- list("drawdown" = c("dfunc", "ret"),"happened" = c("pfunc","ret","limit"))
> dim( mtapplylist2(df, df$date, def) )
[1] 100 2
Notice that the "def" variable is a list containing the following items:
computed column name
vector arg function name as a string
name of the variable in the input data.frame that are inputs into the function
If you look at the guts of "mtapplylist2" function, the key components would be "split" and "mapply". These functions are sufficiently fast (I think split is implemented in C).
This works with functions requiring multiple arguments, and also for functions returning vector of the same size or aggregated value.
Try it out and let me know if this solves your problem.
I'm trying to change the name of a variable that is included inside a for loop and function call. In the example below, I'd like column_1 to be passed to the plot function, then column_2 etc. I've tried using do.call, but it returns "object 'column_j' not found". But object column_j is there, and the plot function works if I hard-code them in. Help much appreciated.
for (j in 2:12) {
column_to_plot = paste("column_", j, sep = "")
do.call("plot", list(x, as.name(column_to_plot)))
}
I do:
x <- runif(100)
column_2 <-
column_3 <-
column_4 <-
column_5 <-
column_6 <-
column_7 <-
column_8 <-
column_9 <-
column_10 <-
column_11 <-
column_12 <- rnorm(100)
for (j in 2:12) {
column_to_plot = paste("column_", j, sep = "")
do.call("plot", list(x, as.name(column_to_plot)))
}
And I have no errors. Maybe you could provide hard-code which (according to your question) works, then will be simpler to find a reason of the error.
(I know that I can generate vectors using loop and assign, but I want to provide clear example)
You can do it without the paste() command in your for loop. Simply assign the columns via the function colnames() in your loop:
column_to_plot <- colnames(dataframeNAME)[j]
Hope that helps as a first kludge.
Are you trying to retrieve an object in the workspace by a character string? In that case, parse() might help:
for (j in 2:12) {
column_to_plot = paste("column_", j, sep = "")
plot(x, eval(parse(text=column_to_plot)))
}
In this case you could use do.call(), but it would not be required.
Edit: wrapp parse() in eval()
Here is one way to do it:
tmp.df <- data.frame(col_1=rnorm(10),col_2=rnorm(10),col_3=rnorm(10))
x <- seq(2,20,by=2)
plot(x, tmp.df$col_1)
for(j in 2:3){
name.list <- list("x",paste("col_",j,sep=""))
with(tmp.df, do.call("lines",lapply(name.list,as.name))) }
You can also do colnames(tmp.df)[j] instead of paste(..) if you'd like.