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.
Related
I am writing a R equivalent to Pythons 'pop' method. I know 99th percentile has one but I'd prefer my own (practice/understanding/consistency etc).
For reference, pop() takes an object and removes the first item from the object whilt also returning it. So
> l <- c(1,3,5)
> x <- pop(l)
> print(l)
> 3, 5
> print(x)
> 1
I am using assign() to replace the input object with one less the first value and returning said first value from the function.
My question is, how do I get the environment of the input object and use this environment within assign()?
I have tried using pryr::where() which returns 'R_GlobalEnv' but I can't use this value in assign(). Instead the only value I can get to work in assign() is 'globalenv()'.
Posted from mobile so let me know if something doesn't work.
You can implement this in base R, though it's not advised. R is a functional language and functions with side effects are not expected by end-users.
pop <- function(vec)
{
vec_name <- deparse(substitute(vec))
assign(vec_name, vec[-1], envir = parent.frame())
vec[1]
}
a <- c(2, 7, 9)
a
#> [1] 2 7 9
pop(a)
#> [1] 2
a
#> [1] 7 9
pop(a)
#> [1] 7
a
#> [1] 9
Created on 2020-08-15 by the reprex package (v0.3.0)
The following answer is based in this R-Help post, function pop with function getEnvOf from this SO post, both adapted to the question's problem.
getEnvOf <- function(what, which=rev(sys.parents())) {
what <- as.character(substitute(what))
for (frame in which)
if (exists(what, frame=frame, inherits=FALSE))
return(sys.frame(frame))
return(NULL)
}
pop <- function(x){
y <- as.character(substitute(x))
e <- getEnvOf(y)
if(length(x) > 0) {
val <- x[[length(x)]]
assign(y, x[-length(x)], envir = parent.env(e))
val
} else {
msg <- paste(sQuote(y), "length is not > 0")
warning(msg)
NULL
}
}
y <- c(1,3,5)
pop(y)
This also works with lists.
z <- list(1, 2, 5)
pop(z)
w <- list(1, c(2, 4, 6), 5)
pop(w)
#[1] 5
pop(w)
#[1] 2 4 6
pop(w)
#[1] 1
pop(w)
#NULL
#Warning message:
#In pop(w) : ‘w’ length is not > 0
You can do it using pryr::promise_info(l)$env, but it's a very un-R-like thing to do. Functions shouldn't have side effects.
For example,
pop <- function(l) {
info <- pryr::promise_info(l)
if (!is.name(info$code))
stop("Argument expression should be a name.")
result <- l[[1]] # work on lists too
assign(as.character(info$code), l[-1], envir = info$env)
result
}
l <- c(1, 3, 5)
pop(l)
#> Registered S3 method overwritten by 'pryr':
#> method from
#> print.bytes Rcpp
#> [1] 1
l
#> [1] 3 5
Created on 2020-08-15 by the reprex package (v0.3.0)
Edited to add: Interestingly, none of the three answers so far works in complicated situations like this one:
f <- function(x) {
cat("The pop(x) result is", pop(x), "\n")
cat("Now x is ", x, "\n")
cat("Now l is ", l, "\n")
}
l <- c(1, 3, 5)
f(l)
#RuiBarradas's answer gives
The pop(x) result is 5
Now x is 1 3 5
Now l is 1 3 5
(He pops the last value rather than the first which is not a big deal, but neither x nor l is modified.)
#AllanCameron's answer gives
The pop(x) result is 1
Now x is 3 5
Now l is 1 3 5
This is arguably correct (x got popped), but I think it would be nice to have l being popped, and that seems tricky.
My answer dies with this message:
Error in pop(x) : Argument expression should be a name.
which seems like a bug: obviously whether it's getting x or l, it really is a name. The problem seems to be in pryr::promise_info, which returns the compiled code that would return the value of x, rather than just the code for x. If I turn off JIT compiling by compiler::enableJIT(0), I get the same result as #AllanCameron. It's not clear to me how to unwind back the right amount to pop l instead of just x.
m <- matrix(1:4, ncol=2)
l <- list(a=1:3, b='c')
d <- data.frame(a=1:3, b=3:1)
I was wondering if it is possible to make a function that takes a base R object (matrix, vector, list or data.frame, ...) as well as a text that specifies the subset of the object.
f1 <- function(object, subset) {
# object'subset'
}
For instance
f1(m, '[1,1]') #to evaluate m[1,1]
f1(l, '[[1]][2:3]') #l[[1]][2:3]
f1(d, '$a') #d$a
would give us (respectively):
[1] 1
[1] 2 3
[1] 1 2 3
I guess the function need somehow to glue the two arguments before evaluating. I guess one could make a kind of interpreter for each bit of the subset text and the (for the matrix example) do something like:
`[`(1,1)
This would possible but I thought there would be an easier more direct way (my 'glue' above).
Well one way to go is to use eval(parse)) methodology, i.e.
f1 <- function(x, text){
eval(parse(text = paste0(x, text)))
}
f1('d', '$a')
#[1] 1 2 3
f1('m', '[1,1]')
#[1] 1
f1('l', '[[1]][2:3]')
#[1] 2 3
f1<-function(object, subset){
return(eval(parse(text=paste0(substitute(object),subset))))
}
> m=matrix(4,2,2)
> l=list(c(1,2,3),c(2,3,4))
> f1(m,'[1,1]')
[1] 4
> f1(l,'[[1]][1:2]')
[1] 1 2
I want to add two dimensions on the name of the list.
For example,
N <- 3
M <- 2
x <- list()
for(i in 1:N) {
for(j in 1:M){
Ps <- i
x[[paste0("element", i)]] <- Ps
}
}
>x
$element1
[1] 1
$element2
[1] 2
$element3
[1] 3
However, I want to return a result like:
$element1,method1
[1] 1
$element1,method2
[1] 1
$element2,method1
[1] 2
$element2,method2
[1] 2
$element3,method1
[1] 3
$element3,method2
[1] 3
I guess building a three-dimensional "array" may work well on this problem, but I need to use a list because multiple hierarchical time series forecast results only can be stored in a list but cannot be stored in an array. Anyone who can help me solve it? Thank you very much.
You can either use nested lists
x[[paste0("element", i)]][[paste0("method", j)]] <- list(Ps)
or simply make character strings describing what you have
x[[paste0("element", i, ",method", j)]] <- Ps
I have a list of lists, with each sub-list containing 3 values. My goal is to cycle through every value of this nested list in a systematic way (i.e. start with list 1, go through all 3 values, go to list 2, and so on), applying a function to each. But my function hits missing values and breaks and I've traced the problem to the indexing itself, which doesn't behave in the way I am expecting. The lists are constructed as:
pop <- 1:100
treat.temp <- NULL
treat <- NULL
## Generate 5 samples of pop
for (i in 1:5){
treat.temp <- sample(pop, 3)
treat[[i]] <- treat.temp
}
## Create a list with which to index mapply
iterations <- (1:5)
Illustrative function and results.
test.function <- function(j, k){
for (n in 1:3){
print(k[[n]][j])
}
}
results <- mapply(test.function, iterations, treat)
[1] 61
[1] 63
[1] 73
[1] NA
[1] NA
[1] NA
[1] NA
[1] NA
<snipped>
For the first cycle through 'j', this works. But after that it throws NAs. But if I do it manually, it returns the values I would expect.
> print(treat[[1]][1])
[1] 61
> print(treat[[1]][2])
[1] 63
> print(treat[[1]][3])
[1] 73
> print(treat[[2]][1])
[1] 59
> print(treat[[2]][2])
[1] 6
> print(treat[[2]][3])
[1] 75
<snipped>
I'm sure this is a basic question, but I can't seem to find the right search terms to find an answer here or on Google. Thanks in advance!
Edited to Add: MrFlick's answer works well for my problem. I have multiple list inputs (hence mapply) in my actual use. A more detailed example, with a few notes.
pop <- 1:100
years <- seq.int(2000, 2014, 1)
treat.temp <- NULL
treat <- NULL
year.temp <- NULL
year <- NULL
## Generate 5 samples of treated states, control states and treatment years
for (i in 1:5){
treat.temp <- sample(pop, 20)
treat[[i]] <- treat.temp
year.temp <- sample(years, 1)
year[[i]] <- year.temp
}
## Create a list with which to index mapply
iterations <- (1:5)
## Define function
test.function <- function(j, k, l){
for (n in 1:3){
## Cycles treat through each value of jXn
print(k[n])
## Holds treat (k) fixed for each 3 cycle set of n (using first value in each treat sub-list); cycles through sub-lists as j changes
print(k[1])
## Same as above, but with 2nd value in each sub-list of treat
print(k[2])
## Holds year (l) fixed for each 3 cycle set of n, cycling through values of year each time j changes
print(l[1])
## Functionally equivalent to
print(l)
}
}
results <- mapply(test.function, iterations, treat, year)
Well, you might be misunderstanding how mapply works. The function will loop through both of the iterations you pass as parameters, which means treat will also be subset each iteration. Essentially, the functions being called are
test.function(iterations[1], treat[[1]])
test.function(iterations[2], treat[[2]])
test.function(iterations[3], treat[[3]])
...
and you seem to treat the k variable as if it were the entire list. Also, you have your indexes backwards as well. But just to get your test working, you can do
test.function <- function(j, k){
for (n in 1:3) print(k[n])
}
results <- mapply(test.function, iterations, treat)
but this isn't really a super awesome way to iterate a list. What exactly are you trying to accomplish?
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()))