Question

我在R shine上做了一个应用程序，我在同一个网络上与朋友分享。我在远程计算机上托管应用程序，人们使用专用端口连接到它。我正在尝试制作一个下载按钮，在Excel文件中保存data.frame并将excel文件下载到用户的计算机中。目前，我可以创建下载按钮，但它只将文件写入远程服务器中的文件夹。我本质上需要有关downloadhandler的帮助。感谢您的时间。这是一个csc可重复的例子

library(shiny) 
library(e1071)
library(rminer)
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggvis)
library(corrplot)
library(DT)
library(caret)
ui <- navbarPage(title = "HR Analytics         ",

                 tabPanel("Data Import",
                          sidebarLayout(sidebarPanel(
                            fileInput('file1', 'Choose CSV File to upload',
                                      accept=c('text/csv', 
                                               'text/comma-separated-values,text/plain', 
                                               '.csv')),
                            helpText("Note: Please ensure that the the file is in .csv",
                                     "format and contains headers."),
                            tags$hr(),
                            actionButton("do", "Import")
                          ),
                          mainPanel(h2(helpText("Descriptive Statistics")),
                                    verbatimTextOutput('contents'))
                          )
                 ),#tabpanel
                 tabPanel("Predictive Model",
                          sidebarLayout(sidebarPanel(
                            uiOutput("model_select"),
                            actionButton("enter", "Enter")
                          ),
                          mainPanel(h2(helpText("Model Output")),
                                    verbatimTextOutput('modelOutput'))
                          )
                 ),#tabpanel
                 tabPanel("Report",
                          sidebarLayout(sidebarPanel(
                            tags$style(type="text/css",
                                       ".shiny-output-error { visibility: hidden; }",
                                       ".shiny-output-error:before { visibility: hidden; }"
                            ),
                            helpText("Download final list of employess to be retained"),
                            br(),
                            uiOutput("modsel"),
                            helpText("Select Model"),
                            uiOutput("noselect"),
                            helpText("Select number pf employess"),
                            downloadButton('downloadData', 'Download'),
                            helpText("Download final list of employees to be retained")
                          ),

                          mainPanel(h2(helpText("Retained Employees")),
                                    dataTableOutput("reportOutput"))
                          )
                 )#tabpanel


)


library(shiny)

server <- function(input, output) {

  hr = eventReactive(input$do,{
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    hr = read.csv(inFile$datapath, header=T, sep=",")
  })

  output$contents <- renderPrint({
    return(summary(hr()))
  })

  output$model_select<-renderUI({
    selectInput("modelselect","Select the model",choices = c("Tree Learning"="rpart","Logistic Regression"="LogitBoost", "Naive Bayes" = "nb"))
  })

  output$modsel<-renderUI({
    selectInput("modelselect2","Select Algo",choices = c("Logistic Regression","Naives Bayes","Tree Learning"),selected = "Logistic_reg")
  })

  output$noselect<- renderUI({
    sliderInput("noselect", "Number of observations:",
              min = 0, max = 300, value = 20)})


  algo = eventReactive(input$enter,{
    return(input$modelselect)
  })


  output$modelOutput <- renderPrint({
    hr_model <- hr() %>% filter(left==0 | last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
    hr_model$left <- as.factor(hr_model$left)
    train_control<- trainControl(method="cv", number=5, repeats=3)
    rpartmodel<- train(left~., data=hr_model, trControl=train_control, method=algo())
    # make predictions
    predictions<- predict(rpartmodel,hr_model)
    hr_model_tree<- cbind(hr_model,predictions)
    # summarize results
    confusionMatrix<- confusionMatrix(hr_model_tree$predictions,hr_model_tree$left)
    confusionMatrix
  })

  rt <- reactive(
    if(input$modelselect2== "Logistic Regression"){
      f1<-data()
      hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
      hr_model1$left <- as.factor(hr_model1$left)
      train_control<- trainControl(method="cv", number=5, repeats=3)
      # Keep some data to test again the final model
      set.seed(100)
      inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
      training <- hr_model1[ inTraining,]
      testing  <- hr_model1[-inTraining,]
      # Estimate the drivers of attrition
      logreg = glm(left ~ ., family=binomial(logit), data=training)
      # Make predictions on the out-of-sample data
      probaToLeave=predict(logreg,newdata=testing,type="response")
      # Structure the prediction output in a table
      predattrition = data.frame(probaToLeave)
      # Add a column to the predattrition dataframe containing the performance
      predattrition$performance=testing$last_evaluation

      predattrition$priority=predattrition$performance*predattrition$probaToLeave
      orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
      orderpredattrition <- head(orderpredattrition, n=input$noselect)
      or<- data.frame(orderpredattrition)
      or
    }
    else if(input$modelselect2== "Naives Bayes"){
      f1<-data()
      hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
      hr_model1$left <- as.factor(hr_model1$left)
      train_control<- trainControl(method="cv", number=5, repeats=3)
      # Keep some data to test again the final model
      set.seed(100)
      inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
      training <- hr_model1[ inTraining,]
      testing  <- hr_model1[-inTraining,]

      # Estimate the drivers of attrition
      e1071model2 = naiveBayes(left ~ ., data=training)
      # Make predictions on the out-of-sample data
      probaToLeave=predict( e1071model2,newdata=testing[,c(-7,-9,-10)],type="raw")
      # Structure the prediction output in a table
      predattrition = data.frame(probaToLeave)
      colnames(predattrition) <- c("c","probaToLeave")
      predattrition[1] <- NULL 
      # Add a column to the predattrition dataframe containing the performance
      predattrition$performance=testing$last_evaluation
      predattrition$priority=predattrition$performance*predattrition$probaToLeave
      orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
      orderpredattrition <- head(orderpredattrition, n=input$noselect)
      or<- data.frame(orderpredattrition)

    }

    else if(input$modelselect2== "Tree Learning"){
      f1<-data()
      hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
      hr_model1$left <- as.factor(hr_model1$left)
      train_control<- trainControl(method="cv", number=5, repeats=3)
      # Keep some data to test again the final model
      set.seed(100)
      inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
      training <- hr_model1[ inTraining,]
      testing  <- hr_model1[-inTraining,]
      # Estimate the drivers of attrition
      rpartmodel = rpart(left ~ satisfaction_level+last_evaluation+number_project+average_montly_hours+time_spend_company+Work_accident+promotion_last_5years,method = "anova",data=training)
      # Make predictions on the out-of-sample data
      probaToLeave=predict(rpartmodel,newdata=testing[,c(-7,-9,-10)],type="vector")
      # Structure the prediction output in a table
      predattrition = data.frame(probaToLeave)*0.5
      # Add a column to the predattrition dataframe containing the performance
      predattrition$performance=testing$last_evaluation

      predattrition$priority=predattrition$performance*predattrition$probaToLeave
      orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
      orderpredattrition <- head(orderpredattrition, n=input$noselect)

      or<- data.frame(orderpredattrition)
      or
    }
  )


  output$reportOutput = renderDataTable({
    rt()
  })

  output$downloadData <- downloadHandler(
    filename = function() { paste(input$modelselect2, '.csv', sep='') },
    content = function(file){
      write.csv(rt(), file)
    }
  )

}
shinyApp(ui=ui, server = server)

Answer 1

有一个更简单的选项，使用data.table＆＃34;导出按钮＆＃34;特征

<强> server.r

output$table_out  <- DT::renderDataTable(
                datatable(
                    data,
                rownames = TRUE,
                options = list(
                    fixedColumns = TRUE,
                    autoWidth = TRUE,
                    ordering = FALSE,
                    dom = 'tB',
                    buttons = c('copy', 'csv', 'excel', 'pdf')
                ),
                class = "display" #if you want to modify via .css
            )

<强> ui.r

DT::dataTableOutput("table_out")

最终结果：

image source

Answer 2

路易斯·马丁斯（Luis Martins）的答案缺少exentions = 'Buttons'参数：

output$table_out  <- DT::renderDataTable(
            datatable(
                data,
            rownames = TRUE,
            options = list(
                fixedColumns = TRUE,
                autoWidth = TRUE,
                ordering = FALSE,
                dom = 'tB',
                buttons = c('copy', 'csv', 'excel', 'pdf')
            ),
            class = "display", #if you want to modify via .css
            extensions = "Buttons"
        )

您可能需要更改“ DOM”选项，以垂直方式对表格/搜索框/按钮/等进行重新排序，例如：dom = 'Btlfipr'

在闪亮的应用程序中创建一个下载按钮，将data.frame保存在Excel文件中，并将excel文件下载到用户的计算机中

2 个答案: