用户在闪亮的应用程序中更新数据表时如何更新反应性数据框

时间:2019-10-19 04:43:03

标签: r shiny

我的闪亮应用程序中有一个可编辑的dataTable。现在,我需要在反应性数据帧中获取数据。此外,用户可以在数据表中添加现有行,并且如果他不修改添加的行,则应用程序应弹出错误。我已经设法以某种方式将更新后的值提取到反应式数据框,但是现在我无法在另一个ovserveEvent中使用反应式数据框来显示错误。我试图复制下面的代码。我们非常感谢您的帮助。

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
iris1<- iris
iris1$index <- c(1:50,1:50,1:50)

home<-bs4TabSetPanel(
  id = "tabset1",
  side = "left",
  bs4TabPanel(
    active = TRUE,
    tabName = "Tab2",
    fluidRow(
      column(6,selectInput("sel2","choose", choices = c("Select",1:50))),
      column(6,selectInput("sel1","choose", choices = iris$Species))
    ),
    fluidRow(
      uiOutput("tbl1")
    ),
    fluidRow(actionButton("save","Save"))
  )
)

ui<- bs4DashPage(
  navbar = bs4DashNavbar(),
  sidebar = bs4DashSidebar(),
  controlbar = bs4DashControlbar(),
  footer = bs4DashFooter(),
  title = "test",
  body = bs4DashBody(
    home
  )
)

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

  output$tbl1<- renderUI(
    DTOutput('t1')
  )

  output$t1<- renderDT({
    datatable(iris1, editable = TRUE)
  })

  observeEvent(input$sel1,{
   if(input$sel1 != "") {
      output$t1<-renderDT({
      d1<- iris1 %>% filter(Species == input$sel1)
    datatable(d1, editable = T)
      })
      } else(
        output$t1<- renderDT({
          datatable(iris1, editable = TRUE)
        })
      )
  })

  observeEvent(input$sel2,{
    if(input$sel2 != "Select") {
      output$t1<-renderDT({
        d1<- iris1 %>% filter(Species == input$sel1)
        rw<-d1 %>% filter(index == input$sel2)
        d1<- rbind(d1,rw)
        datatable(d1, editable = T)
      })
    } else(
      output$t1<- renderDT({
        datatable(iris1, editable = TRUE)
      })
    )
  })

  react1<-eventReactive(c(input$sel2,input$sel1),{
    d1<- iris1 %>% filter(Species == input$sel1)
    rw<-d1 %>% filter(index == input$sel2)
    d1<- rbind(d1,rw)
  })
  v<- reactiveValues(data1 = NULL)

  proxy<- dataTableProxy("t1")

  observeEvent(input$t1_cell_edit,{
    # print(input$t1_cell_edit)
    # print(react1()[input$t1_cell_edit$row, input$t1_cell_edit$col])
    v$data1<- iris1 %>% filter(Species == input$sel1)
    rw<-d1 %>% filter(index == input$sel2)
    v$data1 <- rbind(d1,rw)
     v$data1[input$t1_cell_edit$row, input$t1_cell_edit$col]<- input$t1_cell_edit$value
     print(v$data1[input$t1_cell_edit$row, input$t1_cell_edit$col])
  })

  observeEvent(input$save,{
    temp<-v$data1
    if(anyDuplicated(temp)==nrow(temp)){
      print("Error")
    }
  })


}

shinyApp(ui,server)

input $ save的observeEvent不起作用,因为更新的v $ data1在这里不可用

0 个答案:

没有答案