如何在Shiny App中创建计划的SQL数据?

时间:2018-10-23 11:25:29

标签: r shiny shiny-server

我在Linux服务器上创建了一个闪亮的应用程序,该应用程序连接到SQLSERVER并从中获取数千个数据,然后执行多个步骤以获取最终结果。但是我有这个应用程序的问题...当我尝试通过闪亮的服务器远程访问此报告时,页面需要花费很多时间才能打开,有时我会收到与连接有关的错误页面没有'不发送任何数据,因此我想创建一个Schedule,以仅每天从SQL获取数据,甚至创建刷新按钮以获取新数据。

我尝试了类似invalidateLater的操作,但是尝试这种方法后却得到了空数据,所以任何人都可以给我解决此问题的方法吗?

这是我的应用代码:

从SQL获取数据> DF <- dbGetQuery(con,Query1)

用户界面

ui <- fluidPage(
  theme = shinytheme("cerulean"),
  titlePanel("Audit Logs"),
  sidebarLayout(
    sidebarPanel(
      pickerInput("Action", "Select Action Type", choices = DF %>% distinct(Action), selected = "Update", options = list(`actions-box` = TRUE,
                                                                                                                         `live-search` = TRUE,
                                                                                                                         `deselect-all-text` = "None...",
                                                                                                                         `select-all-text` = "Yeah, all !",
                                                                                                                         `none-selected-text` = "None"),multiple = T),br(),br(),

      pickerInput("SourceTable", "Select Table", choices= DF %>% distinct(SourceTable) , selected = "Sales.DocumentDetails", options = list(`actions-box` = TRUE,
                                                                                                                                            `live-search` = TRUE,
                                                                                                                                            `deselect-all-text` = "None...",
                                                                                                                                            `select-all-text` = "Yeah, all !",
                                                                                                                                            `none-selected-text` = "None"),multiple = T),br(),br(),

      pickerInput("ActionUserID", "Select ActionUserID", choices= DF %>% distinct(ActionUserID), options = list(`actions-box` = TRUE,
                                                                                                                                 `live-search` = TRUE,
                                                                                                                                 `deselect-all-text` = "None...",
                                                                                                                                 `select-all-text` = "Yeah, all !",
                                                                                                                                 `none-selected-text` = "None"),multiple = T),br(),br(),

      pickerInput("`Attribute Name`", "Select Attribute Name", choices= AttributeName, options = list(`actions-box` = TRUE,
                                                                                                      `live-search` = TRUE,
                                                                                                      `deselect-all-text` = "None...",
                                                                                                      `select-all-text` = "Yeah, all !",
                                                                                                      `none-selected-text` = "None"),multiple = T),br(),br(),


      downloadButton('downloadData', 'Download Data as CSV'), br(),
      width = 3

    ),

    mainPanel(
      tabsetPanel(
        tabPanel("Logs",DT::dataTableOutput("Log"))
      )
    )
  )
)

服务器端

server <- function(input, output) {
  Data <- reactive({
    DF %>% filter(SourceTable %in% input$SourceTable, ActionUserID %in% input$ActionUserID)
  })
  Data2 <-reactive({
    result <- lapply(Data()$RowVersion , function(x) {
      xml  <- read_xml(x)
      xml_attrs(xml)
    })
    allNames <- unique(unlist(lapply(result, names)))

    placeholder <- rep(NA, length(allNames))
    names(placeholder) <- allNames
    matrixRes <- t(sapply(result, function(x) {
      # fill values with existing attributes
      tmp <- placeholder
      tmp[names(x)] <- x
      tmp
    }))
    dataFrameRes <-as.data.frame(matrixRes) %>% mutate_all(parse_guess)
    Final <-bind_cols(Data(), dataFrameRes)[,-which(names(Data()) %in% "RowVersion")]

    gathered_data <- gather(Final, "Attribute Name", "Value",-c(1,2,3,4,5,"ID","DocumentID"))  %>% 
      arrange(as.numeric(VersionID)) # %>% na.omit
    # FF <- data.table(Final)
    # s <- melt.data.table(FF,id.vars = c(1,2,3,4,5,"ID","DocumentID"),variable.name = "Attribute Name", value.names = "Value",variable.factor= TRUE,value.factor = TRUE)
    #Handeling Data
    gathered_data <- plyr::rename(gathered_data,c("ID" = "Common Entity Id","DocumentID" = "Header Entity Id"))
    #Get Lag Values 

    gathered_data.table <- data.table(gathered_data)
    StartTime <- Sys.time()
    Row1 <- gathered_data.table[,Was:=shift(Value, 1) , by=c("`Attribute Name`")]
    Row1 <- Row1[!is.na(Row1$Value), ] %>% 
      filter(Value != Was)
    Row1 %>% filter(Action %in% input$Action) 
  })
  output$Log = DT::renderDataTable({Data2()
  })

  output$Test <- reactive({
    Data2$`Attribute Name`
  })



  output$downloadData <- downloadHandler(
    filename = 'AuditLog.csv',
    content = function(file) {
      write.csv(Data2(), file)
    }
  )
}

0 个答案:

没有答案