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

Question

我正在创建R闪亮的应用程序，当用户在列中输入值时"schoolid，"userid，"类，"结果；以及"；结果日期/失败备注"；并点击按钮"；添加，"；相关的数据表显示在"；表2"；，它目前运行良好。

我正在寻找一个将DataTable(从Tab2(下载到.xpt文件的解决方案。有人能帮我做这个吗。？

注：我在参考了我之前的调查后，提出了这个新的调查。：如何将列值从日期格式更改为自由流动的文本取决于"；结果"；柱在R闪亮。

代码

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)