我有三个带有值向量的列表，如何将所有三个列表的值放在同一个索引处到现有数据框中？
I have three lists with a vector of values, how can I put all three list's values at the same index into an existing dataframe?
一个完全可重现的例子。现在的问题是创建的新列在所有值的 c() 中，而不是每个值都在它的单独行中。
date = seq(as.Date("2019/01/01"), by = "month", length.out = 48)
productB = rep("B",48)
productB = rep("B",48)
productA = rep("A",48)
productA = rep("A",48)
subproducts1=rep("1",48)
subproducts2=rep("2",48)
subproductsx=rep("x",48)
subproductsy=rep("y",48)
b1 <- c(rnorm(30,5), rep(0,18))
b2 <- c(rnorm(30,5), rep(0,18))
b3 <-c(rnorm(30,5), rep(0,18))
b4 <- c(rnorm(30,5), rep(0,18))
创建了下面的数据框
dfone <- data.frame("date"= rep(date,4),
"product"= c(rep(productB,2),rep(productA,2)),
"subproduct"=
c(subproducts1,subproducts2,subproductsx,subproductsy),
"actuals"= c(b1,b2,b3,b4))
export_df <- split(dfone[1:4], dfone[3])
# Creation of data frames based off UNIQUE SUBPRODUCTS
dummy_list <- split(dfone[1:4], dfone[3]) %>% lapply( function(x)
x[(names(x) %in% c("date", "actuals"))])
dummy_list <- lapply(dummy_list, function(x) { x["date"] <- NULL; x })
list_dfs <- list()
for (i in 1:length(unique(dfone$subproduct))) {
#assign(paste0("df", i), as.data.frame(dummy_list[[i]]))
list_dfs <-append(list_dfs,dummy_list[[i]])
}
combined_dfs <- Reduce(function(x, y) merge(x, y, all = TRUE,
by='date'), list(list_dfs))
创建时间序列
list_ts <- lapply(list_dfs, function(t)
ts(t,start=c(2019,1),end=c(2021,6), frequency = 12)) %>%
lapply( function(t) ts_split(t,sample.out=(0.2*length(t)))) #
creates my train test split
list_ts <- do.call("rbind", list_ts) #Creates a list of time series
创建模型
model_tune_ses1 <- lapply(list_ts[1:(length(list_ts)/2)], function(x)
forecast::forecast(ses(x,h=24,alpha=0.1)))
model_tune_ses1 <- lapply(model_tune_ses1, "[", c("mean"))
model_tune_ses2 <- lapply(list_ts[1:(length(list_ts)/2)], function(x)
forecast::forecast(ses(x,h=24,alpha=0.2)))
model_tune_ses2 <- lapply(model_tune_ses2, "[", c("mean"))
model_trp_holt_mult <- lapply(list_ts[1:(length(list_ts)/2)],
function(x)
forecast::forecast( HoltWinters(x,seasonal="multiplicative"),h=24))
model_trp_holt_mult <- lapply(model_trp_holt_mult, "[", c("mean"))
lst1 <- do.call(Map, c(f = cbind, mget(ls(pattern = 'model_'))))
export_df1 <- Map(cbind, export_df, lst1)
export_df1 <- bind_rows(export_df1, .id = "date")
我删除了其他编辑以节省更多 space。
编辑2：
export_df1[[6]]
[[1]]
Jan Feb Mar Apr May Jun Jul Aug
Sep Oct Nov Dec
2021 6.508872 4.639274 4.678671 4.626766 5.327353 6.890269 6.640483
6.164311 5.317675 6.152747 5.963053 5.243159
2022 6.517052 4.645104 4.684550 4.632579 5.334046 6.898923 6.648823
6.172052 5.324353 6.160472 5.970540 5.249740
export_df1[[6]]
[[2]]
Jan Feb Mar Apr May Jun Jul Aug
Sep Oct Nov Dec
2021 6.508872 4.639274 4.678671 4.626766 5.327353 6.890269 6.640483
6.164311 5.317675 6.152747 5.963053 5.243159
2022 6.517052 4.645104 4.684550 4.632579 5.334046 6.898923 6.648823
6.172052 5.324353 6.160472 5.970540 5.249740
我不想让数据框中的每一行都作为所有这些值的列表，而是希望该列采用如下形式。
export_df1$actuals
[1] 4.729682 4.573595 7.338069 4.742559 5.853501 3.167612 6.305137
5.879437 4.571004 5.367115 5.127305 4.552428 5.843000 4.060205 4.125869
4.190687
[17] 4.894595 6.454123 4.686262 4.196005 7.289879 6.206924 6.191610
6.100175 4.769656 4.829249 5.287280 4.425435 5.158180 4.402173 0.000000
0.000000 等等
我们可以在 list
中获取所有 'list_ts_ses' 个对象
lst1 <- do.call(Map, c(f = cbind, mget(ls(pattern = 'list_ts_ses'))))
export_df1 <- Map(cbind, export_df, lst1)
更新
out <- Map(function(x, y) {x[colnames(y)] <- sapply(y,
function(u) c(rep(0, nrow(x) - length(u)), u)); x}, export_df, lst1)
-检查结构
str(out)
List of 4
$ 1:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "B" "B" "B" "B" ...
..$ subproduct : chr [1:48] "1" "1" "1" "1" ...
..$ actuals : num [1:48] 5.57 5.16 5.33 4.15 4.29 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ 2:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "B" "B" "B" "B" ...
..$ subproduct : chr [1:48] "2" "2" "2" "2" ...
..$ actuals : num [1:48] 6.5 5.07 4.06 6.9 3.72 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ x:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "A" "A" "A" "A" ...
..$ subproduct : chr [1:48] "x" "x" "x" "x" ...
..$ actuals : num [1:48] 5.21 6.51 2.42 4.8 3.62 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ y:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "A" "A" "A" "A" ...
..$ subproduct : chr [1:48] "y" "y" "y" "y" ...
..$ actuals : num [1:48] 5.01 5.39 5.23 5.43 3.99 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
数据
export_df <- list(data.frame(col1 = 1:24, col2 = 25:48), data.frame(col1 = 1:24, col2 = 25:48), data.frame(col1 = 1:24, col2 = 25:48))
list_ts_ses <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )
list_ts_ses1 <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )
list_ts_ses2 <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )
一个完全可重现的例子。现在的问题是创建的新列在所有值的 c() 中，而不是每个值都在它的单独行中。
date = seq(as.Date("2019/01/01"), by = "month", length.out = 48)
productB = rep("B",48)
productB = rep("B",48)
productA = rep("A",48)
productA = rep("A",48)
subproducts1=rep("1",48)
subproducts2=rep("2",48)
subproductsx=rep("x",48)
subproductsy=rep("y",48)
b1 <- c(rnorm(30,5), rep(0,18))
b2 <- c(rnorm(30,5), rep(0,18))
b3 <-c(rnorm(30,5), rep(0,18))
b4 <- c(rnorm(30,5), rep(0,18))
创建了下面的数据框
dfone <- data.frame("date"= rep(date,4),
"product"= c(rep(productB,2),rep(productA,2)),
"subproduct"=
c(subproducts1,subproducts2,subproductsx,subproductsy),
"actuals"= c(b1,b2,b3,b4))
export_df <- split(dfone[1:4], dfone[3])
# Creation of data frames based off UNIQUE SUBPRODUCTS
dummy_list <- split(dfone[1:4], dfone[3]) %>% lapply( function(x)
x[(names(x) %in% c("date", "actuals"))])
dummy_list <- lapply(dummy_list, function(x) { x["date"] <- NULL; x })
list_dfs <- list()
for (i in 1:length(unique(dfone$subproduct))) {
#assign(paste0("df", i), as.data.frame(dummy_list[[i]]))
list_dfs <-append(list_dfs,dummy_list[[i]])
}
combined_dfs <- Reduce(function(x, y) merge(x, y, all = TRUE,
by='date'), list(list_dfs))
创建时间序列
list_ts <- lapply(list_dfs, function(t)
ts(t,start=c(2019,1),end=c(2021,6), frequency = 12)) %>%
lapply( function(t) ts_split(t,sample.out=(0.2*length(t)))) #
creates my train test split
list_ts <- do.call("rbind", list_ts) #Creates a list of time series
创建模型
model_tune_ses1 <- lapply(list_ts[1:(length(list_ts)/2)], function(x)
forecast::forecast(ses(x,h=24,alpha=0.1)))
model_tune_ses1 <- lapply(model_tune_ses1, "[", c("mean"))
model_tune_ses2 <- lapply(list_ts[1:(length(list_ts)/2)], function(x)
forecast::forecast(ses(x,h=24,alpha=0.2)))
model_tune_ses2 <- lapply(model_tune_ses2, "[", c("mean"))
model_trp_holt_mult <- lapply(list_ts[1:(length(list_ts)/2)],
function(x)
forecast::forecast( HoltWinters(x,seasonal="multiplicative"),h=24))
model_trp_holt_mult <- lapply(model_trp_holt_mult, "[", c("mean"))
lst1 <- do.call(Map, c(f = cbind, mget(ls(pattern = 'model_'))))
export_df1 <- Map(cbind, export_df, lst1)
export_df1 <- bind_rows(export_df1, .id = "date")
我删除了其他编辑以节省更多 space。
编辑2：
export_df1[[6]]
[[1]]
Jan Feb Mar Apr May Jun Jul Aug
Sep Oct Nov Dec
2021 6.508872 4.639274 4.678671 4.626766 5.327353 6.890269 6.640483
6.164311 5.317675 6.152747 5.963053 5.243159
2022 6.517052 4.645104 4.684550 4.632579 5.334046 6.898923 6.648823
6.172052 5.324353 6.160472 5.970540 5.249740
export_df1[[6]]
[[2]]
Jan Feb Mar Apr May Jun Jul Aug
Sep Oct Nov Dec
2021 6.508872 4.639274 4.678671 4.626766 5.327353 6.890269 6.640483
6.164311 5.317675 6.152747 5.963053 5.243159
2022 6.517052 4.645104 4.684550 4.632579 5.334046 6.898923 6.648823
6.172052 5.324353 6.160472 5.970540 5.249740
我不想让数据框中的每一行都作为所有这些值的列表，而是希望该列采用如下形式。
export_df1$actuals
[1] 4.729682 4.573595 7.338069 4.742559 5.853501 3.167612 6.305137
5.879437 4.571004 5.367115 5.127305 4.552428 5.843000 4.060205 4.125869
4.190687
[17] 4.894595 6.454123 4.686262 4.196005 7.289879 6.206924 6.191610
6.100175 4.769656 4.829249 5.287280 4.425435 5.158180 4.402173 0.000000 0.000000 等等
我们可以在 list
lst1 <- do.call(Map, c(f = cbind, mget(ls(pattern = 'list_ts_ses'))))
export_df1 <- Map(cbind, export_df, lst1)
更新
out <- Map(function(x, y) {x[colnames(y)] <- sapply(y,
function(u) c(rep(0, nrow(x) - length(u)), u)); x}, export_df, lst1)
-检查结构
str(out)
List of 4
$ 1:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "B" "B" "B" "B" ...
..$ subproduct : chr [1:48] "1" "1" "1" "1" ...
..$ actuals : num [1:48] 5.57 5.16 5.33 4.15 4.29 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ 2:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "B" "B" "B" "B" ...
..$ subproduct : chr [1:48] "2" "2" "2" "2" ...
..$ actuals : num [1:48] 6.5 5.07 4.06 6.9 3.72 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ x:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "A" "A" "A" "A" ...
..$ subproduct : chr [1:48] "x" "x" "x" "x" ...
..$ actuals : num [1:48] 5.21 6.51 2.42 4.8 3.62 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
$ y:'data.frame': 48 obs. of 7 variables:
..$ date : Date[1:48], format: "2019-01-01" "2019-02-01" "2019-03-01" "2019-04-01" ...
..$ product : chr [1:48] "A" "A" "A" "A" ...
..$ subproduct : chr [1:48] "y" "y" "y" "y" ...
..$ actuals : num [1:48] 5.01 5.39 5.23 5.43 3.99 ...
..$ model_trp_holt_mult: num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses1 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
..$ model_tune_ses2 : num [1:48] 0 0 0 0 0 0 0 0 0 0 ...
数据
export_df <- list(data.frame(col1 = 1:24, col2 = 25:48), data.frame(col1 = 1:24, col2 = 25:48), data.frame(col1 = 1:24, col2 = 25:48))
list_ts_ses <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )
list_ts_ses1 <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )
list_ts_ses2 <- list(ts(rnorm(24), frequency = 12, start = c(2021, 1)),ts(rnorm(24), frequency = 12, start = c(2021, 1)), ts(rnorm(24), frequency = 12, start = c(2021, 1)) )