Невозможно сбросить входные данные в блестящем приложении, используя блестящий - PullRequest
Новая
       8

Невозможно сбросить входные данные в блестящем приложении, используя блестящий

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

После ответов здесь Я пытался использовать shinyjs для сброса входного значения, передав id к div в UI и вызывая его при нажатии на сброс. Ниже приведен мой код для того, что я пробовал. 

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

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

  output$x1 <- DT::renderDataTable({
    modelRun()
    isolate(
      datatable(
        modelData %>% 
          mutate(Current  = as.numeric(Current)*(budget())),
        selection = 'none', editable = TRUE
      )
    )
  })

  observeEvent(reset(), {
    shinyjs::reset("input-panel")
  })  
}
tableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}

ui <- function(request) {
  fluidPage(
    div(shinyjs::useShinyjs(), id = "input-panel",
    tableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run"),
    actionButton("opt_reset", "Reset")
  ))
}

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

  df <- data.frame(Channel = c("A", "B","C"),
                   Current = c(2000, 3000, 4000),
                   Modified = c(2500, 3500,3000),
                   New_Membership = c(450, 650,700),
                   stringsAsFactors = FALSE)

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

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

}

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

1 Ответ

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

Это частичное решение, когда кнопка run действительно не требуется.Поскольку input$budget_input является реактивным значением, таблица обновляется автоматически при изменении входного значения. 

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

tableUI <- function(id) {
  ns <- NS(id)
  tagList(

    div(id = ns("input-panel"),
    h1("Tests "),

    numericInput(ns("budget_input"), "Total Forecast", value = 2),
    actionButton(ns("opt_run"), "Run"),
    actionButton(ns("opt_reset"), "Reset"),

    dataTableOutput(ns("x1"))
    )
  )



}


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


 # observeEvent(input$opt_run, ignoreInit = TRUE, {
 #   Multiplier <- reactiveVal(input$budget_input)
 #   cat(Multiplier())
 # })


#  observeEvent(input$opt_run,{

    output$x1 <-  DT::renderDataTable({

   #  isolate(
    datatable(
      modelData %>% 
        mutate(Current  = as.numeric(Current)*(input$budget_input)),
      selection = 'none', editable = TRUE
        )
  #  )
  })
    #})


  observeEvent(input$opt_reset,{

    shinyjs::reset("input-panel")

    })
#  }) 

}



ui <- fluidPage(
  useShinyjs(debug = TRUE),    
  tableUI("opfun")
)

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

  df <- data.frame(Channel = c("A", "B","C"),
                   Current = c(2000, 3000, 4000),
                   Modified = c(2500, 3500,3000),
                   New_Membership = c(450, 650,700),
                   stringsAsFactors = FALSE)

  callModule( tableMod,"opfun",
             # modelRun = reactive(input$opt_run),
           # reset = reactive(input$opt_reset),
              modelData = df
           #   budget = reactive(input$budget_input)
           )



}

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