R DT包中的Shiny更新数据表

时间:2019-02-21 15:51:36

标签: r shiny

我制作了一个闪亮的仪表板,该仪表板连接到postegreDB并从表中获取值,然后将其子集,然后使用reshape2将其转换为宽格式。我想直接从仪表板更新值,然后将其推入数据库。

我通过以下链接获取灵感:https://github.com/MangoTheCat/dtdbshiny

这是我编写的代码:

server <- function(input, output, session) {

  # Generate reactive values
  rvs <- reactiveValues(
    data = NA,
    dataWide = NA,
    dataSub = NA,
    cdfilTmp = NA,
    cdfilTmp2 = NA,
    dataWideTmp = NA,
    dbdata = NA, 
    dataSame = TRUE, 
    req = NA,
    tabId = NA,
    listeSeuil = NA,
    dataMod = NA
  )

  # Generate source via reactive expression
  mysource <- reactive({
    dbGetQuery(pool, "SELECT * from bilanmasse.v_export_r_scen_seuil")
  })

  # Observe the source, update reactive values accordingly
  observeEvent(mysource(), {

    # Lightly format data by arranging id
    # Not sure why disordered after sending UPDATE query in db    
    data <- mysource() %>% arrange(idscenar)
    data <- dbGetQuery(pool, "SELECT * from bilanmasse.v_export_r_scen_seuil")
    rvs$cdfilTmp <- paste(data$ordreseuil, data$nomfiliere, sep="-")
    data$cdfiliere <- rvs$cdfilTmp
    data <- data[c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "cdfiliere", "valseuil")]
    rvs$data <- data
    rvs$dbdata <- data
    rvs$listeSeuil <- unique(rvs$data[,1])
    rvs$tabId <- dbGetQuery(pool, "SELECT * from bilanmasse.scenar_testr")

    updateSelectInput(session, "listScen", 
                      label = "Choix du scenario",
                      choices = isolate(rvs$listeSeuil)
                         )

  })

  rvs$dataSub <- reactive({ subset(rvs$data, rvs$data[,1] == input$listScen) })
  rvs$dataWide <- reactive({ dcast(rvs$dataSub(), idscenar+nomscenar+codeparam+cdusage+cdlithoprof~cdfiliere, value.var="valseuil") })
  rvs$dataWideTmp <- reactive({ rvs$dataWide() }) 

  ScenBase <- reactive({ subset(rvs$data, rvs$data[,1] == 2) })
  listeParam <- reactive({ unique(ScenBase()[,3]) })
  listeUsage <- reactive({ unique(ScenBase()[,4]) })
  listeLithoProf <- reactive({ unique(ScenBase()[,5]) })
  listeTraitement <- reactive({ unique(ScenBase()[,6]) })
  #

  # render the table
  output$tabScSeuil <- renderDataTable(
    rvs$dataWide(), rownames = FALSE, editable = TRUE, selection = 'none', filter= "top", options = list(
      columnDefs = list(list(className = 'dt-center', targets = "_all")))
  )

  proxy3 = dataTableProxy('tabScSeuil')

  observeEvent(input$tabScSeuil_cell_edit, {

    info = input$tabScSeuil_cell_edit

    i = info$row
    j = info$col = info$col + 1  # column index offset by 1
    v = as.numeric(info$value)


    rvs$dataWideTmp[i,j] <- v


    output$test <- renderPrint(rvs$dataWideTmp[i,j])

})

}

当我想将新值更新到表中时,所有工作都完全可以预期:我收到此错误:

  

[:类型为'closure'的对象的错误不能子集化

所以我尝试使用SQL请求而不是子集:

  observeEvent(input$listScen, {
    val <- as.character(input$listScen)
    req <- paste0("SELECT * from bilanmasse.v_export_r_scen_seuil WHERE idscenar = ", val)
    observeEvent(input$listScen, { dataSub <- dbGetQuery(pool, req) })
    #cdfilTmp2 <- paste(dataSub[,6], dataSub[,7], sep="-")
    #dataSub[,9] <- cdfilTmp2
    #dataSub <- dataSub[c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "V9", "valseuil")]
    #colnames(dataSub) <- c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "cdfiliere", "valseuil")
    #dataWide <- dcast(dataSub, idscenar+nomscenar+codeparam+cdusage+cdlithoprof~cdfiliere, value.var="valseuil")
    #dataWideTmp <-dataWide
    output$test <- renderPrint(req)
  })

但是我收到一个奇怪的错误,当我打印请求时,请求正常:

  

[1]“ SELECT * from bilanmasse.v_export_r_scen_seuil其中idscenar =   2“

但是在R控制台中,我出现了一个错误:

  

postgresqlQuickSQL(conn,statement,...)中的警告:无法   创建执行:SELECT * from bilanmasse.v_export_r_scen_seuil在哪里   idscenar =

有人知道解决方案吗?

0 个答案:

没有答案