I have a some dataframes q1[[i]] and q2[[i]] contain some (i = 19) lists. For example:
q1
[[1]]
[1] 240.13777778 273.73777778 172.73555556 53.70444444 141.80000000 582.93333333
[[2]]
[1] 2.409867e+02 2.731156e+02 1.680622e+02 5.300222e+01 5.112444e+01 1.048476e+03
...
q2
[[1]]
[1] 70.29000000 69.57666667 48.82000000 22.19000000 31.44666667 143.34000000
[[2]]
[1] 70.2066667 69.5533333 47.9766667 22.0866667 14.0000000 270.3766667
I want to create list, contain such fragments:
qw1
[[1]]
[1] 240.13777778
[1] 70.29000000
[[1]]
[2] 273.73777778
[2] 69.57666667
qw2
[[2]]
[1] 2.409867e+02
[1] 70.2066667
[[2]]
[2] 2.731156e+02
[2] 69.5533333
...
and calculate norm for each block (for example)
qw2
[[2]]
[1] 2.409867e+02 -> norm
[1] 70.2066667
...
[[2]]
[2] 2.731156e+02 -> norm
[2] 69.5533333
and create new normlist for plotting (19 lists, insofar as i = 19).
I try to crete same list, but I get only last normlist:
for (i in 1:19){
q1[[i]] <- dfL_F[[assemble_normal[i]]]/0.000450
q2[[i]] <- dfL_RMF[[assemble_normal[i]]]/0.000300
q3[[i]] <- dfL_D[[assemble_normal[i]]]/0.001800
q4[[i]] <- dfL_RMD[[assemble_normal[i]]]/0.001200
length(q1[[i]])
length(q2[[i]])
length(q3[[i]])
length(q4[[i]])
qw1 <- lapply(q1[[i]], `[[`, 1)
qw2 <- lapply(q2[[i]], `[[`, 1)
qw3 <- lapply(q3[[i]], `[[`, 1)
qw4 <- lapply(q4[[i]], `[[`, 1)
nn <- list()
for (j in 1:length(q1[[i]])){
nn[[j]] <- c(qw1[j],qw2[j],qw3[j],qw4[j])
}
qnorm1 <- list()
for (k in 1:length(nn)){
qnorm1[[k]] <- norm(do.call(rbind, lapply(nn[k], as.numeric)),type = "i")
}
}
And I don't know how to get 19 lists contatin two fields for each lists q1[[i]] and q2[[i]], that form a block, there must be such blocks length (q1[[i]]) for each i (length (q1[[i]]) = length (q2[[i]]))?
Code reproducible:
dput(q1)
list(c(240.137777777778, 273.737777777778, 172.735555555556,
53.7044444444444, 141.8, 582.933333333333),c(240.986666666667, 273.115555555556, 168.062222222222, 53.0022222222222, 51.1244444444444, 1048.47555555556)
dput(q2)
list(c(70.29, 69.5766666666667, 48.82, 22.19, 31.4466666666667,
143.34),c(70.2066666666667, 69.5533333333333, 47.9766666666667, 22.0866666666667, 14, 270.376666666667)
dput(qnorm1)
list(305.738611111111, 365.616666666667, 666.443055555556, 608.981111111111, 393.538611111111, 142.288055555556)
But it's only last list qnorm, there should be 19 such lists and they need to be written in general list.
P.S. As a result, I got the required list, but I can't calculate the norm for each block, I get an empty list at the output... Why?
qw <- Map(
function(q1i, q2i) {
stopifnot(length(q1i) == length(q2i))
Map(c, q1i, q2i) # j elementh i block q1[[i]][j], q2[[i]][j]
},
q1, q2 # every block conatin q1[[i]], q2[[i]]
)
# list qw conatin blocks qw1, qw2
stopifnot(length(qw1) == length(qw2))
qnorm11 <- Map(
function(qw1, qw2, qw3, qw4)
{
stopifnot(length(qw1) == length(qw2))
Map(c, (norm(as.matrix(unlist(qw1),type = "1"))),
(norm(as.matrix(unlist(qw2),type = "1"))),
(norm(as.matrix(unlist(qw3),type = "1"))),
(norm(as.matrix(unlist(qw4),type = "1"))))
}, qw1, qw2, qw3, qw4)
Perhaps you can try this
list2env(
setNames(
Map(function(x, y) apply(rbind(x, y), 2, function(v) norm(t(v)), simplify = FALSE), q1, q2),
c("qw1", "qw2")
),
envir = .GlobalEnv
)
Related
I have a vector as follows:
playtimes <- c("1H18M20S", "1H27M5S", "18M27S", "56M38S", "21S")
and I want to convert these to playtimes in second. For example, the resulting vector would be something like this:
playtimeInSeconds <- c(4700, 5225, 1107, 3398, 21)
Im having trouble with separating the strings correctly based on the H, M and S. I wrote the following that works for the playtimes under 1 hour
minutes <- gsub("M.*", "", playtime)
seconds <- gsub(".*M", "", playtime) %>%
gsub("S", "", .)
totalPlaytime <- as.numeric(minutes)*60 + as.numeric(seconds)
But Im not sure how to tackle the H portion of some strings.
You could strsplit and adapt the length of the list elements reversely to 3 which allows you to use sapply to get a matrix where you apply the matrix product %*%.
m <- sapply(strsplit(p, 'H|M|S'), \(x) as.double(rev(`length<-`(rev(x), 3))))
res <- as.vector(t(replace(m, is.na(m), 0)) %*% rbind(3600, 60, 1))
res
# [1] 4700 5225 1107 3398 21
interesting problem. here is a solution that potentially could be more efficient but does the job
# function from https://www.statworx.com/de/blog/strsplit-but-keeping-the-delimiter/
strsplit <- function(x,
split,
type = "remove",
perl = FALSE,
...) {
if (type == "remove") {
# use base::strsplit
out <- base::strsplit(x = x, split = split, perl = perl, ...)
} else if (type == "before") {
# split before the delimiter and keep it
out <- base::strsplit(x = x,
split = paste0("(?<=.)(?=", split, ")"),
perl = TRUE,
...)
} else if (type == "after") {
# split after the delimiter and keep it
out <- base::strsplit(x = x,
split = paste0("(?<=", split, ")"),
perl = TRUE,
...)
} else {
# wrong type input
stop("type must be remove, after or before!")
}
return(out)
}
# convert to seconds
to_seconds <- c(H = 60 * 60,
M = 60,
S = 1)
get_seconds <- function(value, unit) {
value * to_seconds[unit]
}
# example vector
playtimes <- c("1H18M20S", "1H27M5S", "18M27S", "56M38S", "21S")
# extract time parts
times <- strsplit(playtimes,
split = "[A-Z]",
type = "after")
times
#> [[1]]
#> [1] "1H" "18M" "20S"
#>
#> [[2]]
#> [1] "1H" "27M" "5S"
#>
#> [[3]]
#> [1] "18M" "27S"
#>
#> [[4]]
#> [1] "56M" "38S"
#>
#> [[5]]
#> [1] "21S"
# calculate each time in seconds
sapply(times,
function(t) {
# split numeric and unit part
t_split <- strsplit(x = t,
split = "[A-Z]",
type = "before")
# calculate seconds for each unit part
times_in_seconds <- get_seconds(value = as.numeric(sapply(t_split, `[`, 1)),
unit = sapply(t_split, `[`, 2))
# sum of all parts
sum(times_in_seconds)
})
#> [1] 4700 5225 1107 3398 21
I followed the example given in the 3rd answer here and made the following
playtime <- sapply(playtime, function(x){paste(paste(rep(0, 3 - str_count(x, '[0-9]+')), collapse = ' '), x)})
totalPlaytime <- time_length(hms(playtime))
Short, sweet, and checks for potential errors where the playtime is less that 1 hr or less than 1 min.
We can use append function to add element to list. For example like blow.
a_list <- list()
a_list <- append(a_list, "a")
But I want do to like this. The append_new don't return but change the a_list.
a_list <- list()
append_new(a_list, "a")
It can be used by eval function to do this.
a_list <- list()
eval(parse(text="a_list[[1]]<-a"))
a_list
But if I want to write the function add_element_to_list.
a_list <- list()
add_element_to_list(a_list, "a")
a_list ## same as list("a")
How to write the function? This function like assign but more powerful.
The post use eval(parse(text="")) but it can not write in the custom function append_new.
Simpler:
`append<-` <- function(x, value) {
c(x, value)
}
x <- as.list(1:3)
y <- as.list(1:3)
append(x) <- y
append(x) <- "a"
print(x)
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
[[4]]
[1] 1
[[5]]
[1] 2
[[6]]
[1] 3
[[7]]
[1] "a"
Using evil parse:
append_new <- function(x, y){
eval(parse(text = paste0(x, "[ length(", x, ") + 1 ]<<- '", y, "'")))
}
a_list <- list()
append_new(x = "a_list", y = "a")
a_list
# [[1]]
# [1] "a"
append_new(x = "a_list", y = "b")
a_list
# [[1]]
# [1] "a"
#
# [[2]]
# [1] "b"
Perhaps something like this?
add_element_to_list <- function(this, that)
{
if(typeof(this) != "list") stop("append_new requires a list as first argument")
assign(deparse(substitute(this)),
append(this, that),
envir = parent.frame(),
inherits = TRUE)
}
a_list <- list()
add_element_to_list(a_list, "a")
a_list
#> [[1]]
#> [1] "a"
add_element_to_list(a_list, "b")
a_list
#> [[1]]
#> [1] "a"
#>
#> [[2]]
#> [1] "b"
I would be very cautious in using something like this in a package though, since it is not idiomatic R. In general, R users expect functions not to modify existing objects but to return new objects.
Of course there are some notable exceptions...
I am fetching bins.txt and saving its data in "data". I tried printing it and it is printing properly.
data <- read.csv("bins.txt", header = FALSE)
for (n in 1:24060)
{
j=(data[n,])
for (i in 1:20)
{
m=(i-1)*80
n=(i*80)-1
if(m<j && j<n)
{
print (i)
}
}
}
I wish to not print(i) but store the values of i in some vector and print it outside the loop and pass it in
obs="vector"
Somewhat like this
No idea what your bins.txt is. Since I really dislike nested loops, here's a suggestion:
(i) define the twenty pairs of min (or m) and max (or j) values in condition check:
m <- lapply(1:20, function(x) (x-1)*80)
n <- lapply(1:20, function(x) (x*80)-1)
(ii) return a list of twenty vectors based against data based on the twenty combinations of m and n:
lapply(1:20, function(x) dat[m[[x]] < dat & dat < n[[x]]])
Assuming that your data is
dat <- seq(0, 1000, length.out=50)
The first six vectors returned are:
[[1]]
[1] 20.40816 40.81633 61.22449
[[2]]
[1] 81.63265 102.04082 122.44898 142.85714
[[3]]
[1] 163.2653 183.6735 204.0816 224.4898
[[4]]
[1] 244.8980 265.3061 285.7143 306.1224
[[5]]
[1] 326.5306 346.9388 367.3469 387.7551
[[6]]
[1] 408.1633 428.5714 448.9796 469.3878
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)
Say I have a list:
> fs
[[1]]
NULL
[[2]]
NULL
[[3]]
NULL
[[4]]
[1] 61.90298 58.29699 54.90104 51.70293 48.69110
I want to "reverse fill" the rest of the list by using it's values. Example:
The [[3]] should have the function value of [[4]] pairs:
c( myFunction(fs[[4]][1], fs[[4]][2]), myFunction(fs[[4]][2], fs[[4]][3]), .... )
The [[2]] should have myFunction values of [[3]] etc...
I hope that's clear. What's the right way to do it? For loops? *applys? My last attempt, which leaves 1-3 empty:
n = length(fs)
for (i in rev(1:(n-1)))
child_fs = fs[[i+1]]
res = c()
for (j in 1:(i+1))
up = v(child_fs[j])
do = v(child_fs[j+1])
this_f = myFunction(up, do)
res[j] = this_f
fs[[i]] = res
Make fs easily reproducible
fs <- list(NULL, NULL, NULL, c(61.90298, 58.29699, 54.90104, 51.70293, 48.69110))
To be able to show an example, make a trivial myFunction
myFunction <- function(a, b) {a + b}
You can loop over all but the last positions in fs (in reverse order), and compute each. Just call myFunciton with the vectors which are the next higher position's vectors without the last and without the first element.
for (i in rev(seq_along(fs))[-1]) {
fs[[i]] <- myFunction(head(fs[[i+1]], -1), tail(fs[[i+1]], -1))
}
That assumes myFunction is vectorized (given vectors for inputs, will give a vector for output). If it isn't, you can easily make a version which is.
myFunction <- function(a, b) {a[[1]] + b[[1]]}
for (i in rev(seq_along(fs))[-1]) {
fs[[i]] <- Vectorize(myFunction)(head(fs[[i+1]], -1), tail(fs[[i+1]], -1))
}
In either case, you get
> fs
[[1]]
[1] 453.2 426.8
[[2]]
[1] 233.398 219.802 206.998
[[3]]
[1] 120.200 113.198 106.604 100.394
[[4]]
[1] 61.90298 58.29699 54.90104 51.70293 48.69110
Really, what you have is a starting point
start <- c(61.90298, 58.29699, 54.90104, 51.70293, 48.69110)
a function you want to apply (I made this one up which adds 1 everywhere and deletes the last element)
myFunction <- function(x) head(x + 1, -1L)
and the number of times you want to apply the function (recursively):
n <- 3L
So I would write a function to apply the function n times recursively, then reverse the output list:
apply.n.times <- function(fun, n, x)
if (n == 0L) list(x) else c(list(x), Recall(fun, n - 1L, fun(x)))
rev(apply.n.times(myFunction, n, start))
# [[1]]
# [1] 64.90298 61.29699
#
# [[2]]
# [1] 63.90298 60.29699 56.90104
#
# [[3]]
# [1] 62.90298 59.29699 55.90104 52.70293
#
# [[4]]
# [1] 61.90298 58.29699 54.90104 51.70293 48.69110
Here is a one-line solution (if myFunction can be replaced with something like sum, or in this case rowSums):
Reduce( function(x,y) rowSums( embed(y,2) ), fs, right=TRUE, accumulate=TRUE )
If myFunction needs to accept 2 values and do something with them then this can be expanded a bit to:
Reduce( function(x,y) apply( embed(y,2), 1, function(z) myFunction(z[1],z[2]) ),
fs, right=TRUE, accumulate=TRUE )