在Shiny应用程序中构建响应式查询并导出结果

时间:2016-07-18 15:10:28

标签: r shiny

我有一个内置的Shiny应用程序,它可以查询本地数据库并在表格中返回结果。有两个查询可以运行,每个查询都由一个单独的操作按钮控制。

该应用程序工作正常,但我在尝试制作数据下载按钮时遇到了问题。问题是我已经制作了两个单独的反应函数来获取每个查询,而我无法弄清楚如何使两个查询的结果都是相同的“对象”[请原谅可能不正确的术语]以便相同的数据-download按钮将根据运行的查询下载当前数据。一个丑陋的解决办法就是制作两个下载按钮,但我确信这是一个优雅的解决方案。

这是我的代码:

global.R

library(shiny)
library(RSQLite)
library(data.table)
library(dplyr)
library(zoo)
library(igraph)

# Import parts list and materials list
setwd("REDACTED/Scripts/shiny/LegislationQuery/")
partList <- read.csv("partList.csv")
materialsList <- read.csv("materialsList.csv")

# Set up local.db
if(file.exists("local.db")) file.remove("local.db")
myDB<-dbConnect(SQLite(),"local.db")
dbWriteTable(myDB, "partList", partList, overwrite = TRUE)
dbWriteTable(myDB, "Materials", materialsList, overwrite = TRUE)

server.R

library(shiny)
library(RSQLite)
library(data.table)
library(dplyr)
library(zoo)
library(igraph)

shinyServer(function(input, output) {

 sqlDown <- reactive ({paste("with recursive Parts(P,S, Level) as (select Part as P, SubPart as S, 0 from partList union select Parts.P, partList.SubPart as S, Parts.Level + 1 as Level from Parts, partList where Parts.S = partList.Part) select P as Part, S as SubPart,  Level from Parts where P = ","'", input$partForQuery, "'", sep = "")})
 sqlUp <- reactive ({paste("with Parts(subPart, part, level) as (select SubPart as subPart, Part as part, 0 as level from partList where subPart =", "'", input$partForQuery, "'", "union select partList.SubPart, partList.Part as part, Parts.level - 1 as level from Parts, partList where Parts.part = partList.SubPart) select subPart as SubPart, part as Part, level as Level from Parts", sep = "")})

  queryDownData  <- function() {dbGetQuery(myDB, sqlDown())}
  queryUpData  <- function() {dbGetQuery(myDB, sqlUp())}

  observeEvent(input$RunDownQuery, {
    output$table <- renderDataTable(data.table({
    data = queryDownData()}))
    })
  observeEvent(input$RunUpQuery, {
    output$table <- renderDataTable(data.table({
    data = queryUpData()}))
    })  

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

ui.R

library(shiny)
library(data.table)

shinyUI(pageWithSidebar(

  headerPanel("Part Query"),

  sidebarPanel(
  textInput("partForQuery", "Part Number:"),

    fluidRow(
    actionButton("RunDownQuery", label = "Run Query (Down)"),
    actionButton("RunUpQuery", label = "Run Query (Up)")
    ),
    downloadButton('downloadData', 'Download')
  ),

  mainPanel(
    dataTableOutput("table")
  )
))

1 个答案:

答案 0 :(得分:0)

这样的事情应该有效:

library(shiny)
library(RSQLite)
library(data.table)
library(dplyr)
library(zoo)
library(igraph)

shinyServer(function(input, output) {

  whichQuery <- c()

  sqlDown <- reactive ({paste("with recursive Parts(P,S, Level) as (select Part as P, SubPart as S, 0 from partList union select Parts.P, partList.SubPart as S, Parts.Level + 1 as Level from Parts, partList where Parts.S = partList.Part) select P as Part, S as SubPart,  Level from Parts where P = ","'", input$partForQuery, "'", sep = "")})
  sqlUp <- reactive ({paste("with Parts(subPart, part, level) as (select SubPart as subPart, Part as part, 0 as level from partList where subPart =", "'", input$partForQuery, "'", "union select partList.SubPart, partList.Part as part, Parts.level - 1 as level from Parts, partList where Parts.part = partList.SubPart) select subPart as SubPart, part as Part, level as Level from Parts", sep = "")})

  queryDownData  <- function() {dbGetQuery(myDB, sqlDown())}
  queryUpData  <- function() {dbGetQuery(myDB, sqlUp())}

  observeEvent(input$RunDownQuery, {
    whichQuery <<- "Down"
    output$table <- renderDataTable(data.table({
      data = queryDownData()}))
  })
  observeEvent(input$RunUpQuery, {
    whichQuery <<- "Up"
    output$table <- renderDataTable(data.table({
      data = queryUpData()}))
  })  

  output$downloadData <- downloadHandler(
    filename = function() { paste(input$partForQuery, '.csv', sep='') },
    content = function(file) {
      write.csv(ifelse(whichQuery=="Down",queryDownData(),queryUpData()), file)
    }
  )
})

whichQuery保存最后按下的按钮,然后在确定要下载的文件时使用该值。