Отредактируйте блестящее приложение DT в R, чтобы обновить вторую таблицу DT - PullRequest
Новая
       2

Отредактируйте блестящее приложение DT в R, чтобы обновить вторую таблицу DT

0 голосов
/ 05 марта 2019

Я пытаюсь работать над блестящим приложением, в котором, если пользователь редактирует первую таблицу, оно изменяет значение во второй таблице.Если вы видите код, у меня есть две таблицы x1 и x2 в функции tableMod. Значения в таблице x1 основаны на значениях из таблицы x2 и некоторых вычислениях.Так что я хочу сделать, если пользователь изменяет значения с помощью редактирования в таблице x1, он должен обновить значения путем обратного расчета в таблице x2.Ниже приведен код, за исключением того, как выполнять редактирование и обратные вычисления: 

library(shiny)
library(DT)
library(dplyr)

df <- data.frame(Channel = c("A", "B","C"),
                 Current = c(2000, 3000, 4000),
                 Modified = c(2500, 3500,3000),
                 New_Membership = c(362, 577,575),
                 stringsAsFactors = FALSE)
rates <- data.frame(
                 low = c(1000, 2000, 3000),
                 high = c(4000, 6000,8000),
                 stringsAsFactors = FALSE)

#### Module 1 renders the first table
tableMod <- function(input, output, session, modelRun,modelData,ratesData,budget){


  observeEvent( input$x1_cell_edit, {
    cat ('input$x1_cell_edit \n')
    info = input$x1_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    df[i, j] <- DT:::coerceValue(v, df[i, j])
    assign("df", df, envir = .GlobalEnv)

  })


  output$x1 <- DT::renderDataTable({
    modelRun()
   modelData <- df
   ratesData <- rates
    isolate(
      datatable(
        modelData %>% 
          mutate(Current = (ratesData$low * budget())) %>%
          mutate(Modified = (ratesData$high * budget())),
         #mutate(New_Membership  = round((Current*ratesData$low + Modified*ratesData$high)*budget(),0) ),
        selection = 'none', editable = TRUE
      )
    )
  })
  output$x2<- DT::renderDataTable({
    ratesData
  })


}
firstTableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}
secondTableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x2"))
}

ui <- function(request) {
  fluidPage(
    firstTableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run"),
    secondTableUI("opfun")
  )
}
server <- function(input, output, session) {

  callModule( tableMod,"opfun",
              modelRun = reactive(input$opt_run),
              modelData = df,
              ratesData = rates,
              budget = reactive(input$budget_input))

  observeEvent(input$opt_run, {
    cat('HJE')
  })
}

shinyApp(ui, server, enableBookmarking = "url")
...