Получение зацикленного вывода в добавляемый объект - PullRequest
Новая
       22

Получение зацикленного вывода в добавляемый объект

0 голосов
/ 08 июля 2019

Итак, я пытаюсь сделать базовый скрипт анализа чувствительности.Выводы получаются, как я хочу, через отпечаток, который я добавил в конец сценария.Проблема заключается в том, что я хотел бы, чтобы tibble или объект, к которому были приложены все выходные данные, которые я могу экспортировать как csv или xlsx.

Я создал две функции: sens_analysis, который запускает весь код, и multiply_across, который умножается на каждый возможный процент в каждом возможном столбце вашей таблицы.Вам нужно multiply_across для запуска sens_analysis.

Обычно я хотел бы заголовок, но вместо этого я просто добавил столбец индикатора вместо того, чтобы сортировать по нему.

Я сделал все с помощью mtcars, чтобы его было легко скопировать, проблема в том, чтоУ меня просто огромный отпечаток в конце;не объект, которым я могу манипулировать или извлекать для другого анализа.

Я пробовал добавлять строки в rbind, bind_row, различными способами.Или строим новый объект.Как вы можете видеть в коде в строке (18), я делаю что-то под названием output, который я пытался заполнить, что не получилось. 

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)

Ожидаемый результат, если вы просто выполните код прямо-папка должна быть просто кучкой печатных надписей, которых нет в объекте.Но в идеале, для будущего анализа данных или простоты использования лучше всего подойдет таблица результатов, приложенных вместе.

1 Ответ

0 голосов
/ 21 июля 2019

Так что я разобрался и добавлю свой ответ здесь на случай, если кто-то другой решит эту проблему.

Я создал список внутри циклов, а затем связал эти списки вместе.

Просто сфокусируйтесь на переплетных строках за пределами правого цикла for. 

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))

}
...