I have data as follows:
alist <- list()
vec <- c(1, 2, 3)
I want to put a value (in this case an object), into a sublist. But when I do:
for (i in 1:length(vec)) {
alist[[i]][1] <- vec
}
this is for some reason not allowed: Error in *tmp* [[i]] : subscript out of bounds.
Do I have to intialise every sublist? If so, what is the syntax for doing that?
Desired outcome:
desired_out <- list( list(alist = c(1, 2, 3) ), list(alist = c(1, 2, 3) ), list(alist = c(1, 2, 3) ))
EDIT:
An attempt to create a reproducible example for the entire loop (my actual data is a loop within a loop):
alist <- list()
vec <- c(1, 2, 3)
for (j in 1:2) {
for (i in 1:length(vec)) {
alist[[i]][j] <- vec
}
}
Create an empty list with length then fill it in:
x <- vector(mode = "list", length = 3)
for (j in 1:2) {
for (i in 1:length(vec)) {
# notice double square brackets
x[[ i ]][[ j ]] <- vec
}
}
This does what you ask for, but I think your example is still to minimal for your original nested loop problem:
alist <- list()
vec <- c(1, 2, 3)
for (i in 1:length(vec)) {
alist[[i]] <- list(alist = vec)
}
desired_out <- list(
list(alist = c(1, 2, 3)),
list(alist = c(1, 2, 3)),
list(alist = c(1, 2, 3))
)
identical(alist, desired_out)
#> [1] TRUE
Created on 2021-11-05 by the reprex package (v2.0.1)
Related
I am trying to save the results of all interactions, but for loop only gives me the result of last interaction. Just like this:
l <- list(a = c(1, 3, 5), b = c(4, 8), c = 2)
df <- data.frame()
for (i in 1:length(l)) {
s <- data.frame(name = names(l[i]),
value = mean(l[[i]]))
out <- rbind(df, s)
}
This code returns this:
I need to something like this:
How can I solve this?
Thanks in advance!
Your out variable only contains the result of the last iteration since out is overriden in every iteration of the loop.
Replace out by df like so, your expected result will be in the df variable:
l <- list(a = c(1, 3, 5), b = c(4, 8), c = 2)
df <- data.frame()
for (i in 1:length(l)) {
s <- data.frame(name = names(l[i]),
value = mean(l[[i]]))
df <- rbind(df, s)
}
df
To keep my script records clean, I'd like to output vector inputs with rep() instead of repeated values in chain. Please see my example below, using dput():
v<-c(rep(1,2), rep(2,4), rep(NA,5))
dput(v)
>c(1, 1, 2, 2, 2, 2, NA, NA, NA, NA, NA)
unknown_function(v)
>c(rep(1,2), rep(2,4), rep(NA,5))
Surely trivial, but I cannot find any simple solution. Suggestions for unknown_function(), please?
rle will compute the values and lengths and from that we can paste it together:
with(rle(format(v)), paste0("c(", toString(paste0("rep(", values, ",", lengths, ")")), ")"))
## [1] "c(rep( 1,2), rep( 2,4), rep(NA,5))"
You can write a function using the stucture of rle and change it to crunch also NA and combine it with the method from #g-grothendieck.
dputRle <- function (x, nmin=3) {
if (!is.vector(x) && !is.list(x))
stop("'x' must be a vector of an atomic type")
n <- length(x)
if (n <= 1L)
return(x)
y <- x[-1L] != x[-n] | is.na(x[-1L]) != is.na(x[-n])
i <- c(which(y), n)
lengths = diff(c(0L, i))
paste0("c(", toString(unlist(sapply(seq(i), function(y) {
if(lengths[y] <= nmin) {rep(x[i[y]], lengths[y])
} else {paste0("rep(", x[i[y]], ",", lengths[y], ")")}
}))), ")")
}
v <- c(rep(1,2), rep(2,4), rep(NA,5), 1)
dputRle(v, 1)
#[1] "c(rep(1,2), rep(2,4), rep(NA,5), 1)"
dputRle(v)
#"c(1, 1, rep(2,4), rep(NA,5), 1)"
v <- 1
dputRle(v)
#[1] 1
v <- numeric(0)
dputRle(v)
#numeric(0)
Or alternative.
dputRle2 <- function (x) {
if (!is.vector(x) && !is.list(x))
stop("'x' must be a vector of an atomic type")
n <- length(x)
if (n <= 1L)
return(x)
y <- x[-1L] != x[-n] | is.na(x[-1L]) != is.na(x[-n])
i <- c(which(y), n)
paste0("rep(c(", toString(x[i]), "), c(", toString(diff(c(0L, i))), "))")
}
v <- c(rep(1,2), rep(2,4), rep(NA,5), 1)
dputRle2(v)
#[1] "rep(c(1, 2, NA, 1), c(2, 4, 5, 1))"
There are some ways to use rle with c and rep. All of the following will produce the same vector.
c(1, 2, 2, 3, 3, 3)
c(1, rep(2, 2), rep(3, 3))
c(1, rep(c(2, 3), c(2, 3)))
rep(c(1, 2, 3), c(1, 2, 3))
rep(1:3, 1:3)
I made a calculation for a nested loop, then I tried to transform it to lapply but it doesn't show the same result, do you know why is it? This is my code:
#list
l <- list()
l[[1]] <- matrix(c(4, 3, 20, 10), ncol=2)
l[[2]] <- matrix(c(3, 3, 40, 12), ncol=2)
l[[3]] <- matrix(c(2, 3, 60, 10), ncol=2)
#loop
##index
s <- 1:length(l)
#for loop
zzz <- list()
for (i in s){
zzz[[i]] <- apply(X = l[[i]], MARGIN = 1,
FUN = function(x) spDistsN1(l[[i]], x, longlat = T))
zzz
}
#lapply loop
yyy <- lapply(s, function(x){
apply(X = l[[i]], MARGIN = 1,
FUN = function(x) spDistsN1(l[[i]], x, longlat = T))
})
And they output aren't identical, why?
identical(zzz,yyy)
[1] FALSE
We can change the code to
library(sp)
yyy <- lapply(s, function(i) apply(l[[i]], 1, FUN= function(x)
spDistsN1(l[[i]], x, longlat = TRUE)))
identical(zzz, yyy)
#[1] TRUE
In the OP's code, the anonymous function call used in both function is x, so within the spDistsN1, the x was coming from the whole matrix instead of the row
I'm trying to subtract each unique pair-wise ps from the for loop in my function below. To do so, I first find unique pair-wise ps using combn(p, 2) and second use outer to subtract each unique pair from each other.
In both steps, I get error. Is there a fix for the error?
prop <- function(n, yes, a, b = a){
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
outer(combn(p, 2), FUN = "-") # Gives Error
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3))
By default, it is simplify = TRUE in combn. So, even though the output is a list, it is simplified to have a dim attribute by converting each of the the list as elements in a matrix. As the m is 2, there are 2 list elements for each comparison, extract those elements using [[ and subtract
combn(p, 2, FUN = function(x) x[[1]]- x[[2]])
-full function
prop <- function(n, yes, a, b = a){
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
combn(p, 2, FUN = function(x) x[[1]]- x[[2]])
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3))
If we wanted to include another argument how
prop <- function(n, yes, a, b = a, how= "one.two"){
delta <- switch(how,
one.two = function(x) x[[1]] - x[[2]],
two.one = function(x) x[[2]] - x[[1]])
p <- list()
for(i in 1:length(n)){
p[[i]] <- rbeta(2, a[i] + yes[i], b[i] + (n[i] - yes[i]))
}
out <- combn(p, 2, FUN = delta)
nm1 <- paste0("p", combn(seq_along(p), 2, FUN = paste, collapse="-"))
colnames(out) <- nm1
out
}
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3), how = "one.two")
prop(n = c(10, 20, 30), yes = rep(5, 3), a = rep(1, 3), how = "two.one")
I have two vectors, which I would like to combine in one dataframe. One of the vectors values needs to be divided into two columns. The second vector nc informs about the number of values for each observation. If nc is 1, only one value is given in values (which goes into val1) and 999 is to be written in the second column (val2).
What is an r-ish way to divide vector value and populate the two columns of df? I suspect I miss something very obvious, but can't proceed at the moment...Many thanks!
set.seed(123)
nc <- sample(1:2, 10, replace = TRUE)
value <- sample(1:6, sum(nc), replace = TRUE)
# result by hand
df <- data.frame(nc = nc,
val1 = c(6, 3, 4, 1, 2, 2, 6, 5, 6, 5),
val2 = c(999, 5, 999, 6, 1, 999, 6, 4, 4, 999))
Here's an approach based on this answer:
set.seed(123)
nc <- sample(1:2, 10, replace = TRUE)
value <- sample(1:6, sum(nc), replace = TRUE)
splitUsing <- function(x, pos) {
unname(split(x, cumsum(seq_along(x) %in% cumsum(replace(pos, 1, pos[1] + 1)))))
}
combineValues <- function(vals, nums) {
mydf <- data.frame(cbind(nums, do.call(rbind, splitUsing(vals, nums))))
mydf$V3[mydf$nums == 1] <- 999
return(mydf)
}
df <- combineValues(value, nc)
I think this is what you are looking for. I'm not sure it is the fastest way, but it should do the trick.
count <- 0
for (i in 1:length(nc)) {
count <- count + nc[i]
if(nc[i]==1) {
df$val1[i] <- value[count]
df$val2[i] <- 999
} else {
df$val1[i] <- value[count-1]
df$val2[i] <- value[count]
}
}