将循环输出放入附加 Object

Question

所以我正在尝试制作一个基本的敏感性分析脚本。通过我添加到脚本末尾的打印，输出按我想要的方式输出。问题是我想要一个 tibble 或 object 将所有输出附加在一起，我可以将其导出为 csv 或 xlsx。

我创建了两个函数，sens_analysis 是所有代码的运行，multiply_across 是 table 中每个可能列的每个可能百分比的乘积。你需要 multiply_across 到运行到 sens_analysis。

我通常想要一个标题，但我只是添加了一个指示列，而不是我可以作为排序依据的列。

我用 mtcars 制作了所有东西，所以它应该很容易复制，问题是我最后只有一个巨大的印刷品；不是我可以操纵或提取用于其他分析的 object。

我一直在尝试 rbind，bind_row，以各种方式附加行。或者建立一个新的 object。正如您在第 (18) 行的代码中看到的那样，我做了一些我尝试填充的称为输出的东西，但效果不佳。

rm(list = ls())

library(dplyr)
library(tidyr)
library(purrr)
library(tibble)
library(magrittr)
library(xtable)

data<-mtcars
percent<-c(.05,.1,.15)
goods<-c("hp","gear","wt")
weight<-c(6,7,8)
disagg<-"cyl"
func<-median

sens_analysis<-function(data=data, goods=goods, weight=weight, disagg=disagg, precent=percent, func=func){
  output<-NULL%>%
    as.tibble()
  basket<-(rbind(goods,weight))
  percent<-c(0,percent,(percent*-1))
  percent_to_1<-percent+1


  data_select<-data%>%
    dplyr::select(c(goods,disagg))%>%
    group_by_at(disagg)%>%
    summarise_at(.vars = goods ,.funs = func)%>%
    as_tibble()

  data_select_weight<-purrr::map2(data_select[,-1], as.numeric(basket[2,]),function(var, weight){
    var*weight
  })%>% as_tibble %>%
    add_column(data_select[,1], .before = 1)
  colnames(data_select_weight)[1]<-disagg


  multiply_across(data_select_weight,percent_to_1)
  return(output) 
  #output2<-rbind(output2,output)                        
}

############################
multiply_across<-function(data=data_select_weight,list=percent_to_1){
  varlist<-names(data[,-1]) 
  for(i in varlist){
    df1 = data[,i]
    for(j in list){
      df<-data
      df[,i]<-round(df1*j,2)
      df<-mutate(df, total = round(rowSums(df[,-1]),2))%>%
        mutate(type=paste0(i," BY ",(as.numeric(j)-1)*100,"% OVER ",disagg))%>%
       print(df) 

      #output<-bind_rows(output,df)
      #output<-bind_rows(output,df)
      #output[[j]]<-df[[j]]
    }  

  }

}

##############################################################################################
sens_analysis(data,goods,weight,disagg,percent,func)

如果你只是运行代码 straight-up 的预期结果应该只是一堆印刷的小标题，而不是 object。但理想情况下，为了将来对数据进行分析或便于使用，最好将 table 输出附加在一起。

Answer 1

所以我想通了，并会在此处添加我的答案，以防其他人遇到此问题。

我在循环中创建了一个列表，然后将这些列表绑定在一起。

只关注右侧外的绑定行for-loop。

multiply_across<-function(data=data_select_weight,
  list=percent_to_1){
  varlist <- colnames(data[, -1])
  output_list <- list()
  for (i in varlist) {
    df1 <- data[,i]
    for (j in list) {
      name <- paste0(i, " BY ", (as.numeric(j)-1)*100, "% OVER ", disagg)

      df <- as_tibble(data)
      df[,i] <- round(df1*j, 2)
      df <- mutate(df, total = round(rowSums(df[,-1]),2))%>%
            mutate(type = paste0(i, " BY ", (as.numeric(j)-1)*100, "% OVER ", disagg))
      df<-df[,c(6,1,2,3,4,5)]


      output_list[[paste0(i," BY ",(as.numeric(j)-1)*100)]] <- (assign(paste0(i," BY ",(as.numeric(j)-1)*100,"% OVER ",disagg),df))

    }

  }

  bind_rows(lapply(output_list,
    as.data.frame.list,
    stringsAsFactors=F))

}

将循环输出放入附加 Object

Getting Looped Output into an Appended Object

for-loop

r

rbind

output