如何将数据表下载到 R shiny 中的 .xpt 文件？

Question

我正在创建 R shiny 应用程序，当用户在“schoolid”、“userid”、“class”、“结果”和“结果日期/失败备注”列中输入值时”，点击“添加”按钮，相关数据表显示在“Tab2”中，目前完美运行。

我正在寻找将 DataTable（从 Tab2）下载到 .xpt 文件的解决方案。有人可以帮我解决这个问题吗？

注：我是参考了我之前的问题才问这个问题的：How to change column values from date format to free-flowing text is dependent on "result" column in R shiny.

代码

library(shiny)
library(stringr)
library(shinydashboard)
library(tidyverse)
library(DT)

ui <- fluidPage(
  fluidRow(tabsetPanel(id='tabs', 
                       tabPanel("Tab1",
                                div(id = "form", 
                                    textInput("schoolId", label="SchoolId *" ),
                                    selectInput("userId", label="UserId", choices = c("UserA", "UserB", "UserC"),selected = "UserA"), 
                                    textInput("class", label = "class"), 
                                    selectInput("result", label="result", choices = c("PASS", "FAIL" )),
                                                dateInput("resultdate", value = NA, label = "Date of the result / Remarks for fail"
                                                          , format = "yyyy-mm-dd" )
                                ),
                                actionButton("add", "Add")
                       ), 
                       tabPanel("Tab2", 
                                tabPanel("View", 
                                         conditionalPanel("input.add != 0", 
                                                          DTOutput("DT2"), hr(), downloadButton('downloadData', 'Download'))
                                )
                       )
  )
  )
)

server <- function(input, output, session) {
  store <- reactiveValues()
  
  observeEvent(input$add,{
    new_entry <- data.frame(SCHOOLID=input$schoolId, USERID=input$userId
                            , CLASS= input$class
                            , RESULT=input$result,
                            RESULT_DATE = input$resultdate)
    
    if("value" %in% names(store)){
      store$value<-bind_rows(store$value, new_entry)
    } else {
      store$value<-new_entry
    }
    # If you want to reset the field values after each entry use the following two lines
    for(textInputId in c("schoolId", "class")) updateTextInput(session, textInputId, value = "")
    updateSelectInput(session, "userId", selected = "UserA")
    updateSelectInput(session, "result", selected = "PASS")
    updateDateInput(session, "resultdate")
  })
  output$DT2 <- renderDT({
    store$value
  })
  
}

shinyApp(ui, server)

Answer 1

您可以尝试 SASxport 包中的 write.xport。试试这个

library(shiny)
library(stringr)
library(shinydashboard)
library(tidyverse)
library(DT)
library("SASxport")

ui <- fluidPage(
  fluidRow(tabsetPanel(id='tabs', 
                       tabPanel("Tab1",
                                div(id = "form", 
                                    textInput("schoolId", label="SchoolId *" ),
                                    selectInput("userId", label="UserId", choices = c("UserA", "UserB", "UserC"),selected = "UserA"), 
                                    textInput("class", label = "class"), 
                                    selectInput("result", label="result", choices = c("PASS", "FAIL" )),
                                    dateInput("resultdate", value = NA, label = "Date of the result / Remarks for fail"
                                              , format = "yyyy-mm-dd" )
                                ),
                                actionButton("add", "Add")
                       ), 
                       tabPanel("Tab2", 
                                tabPanel("View", 
                                         conditionalPanel("input.add != 0", 
                                                          DTOutput("DT2"), hr(), downloadButton('downloadData', 'Download'))
                                )
                       )
  )
  )
)

server <- function(input, output, session) {
  store <- reactiveValues()
  
  observeEvent(input$add,{
    new_entry <- data.frame(SCHOOLID=input$schoolId, USERID=input$userId
                            , CLASS= input$class
                            , RESULT=input$result,
                            RESULT_DATE = input$resultdate)
    
    if("value" %in% names(store)){
      store$value<-bind_rows(store$value, new_entry)
    } else {
      store$value<-new_entry
    }
    # If you want to reset the field values after each entry use the following two lines
    for(textInputId in c("schoolId", "class")) updateTextInput(session, textInputId, value = "")
    updateSelectInput(session, "userId", selected = "UserA")
    updateSelectInput(session, "result", selected = "PASS")
    updateDateInput(session, "resultdate")
  })
  output$DT2 <- renderDT({
    store$value
  })
  
  output$downloadData <- downloadHandler(
    filename = paste0("mydata", ".xpt"),
    content = function(file){
      write.xport(store$value, file = file)
    }
  )
  
}

shinyApp(ui, server)

如何将数据表下载到 R shiny 中的 .xpt 文件？

How to download the datatable to .xpt file in R shiny?

r

shiny