我已將資料框拆分為兩個月（6 月和 7 月）。然后我基于ID. 嵌套資料框包含帶有ID和 的data列。
該data列包含一個串列，該串列表示ID一個月內已拆分為三個 10 天間隔的資料。例如，對于ID A，串列顯示[[1]]為一個月內的前 10 天、[[2]]第二個 10 天和[[3]]第三個 10 天。
在接下來的部分，我想下去每個串列中為每個ID并計算最小值之差jDate的nested_june和nested_july，如下所示n1，n2和n3。然后將這些差異組合成一個矩陣，m1。
最后，我有一個包含兩個矩陣的串列l1，我想將串列中的每個矩陣除以m1。
有沒有更有效的方法來計算串列中矩陣的差異和劃分？
library(lubridate)
library(dplyr)
library(tidyr)
library(purrr)
f = function(data){
data %>% mutate(
new = floor_date(data$date, "10 days"),
new = if_else(day(new) == 31, new - days(10), new)
) %>%
group_split(new)
}
ID <- rep(c("A","B","C"), 1000)
date <- rep_len(seq(dmy("01-01-2010"), dmy("31-12-2013"), by = "days"), 500)
x <- runif(length(date), min = 60000, max = 80000)
y <- runif(length(date), min = 800000, max = 900000)
df <- data.frame(date = date,
x = x,
y =y,
ID)
df$jDate <- julian(as.Date(df$date), origin = as.Date("1970-01-01"))
df$Month <- month(df$date)
df_june <- filter(df, Month == c("6"))
df_july <- filter(df, Month == c("7"))
nested_june <- tibble(
df_june
) %>% group_by(ID) %>%
nest() %>%
mutate(data = map(data, f))
nested_july <- tibble(
df_july
) %>% group_by(ID) %>%
nest() %>%
mutate(data = map(data, f))
# Create list of matrices
t1 <- c(100,150,200)
t2 <- c(200,250,350)
t3 <- c(300,350, 400)
mat <- cbind(t1,t2, t3)
t1 <- c(150,150,200)
t2 <- c(250,250,350)
t3 <- c(350,350, 400)
mat2 <- cbind(t1,t2, t3)
l1 <- list(list(mat), list(mat2))
## Hoping to get a function for everything below here ##
# Calculate difference in days from the first day of one interval to the first
# day of the second interval and repeat with the other intervals.
n1 <- c(((min(nested_july[[2]][[1]][[1]]$jDate))- min(nested_june[[2]][[1]][[1]]$jDate)),
((min(nested_july[[2]][[1]][[1]]$jDate))- min(nested_june[[2]][[1]][[2]]$jDate)),
((min(nested_july[[2]][[1]][[1]]$jDate))- min(nested_june[[2]][[1]][[3]]$jDate)))
n2 <- c(((min(nested_july[[2]][[1]][[2]]$jDate))- min(nested_june[[2]][[1]][[1]]$jDate)),
((min(nested_july[[2]][[1]][[2]]$jDate))- min(nested_june[[2]][[1]][[2]]$jDate)),
((min(nested_july[[2]][[1]][[2]]$jDate))- min(nested_june[[2]][[1]][[3]]$jDate)))
n3 <- c(((min(nested_july[[2]][[1]][[3]]$jDate))- min(nested_june[[2]][[1]][[1]]$jDate)),
((min(nested_july[[2]][[1]][[3]]$jDate))- min(nested_june[[2]][[1]][[2]]$jDate)),
((min(nested_july[[2]][[1]][[3]]$jDate))- min(nested_june[[2]][[1]][[3]]$jDate)))
m1 <- cbind(n1,n2,n3)
# Expected output as matrices
l1[[1]][[1]]/m1
l1[[2]][[1]]/m1
uj5u.com熱心網友回復：
試試 lapply
lapply(l1, function(sub) {sub <- lapply(sub, `/`, m1)
sub})
-輸出
[[1]]
[[1]][[1]]
t1 t2 t3
[1,] 3.333333 5.000000 6.00000
[2,] 7.500000 8.333333 8.75000
[3,] 20.000000 17.500000 13.33333
[[2]]
[[2]][[1]]
t1 t2 t3
[1,] 5.0 6.250000 7.00000
[2,] 7.5 8.333333 8.75000
[3,] 20.0 17.500000 13.33333
要創建matrix，我們可以做到
library(tidyr)
library(purrr)
library(dplyr)
m2 <- crossing(i1 = seq_len(nrow(nested_july)),
i2 = seq_len(nrow(nested_june))) %>%
transmute(new =map2_dbl(i1, i2,
~ min(nested_july[[2]][[1]][[.x]]$jDate) -
min(nested_june[[2]][[1]][[.y]]$jDate))) %>%
pull(new) %>%
matrix(ncol = 3)
-檢查
> m2
[,1] [,2] [,3]
[1,] 30 40 50
[2,] 20 30 40
[3,] 10 20 30
OP的'm1
> m1
n1 n2 n3
[1,] 30 40 50
[2,] 20 30 40
[3,] 10 20 30
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/338779.html