I want to make a list of objects of a particular class in R, go through the list, and change each object according to some criterion. For example:
Duck <- function(grade,cap) {
res <- structure(list(grade=grade,cap=cap),class="Duck")
return(res)
}
Kwik <- Duck(5,0)
Kwek <- Duck(7,0)
Kwak <- Duck(9,0)
# Select all Ducks from the workspace
AllDucks <- Filter( function(x) 'Duck' %in% class( get(x) ), ls() )
# Give each Duck with a grade higher than 5 a cap (i.e. cap is set to 1)
for(i in 1:length(AllDucks)) {
if(get(AllDucks[i])$grade > 5) {
get(AllDucks[i])$cap <- 1
}
}
The expression get(AllDucks[i])$cap <- 1 gives the error message
Error in get(AllDucks[i])$cap <- 1 : could not find function "get<-"
How can I pick an object from a list of objects and change some of its attributes?
Why don't your ducks swim nicely in a pond? You should give them a nice habitat to begin with, but you can also catch them from the wild:
pond <- mget(AllDucks)
pond <- lapply(pond, function(x) {
if (x$grade > 5) x$cap <- 1
x
})
pond$Kwek
# $grade
# [1] 7
#
# $cap
# [1] 1
#
# attr(,"class")
# [1] "Duck"
To reassign into the current environment, you could do
mapply(assign, AllDucks, lapply(mget(AllDucks), function(x) {x$cap<-1; x}),
MoreArgs =list(envir = environment()))
Related
I have a dataframe like this one
ourmodel difference new_topic
1 2 0.08233167 1
2 3 0.07837389 2
3 1 0.15904427 3
4 3 0.05716799 4
5 1 0.13388058 3
6 3 0.09156650 3
and I wish to save each output from the model in the variable out. My approach doesn't seem to work - can anyone see what I'm doing wrong?
This is how I do:
library(rethinking)
out <- list()
for (i in unique(singo$new_topic)) {
i <- ulam(
alist(
difference ~ dnorm(mu, sigma),
mu <- a[ourmodel],
a[ourmodel] ~ dnorm(0.40, 0.15) ,
sigma ~ dexp(2)
), data = final, chains = 4, cores = 4)
out[[i]] <- precis(i, depth = 2)
}
I get the following error
Error in out[[i]] <- precis(i, depth = 2) : invalid subscript type 'S4'
You're making 2 mistakes:
1. You are iterating across S4 objects, rather than integers.
Rather than
for (i in unique(singo$new_topic))
You want
max_i <- length(unique(singo$new_topic))
for (i in 1:max_i)
The error you are getting is because you are iterating over the elements of singo and trying to subset with them, rather than with an integer.
This example might make the nature of the error clearer:
animals <- c("cow", "pig", "sheep")
## This works
for(i in 1:length(animals)){
print(animals[[i]])
}
#> [1] "cow"
#> [1] "pig"
#> [1] "sheep"
## This also works
for(i in animals){
print(i)
}
#> [1] "cow"
#> [1] "pig"
#> [1] "sheep"
## This does not
for(i in animals){
print(animals[[i]])
}
#> Error in animals[[i]]: subscript out of bounds
Created on 2022-11-18 with reprex v2.0.2
2. You are overwriting i
If you want to use i to subset your list, you should not overwrite the value of i in the first line of your list. So do something like:
for(i in 1:max_i){
## don't assign to i here:
j <- ulam(
## some code
)
## Use i as the index, j as the first argument to precis()
out[[i]] <- precis(j, depth = 2)
}
3. Bonus: It's better to make an empty list of the correct lenght.
So try:
out <- vector("list", length = max_i)
To initialise out before you run the for loop. This makes your code clearer and faster to run.
Is it possible to retrieve the function components of a function call? That is, is it possible to use as.list(match.call()) on another function call.
The background is, that I want to have a function that takes a function-call and returns the components of said function call.
get_formals <- function(x) {
# something here, which would behave as if x would be a function that returns
# as.list(match.call())
}
get_formals(mean(1:10))
# expected to get:
# [[1]]
# mean
#
# $x
# 1:10
The expected result is to have get_formals return as match.call() was called within the supplied function call.
mean2 <- function(...) {
as.list(match.call())
}
mean2(x = 1:10)
# [[1]]
# mean2
#
# $x
# 1:10
Another Example
The motivation behind this question is to check if a memoised function already contains the cached values. memoise has the function has_cache() but it needs to be called in a specific way has_cache(foo)(vals), e.g.,
library(memoise)
foo <- function(x) mean(x)
foo_cached <- memoise(foo)
foo_cached(1:10) # not yet cached
foo_cached(1:10) # cached
has_cache(foo_cached)(1:10) # TRUE
has_cache(foo_cached)(1:3) # FALSE
My goal is to log something if the function call is cached or not.
cache_wrapper <- function(f_call) {
is_cached <- has_cache()() # INSERT SOLUTION HERE
# I need to deconstruct the function call to pass it to has_cache
# basically
# has_cache(substitute(expr)[[1L]])(substitute(expr)[[2L]])
# but names etc do not get passed correctly
if (is_cached) print("Using Cache") else print("New Evaluation of f_call")
f_call
}
cache_wrapper(foo_cached(1:10))
#> [1] "Using Cache" # From the log-functionality
#> 5.5 # The result from the function-call
You can use match.call() to do argument matching.
get_formals <- function(expr) {
call <- substitute(expr)
call_matched <- match.call(eval(call[[1L]]), call)
as.list(call_matched)
}
get_formals(mean(1:10))
# [[1]]
# mean
#
# $x
# 1:10
library(ggplot2)
get_formals(ggplot(mtcars, aes(x = mpg, y = hp)))
# [[1]]
# ggplot
#
# $data
# mtcars
#
# $mapping
# aes(x = mpg, y = hp)
library(dplyr)
get_formals(iris %>% select(Species))
# [[1]]
# `%>%`
#
# $lhs
# iris
#
# $rhs
# select(Species)
Edit: Thanks for #KonradRudolph's suggestion!
The function above finds the right function. It will search in the scope of the parent of get_formals(), not in that of the caller. The much safer way is:
get_formals <- function(expr) {
call <- substitute(expr)
call_matched <- match.call(eval.parent(bquote(match.fun(.(call[[1L]])))), call)
as.list(call_matched)
}
The match.fun() is important to correctly resolve functions that are shadowed by a non-function object of the same name. For example, if mean is overwrited with a vector
mean <- 1:5
The first example of get_formals() will get an error, while the updated version works well.
Here's a way to do it that also gets the default values from the function if you didn't supply all the arguments:
get_formals <- function(call)
{
f_list <- as.list(match.call()$call)
func_name <- f_list[[1]]
p_list <- formals(eval(func_name))
f_list <- f_list[-1]
ss <- na.omit(match(names(p_list), names(f_list)))
if(length(ss) > 0) {
p_list[na.omit(match(names(f_list), names(p_list)))] <- f_list[ss]
f_list <- f_list[-ss]
}
unnamed <- which(!nzchar(sapply(p_list, as.character)))
if(length(unnamed) > 0)
{
i <- 1
while(length(f_list) > 0)
{
p_list[[unnamed[i]]] <- f_list[[1]]
f_list <- f_list[-1]
i <- i + 1
}
}
c(func_name, p_list)
}
Which gives:
get_formals(rnorm(1))
[[1]]
rnorm
$n
[1] 1
$mean
[1] 0
$sd
[1] 1
get_formals(ggplot2::ggplot())
[[1]]
ggplot2::ggplot
$data
NULL
$mapping
aes()
$...
$environment
parent.frame()
To get this to work one level in you could do something like:
foo <- function(f_call) {
eval(as.call(list(get_formals, call = match.call()$f_call)))
}
foo(mean(1:10))
[[1]]
mean
$x
1:10
$...
This answer is mostly based on Allens answer, but implements Konrads comment regarding the eval and eval.parent functions.
Additionally, some do.call is thrown in to finalise the cache_wrapper from the example above:
library(memoise)
foo <- function(x) mean(x)
foo_cached <- memoise(foo)
foo_cached(1:10) # not yet cached
#> [1] 5.5
foo_cached(1:10) # cached
#> [1] 5.5
has_cache(foo_cached)(1:10)
#> [1] TRUE
has_cache(foo_cached)(1:3)
#> [1] FALSE
# As answered by Allen with Konrads comment
get_formals <- function(call) {
f_list <- as.list(match.call()$call)
func_name <- f_list[[1]]
# changed eval to eval.parent as suggested by Konrad...
p_list <- formals(eval.parent(eval.parent(bquote(match.fun(.(func_name))))))
f_list <- f_list[-1]
ss <- na.omit(match(names(p_list), names(f_list)))
if(length(ss) > 0) {
p_list[na.omit(match(names(f_list), names(p_list)))] <- f_list[ss]
f_list <- f_list[-ss]
}
unnamed <- which(!nzchar(sapply(p_list, as.character)))
if(length(unnamed) > 0) {
i <- 1
while(length(f_list) > 0) {
p_list[[unnamed[i]]] <- f_list[[1]]
f_list <- f_list[-1]
i <- i + 1
}
}
c(func_name, p_list)
}
# check if the function works with has_cache
fmls <- get_formals(foo_cached(x = 1:10))
do.call(has_cache(eval(parse(text = fmls[1]))),
fmls[2])
#> [1] TRUE
# implement a small wrapper around has_cache that reports if its using cache
cache_wrapper <- function(f_call) {
fmls <- eval(as.call(list(get_formals, call = match.call()$f_call)))
is_cached <- do.call(has_cache(eval(parse(text = fmls[1]))),
fmls[2])
if (is_cached) print("Using Cache") else print("New Evaluation of f_call")
f_call
}
cache_wrapper(foo_cached(x = 1:10))
#> [1] "Using Cache"
#> [1] 5.5
cache_wrapper(foo_cached(x = 1:30))
#> [1] "New Evaluation of f_call"
#> [1] 5.5
This is a trivial question, but I'm stumped. How can I filter a list of dataframes based on their length? The list is nested -- meaning there are lists of lists of dataframes of different lengths. Here is an example. I'd like to filter or subset the list to include only those objects that are length n, say 3.
Here is an example and my current approach.
library(tidyverse)
# list of list with arbitrary lengths
star.wars_ls <- list(starwars[1:5],
list(starwars[1:8], starwars[4:6]),
starwars[1:2],
list(starwars[1:7], starwars[2:6]),
starwars[1:3])
# I want to filter the list by dataframes that are 3 variables long (i.e. length(df == 3).
# Here is my attempt, I'm stuck at how to obtain
# the number of varibles in each dataframe and then filter by it.
map(star.wars_ls, function(x){
map(x, function(x){ ## Incorrectly returns 20 for all
length(y)
})
})
We can do
map(star.wars_ls, ~ if(is.data.frame(.x)) .x[length(.x) == 3] else map(.x, ~ .x[length(.x) == 3]))
You should be able to check whether the item in the star.wars_ls is a list or a data frame. Then, check the number of columns within each item. Try using:
library(tidyverse)
# list of list with arbitrary lengths
star.wars_ls <- list(starwars[1:5],
list(starwars[1:8], starwars[4:6]),
starwars[1:2],
list(starwars[1:7], starwars[2:6]),
starwars[1:3])
# I want to filter the list by dataframes that are 3 variables long (i.e. length(df == 3).
datacols <- map(star.wars_ls, function(X) {
if (is.data.frame(X) == T) {
ncol(X) }
else {
map(X, function(Y) {
ncol(Y)
})
}
}
)
# > datacols
# [[1]]
# [1] 5
#
# [[2]]
# [[2]][[1]]
# [1] 8
#
# [[2]][[2]]
# [1] 3
#
#
# [[3]]
# [1] 2
#
# [[4]]
# [[4]][[1]]
# [1] 7
#
# [[4]][[2]]
# [1] 5
#
#
# [[5]]
# [1] 3
This will only give you the length (number of columns) of each data frame within the list. To get the indices (I'm sure there's a more efficient way to do this -- maybe someone else can help with that):
indexlist <- c()
for (i in 1:length(datacols)) {
if (length(datacols[[i]]) == 1) {
if (datacols[[i]][1] == 3) {
index <- i
indexlist <- c(indexlist, as.character(index))
}
} else {
for (j in 1:length(datacols[[i]])) {
if (datacols[[i]][[j]][1] == 3) {
index <- str_c(i, ",", j)
indexlist <- c(indexlist, index)
}
}
}
}
# > indexlist
# [1] "2,2" "5"
you could use recursion. It doesnt matter how deeply nested the list is:
ff = function(x)map(x,~if(is.data.frame(.x)){if(length(.x)==3) .x} else ff(.x))
ff(star.wars_ls)
This question already has answers here:
Access lapply index names inside FUN
(12 answers)
Closed 8 years ago.
I have a time series (x,y,z and a) in a list name called dat.list. I would like to apply a function to this list using lapply. Is there a way that I can print the element names i.e., x,y,z and a after each iteration is completed in lapply. Below is the reproducible example.
## Create Dummy Data
x <- ts(rnorm(40,5), start = c(1961, 1), frequency = 12)
y <- ts(rnorm(50,20), start = c(1971, 1), frequency = 12)
z <- ts(rnorm(50,39), start = c(1981, 1), frequency = 12)
a <- ts(rnorm(50,59), start = c(1991, 1), frequency = 12)
dat.list <- list(x=x,y=y,z=z,a=a)
## forecast using lapply
abc <- function(x) {
r <- mean(x)
print(names(x))
return(r)
}
forl <- lapply(dat.list,abc)
Basically, I would like to print the element names x,y,z and a every time the function is executed on these elements. when I run the above code, I get null values printed.
The item names do not get passed to the second argument from lapply, only the values do. So if you wanted to see the names then the calling strategy would need to be different:
> abc <- function(nm, x) {
+ r <- mean(x)
+ print(nm)
+ return(r)
+ }
>
> forl <- mapply(abc, names(dat.list), dat.list)
[1] "x"
[1] "y"
[1] "z"
[1] "a"
You can use some deep digging (which I got from another answer on SO--I'll try to find the link) and do something like this:
abc <- function(x) {
r <- mean(x)
print(eval.parent(quote(names(X)))[substitute(x)[[3]]])
return(r)
}
forl <- lapply(dat.list, abc)
# [1] "x"
# [1] "y"
# [1] "z"
# [1] "a"
forl
# $x
# [1] 5.035647
#
# $y
# [1] 19.78315
#
# $z
# [1] 39.18325
#
# $a
# [1] 58.83891
Our you can just lapply across the names of the list (similar to what #BondedDust did), like this (but you lose the list names in the output):
abc <- function(x, y) {
r <- mean(y[[x]])
print(x)
return(r)
}
lapply(names(dat.list), abc, y = dat.list)
I'm trying to add elements to a list in a for loop. How can I set the field name?
L <- list()
for(i in 1:N)
{
# Create object Ps...
string <- paste("element", i, sep="")
L$get(string) <- Ps
}
I want every element of the list to have the field name dependent from i (for example, the second element should have "element2")
How to do this? I think that my error is the usage of get
It seems like you're looking for a construct like the following:
N <- 3
x <- list()
for(i in 1:N) {
Ps <- i ## where i is whatever your Ps is
x[[paste0("element", i)]] <- Ps
}
x
# $element1
# [1] 1
#
# $element2
# [1] 2
#
# $element3
# [1] 3
Although, if you know N beforehand, then it is better practice and more efficient to allocate x and then fill it rather than adding to the existing list.
N <- 3
x <- vector("list", N)
for(i in 1:N) {
Ps <- i ## where i is whatever your Ps is
x[[i]] <- Ps
}
setNames(x, paste0("element", 1:N))
# $element1
# [1] 1
#
# $element2
# [1] 2
#
# $element3
# [1] 3