通过多个数据集循环到 运行 并将每个输出保存在 R 中

loop to run through multiple datasets and save each output in R

我们正在尝试 运行 循环遍历八个不同的数据集,然后以标准化格式保存输出。

数据帧被称为 df1df2df3

我无法共享数据 (here is a sample of the data),但每个数据集都是 df1 的子集 - 因此它确实具有相同的列。

df1 看起来像:

age   wt   sex
10    200  F
15    250  F
20    300  F
12    200  M
13    250  M
25    300  M

子集 dfs 将是,例如,df2<-df1%>%filter(sex=="F")df3<-df1%>%filter(sex=="M"),等等。

这里有一个 small 代码示例,我们希望 运行 每个数据帧。

nls.mon <- nls(wt~A*(1-exp(k*(t0-age))), 
    data=df1,
    start = list(A=253.6,k=.03348,t0=32.02158))

aad_mon_est <- data.frame(tidy(nls.mon)) 
mon_A_est  <- as.numeric(aad_mon_est[1, "estimate"])
mon_k_est  <- as.numeric(aad_mon_est[2, "estimate"])
mon_t0_est <- as.numeric(aad_mon_est[3, "estimate"])

nls.von <- nls(wt ~A*(1-(1/3)*exp(k*(t0-age)))^3, 
    data=df1,
    start=list(A=253.6,k=.03348,t0=32.02158))

aad_von_est <- data.frame(tidy(nls.von))
von_A_est  <- as.numeric(aad_von_est[1, "estimate"])
von_k_est  <- as.numeric(aad_von_est[2, "estimate"])
von_t0_est <- as.numeric(aad_von_est[3, "estimate"])

如果有办法通过每个数据帧(df1df2df3 等)告诉循环到 运行,然后保存 aad_arc_B_estaad_arc_k_est,然后是 aad_arc_mx_est

我们希望得到如下所示的输出:

dataframe  model     A_est   k_est  t0_est
df1        nls.mon   250     10     0.14   
df1        nls.von   350     12     0.13   
df2        nls.mon   150     11     0.15   
df2        nls.von   240     14     0.16
df3        nls.mon   220     11     0.11   
df3        nls.von   450     15     0.10                 

我们正在考虑使用索引 - 类似 for (i in dataframe) 的东西让它 运行 通过每个数据帧,并且
dataframe[i,] <- row_i 将每一行追加到后面?

但是,也许有更好的方法?

您是否考虑过将代码更改为函数?您可以将所有 data.frames 存储在命名列表中,然后对列表中的每个 data.frame 应用函数,然后收集结果。

library(tidyverse)
library(broom)

# changing your code to a function
my_function <- function(.df){
  
  nls.mon <- nls(wt~A*(1-exp(k*(t0-age))), 
                 data=.df,
                 start = list(A=253.6,k=.03348,t0=32.02158))
  
  nls.von <- nls(wt ~A*(1-(1/3)*exp(k*(t0-age)))^3, 
                 data=.df,
                 start= list(A=253.6,k=.03348,t0=32.02158))
  
  # I slightly edited this part of your code
  df <- bind_rows(
    tidy(nls.mon) %>% mutate(model = "nls.mon"),
    tidy(nls.von) %>% mutate(model = "nls.von")
  ) %>%
    select(model, term, estimate) %>%
    pivot_wider(names_from = "term", values_from = "estimate")

  return(df)
}

# reading in data, the path to the data needs to be changed
df1 <- read_csv(r"{C:\Users\novot\Downloads\sample.csv}") %>%
  select(-1)

df2 <- df1 %>%
  filter(sex == "M")

# using map to apply the created function to each member of the list
df_out <- list("df1" = df1, "df2" = df2) %>%
  map(
    ~my_function(.x)
  ) %>%
  bind_rows(.id = "dataframe")

df_out
#> # A tibble: 4 x 5
#>   dataframe model       A      k    t0
#>   <chr>     <chr>   <dbl>  <dbl> <dbl>
#> 1 df1       nls.mon  248. 0.0135  2.09
#> 2 df1       nls.von  246. 0.0222 32.9 
#> 3 df2       nls.mon  248. 0.0135  2.09
#> 4 df2       nls.von  246. 0.0222 32.9

您可以将代码包装在一个函数中,并将该函数应用于您的数据帧列表

f <- function(n,dfs) {
  nls.aad_arc <- nls(wt~ B*atan(k*(age - mx)) + my, data=dfs[[n]],start = list(B=120, k=.02, mx=30, my= 82.06)) 
  aad_arc_est <- data.frame(tidy(nls.aad_arc)) 
  data.frame(
    dataframe = n,
    aad_arc_B_est  <- as.numeric(aad_arc_est[1, "estimate"]), 
    aad_arc_k_est  <- as.numeric(aad_arc_est[2, "estimate"]),
    aad_arc_mx_est <- as.numeric(aad_arc_est[3, "estimate"])  
  )
}

dfs = list('df1'=df1, 'df2'=df2,'df3' = df3)
do.call(rbind, lapply(names(dfs), function(x) f(x,dfs)))