【发布时间】：2020-08-13 12:17:14
【问题描述】：
我正在尝试为我的数据的不同子组的更改模型模拟拟合值，这些模型再次基于我的原始数据框的另一个子集的随机抽样（我为这个问题编写的最小示例忽略了随机抽样等.，导致所有模拟的拟合值相同，但这并不重要）。我编写了一个 dplyr 代码来存储每个组的模型，生成新的 x 值来预测拟合值，预测它们等等。它会产生一列拟合值，完全符合我的要求。但是，我想将整个过程进行 1000 倍。我当然可以使用 for 循环来执行此操作（如下面的示例中所做的那样），但是是否有可能在 dplyr-pipe 行中执行此操作？也许会加快整个过程（我的原始数据集相当大，for-loop 需要很长时间）？
# making up data
dat <- data.frame("species" = seq(1:20), "col_A" = runif(20, min=1000, max=2500), "col_B" = runif(20, min = 0, max = 1500),
"maximum" = rep(2500, 20), "minimum" = rep(1000, 20), groups = rep(LETTERS[1:5], each = 4))
# functions to use with purrr
linear_mod <- function(dat) {
lm(col_A ~ col_B, data = dat)
}
# define parametres and an empty data frame to use in the for loop
runs <- 10
fitted_sim <- data.frame(matrix(data=NA,nrow=20,ncol=runs+1,byrow=FALSE)) #empty dataframe to contain fitted values for each alt
names(fitted_sim) <- as.factor(seq(1:runs+1))
# for-loop around my dplyr-code
for (j in 1:runs){
simul <- dat %>%
group_by(groups) %>%
nest(data = c(col_A, col_B, species)) %>%
mutate(model = map(data, linear_mod), # add model for every group
sim_data = list(seq(minimum, maximum, by = 10))) %>% # define new x-values for later predictions
unnest(sim_data) %>%
nest(sim_data = sim_data) %>%
mutate(fitted = map2(model, sim_data, ~predict(.x, col_B = sim_data, type = "response")), # predict values
unnest(fitted) # unnest predicted values to save in data frame
# save newly fitted values in fitted_sim data frame
fitted_sim[,1] <- simul$groups
fitted_sim[,1+j] <- simul$fitted
}
感谢您的每一个提示！
编辑： 这是一个扩展示例代码，包括上述随机抽样，但在我的第一个示例中省略：
# for-loop around my dplyr-code
for (j in 1:runs) {
simul <- dat %>%
group_by(groups) %>%
rowwise() %>%
mutate(vector_column = case_when(abs(col_A) == (maximum-minimum) ~ list(col_B),
sign(col_A) == 1 ~ list(dat$col_B[dat$col_B <= maximum - col_A]), # using list function to store vectors in a data.frame
sign(col_A) != 1 ~ list(dat$col_B[dat$col_B >= minimum + col_A])),
helper = !is_empty(vector_column), # in case some of the vectors are empty so it is not possible to use sample
col_B_new = ifelse(helper, sample(vector_column, 1), NA),
helper = NULL,
sim_data = list(seq(minimum, maximum, by = 10))) %>% # define new x-values for later predictions
ungroup() %>% # get rid of rowwise()
group_by(groups) %>%
unnest(sim_data) %>%
nest(sim_data = sim_data) %>%
nest(data = c(col_A, col_B, col_B_new, species)) %>%
mutate(model = map(data, linear_mod),
fitted = map2(model, sim_data, ~predict(.x, col_B_new = sim_data, type = "response"))) %>% # predict values
unnest(fitted) # unnest predicted values to save in data frame
# save newly fitted values in fitted_sim data frame
fitted_sim[,1] <- simul$groups
fitted_sim[,1+j] <- simul$fitted
}
【问题讨论】：