遍历子集，源文件并将结果保存在数据框中

Question

类似的问题已被问到，但没有人能够解决我的具体问题。我有一个.R文件（“Mycalculus.R”），其中包含我需要应用于数据框子集的许多基本演算：每年的一个子集，其中“年份”的模式是因素（年A，年B，年C）不是数字值。该文件生成一个新的数据帧，我需要将其保存在Rda文件中。这是我所期望的代码看起来像一个for循环（这显然是一个不工作）：

id <- identif(unlist(df$year)) 
for (i in 1:length(id)){ 
    data <- subset(df, year == id[i]) 
    source ("Mycalculus.R", echo=TRUE) 
    save(content_df1,file="myresults.Rda") 
} 

这里有一个确切的主要data.frame DF的：

obs year income gender ageclass weight 
1  yearA 1000  F   1   10 
2  yearA 1200  M   2   25 
3  yearB 1400  M   2   5 
4  yearB 1350  M   1   11 

这里是源文件“Mycalculus.R”的作用：它将大量基础微积分应用于数据框的称为“数据”的列，并基于df1创建两个新的数据框df1，然后创建df2。下面是摘录：

data <- data %>% 
    group_by(gender) %>% 
    mutate(Income_gender = weighted.mean(income, weight)) 
data <- data %>% 
    group_by(ageclass) %>% 
    mutate(Income_ageclass = weighted.mean(income, weight)) 

library(GiniWegNeg) 
gini=c(Gini_RSV(data$Income_gender, weight), Gini_RSV(data$Income_ageclass,weight)) 

df1=data.frame(gini) 
colnames(df1) <- c("Income_gender","Income_ageclass") 
rownames(df1) <- c("content_df1") 

df2=(1/5)*df1$Income_gender+df2$Income_ageclass 
colnames(df2) <- c("myresult") 
rownames(df2) <- c("content_df2") 

因此，在年底，我得到两个dataframes这样的：

    Income_Gender Income_Ageclass  
content_df1   ....    ....  

而对于DF2：

    myresult  
content_df2   ....   

但我需要保存DF1和Rf2作为Rda文件，其中每个子集给出content_df1和content_df2的行名称，如下所示：

    Income_Gender Income_Ageclass  
content_df1_yearA  ....    ....  
content_df1_yearB  ....    ....  
content_df1_yearC  ....    ....  

和

    myresult 
content_df2_yearA  .... 
content_df2_yearB  ....  
content_df2_yearC  .... 

目前，我的程序不使用任何循环，在做工作，但乱七八糟。基本上，代码超过2500行代码。 （请不要把西红柿扔给我）。

任何人都可以帮我解决这个问题吗？ 预先感谢您。

Answer 1

考虑将所有脚本与所需参数的已定义函数合并到一个脚本中，由lapply()调用。然后，Lapply返回一个数据帧列表，您可以将其绑定到最后一个df中。

library(dplyr) 
library(GiniWegNeg) 

runIncomeCalc <- function(data, y){  
    data <- data %>% 
    group_by(gender) %>% 
    mutate(Income_gender = weighted.mean(income, weight)) 
    data <- data %>% 
    group_by(ageclass) %>% 
    mutate(Income_ageclass = weighted.mean(income, weight))  

    gini <- c(Gini_RSV(data$Income_gender, weight), Gini_RSV(data$Income_ageclass,weight)) 

    df1 <- data.frame(gini) 
    colnames(df1) <- c("Income_gender","Income_ageclass") 
    rownames(df1) <- c(paste0("content_df1_", y)) 

    return(df1) 
} 

runResultsCalc <- function(df, y){ 
    df2 <- (1/5) * df$Income_gender + df$Income_ageclass 
    colnames(df2) <- c("myresult") 
    rownames(df2) <- c(paste0("content_df2_", y) 

    return(df2) 
} 

dfIncList <- lapply(unique(df$year), function(i) {  
    yeardata <- subset(df, year == i) 
    runIncomeCalc(yeardata, i)  
}) 

dfResList <- lapply(unique(df$year), function(i) {  
    yeardata <- subset(df, year == i) 
    df <- runIncomeCalc(yeardata, i) 
    runResultsCalc(df, i)  
}) 

df1 <- do.call(rbind, dfIncList) 
df2 <- do.call(rbind, dfResList) 

---

现在，如果你需要跨脚本源。在Mycalculus.R创建两个相同的功能，runIncomeCalc和runResultsCalc然后调用各自在其他脚本：

library(dplyr) 
library(GiniWegNeg) 

if(!exists("runIncomeCalc", mode="function")) source("Mycalculus.R") 

dfIncList <- lapply(unique(df$year), function(i) {  
    yeardata <- subset(df, year == i) 
    runIncomeCalc(yeardata, i)  
}) 

dfResList <- lapply(unique(df$year), function(i) {  
    yeardata <- subset(df, year == i) 
    df <- runIncomeCalc(yeardata, i) 
    runResultsCalc(df, i)  
}) 

df1 <- do.call(rbind, dfIncList) 
df2 <- do.call(rbind, dfResList) 

Answer 2

如果功能-IZE你的脚步，你可以创建类似下面的工作流程：

calcFunc <- function(df) { 
    ## Do something to the df, then return it 
    df 
} 

processFunc <- function(fname) { 
    ## Read in your table 
    x <- read.table(fname) 

    ## Do the calculation 
    x <- calcFunc(x) 

    ## Make a new file name (remember to change the file extension) 
    new_fname <- sub("something", "else", fname) 

    ## Write the .RData file 
    save(x, file = new_fname) 
} 

### Your workflow 
## Generate a vector of files 
my_files <- list.files() 

## Do the work 
res <- lapply(my_files, processFunc) 

另外，不保存文件。在processFunc中省略save调用，并返回data.frame对象的列表。然后使用data.table::rbindlist(res)或do.call(rbind, list)来制作一个大的data.frame对象。