Shiny Dynamic UI Resetting to Original Values

泪湿孤枕 提交于 2021-01-29 08:39:17

问题


I have created a dynamic UI with the number of rows of a 'table' defined by a slider. I would like to use the numericInputs from the UI to perform further calculations. In the example below I have tried to calculate a rate from the two numeric inputs, which seems to work when new values are entered but immediately defaults back to the original starting values.

I tried using a button and changing the observe to an observeEvent to calculate the rates which worked to generate the result, but did not stop the numericInputs defaulting back to the starting values.

I have also tried to create the textboxes as a reactive and then call it to renderUI which gives the same 'broken' functionality.

  output$groupings <- renderUI({ textboxes() })
    
  textboxes <- reactive ({  

I think I need to create vector or datatable to store the inputs so that I can call them later, however I've been unsuccessful so far. My working example is below:

library(shiny)

mod1UI <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
    hr(),
    fluidRow(
      column(2, 
             strong("Speed")),
      column(2,
             strong("Amount")),
      column(2,
             strong("Run Rates"))
    ),
    hr(),
    uiOutput(ns("textboxes")),
  )
}

mod1 <- function(input, output, session, data) {
  ns <- session$ns
  m <- reactiveValues(x=NULL)

  output$textboxes <- renderUI ({  
    req(input$groups)
    lapply(1:input$groups, function(i) {
      fluidRow(
        column(2,
               numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
        ),
        column(2, 
               numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
        ),
        column(2,
               (m$x[[i]])
        )
      )
    })
  })
  
  observe({
    lapply(1:input$groups, function(i){
      m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
    })
  })
}

ui <- fluidPage(
  fluidRow(
    column(12,
           mod1UI("input1"))
  )
)

server <- function(input, output, session) {
  y <- callModule(mod1, "input1")
}

shinyApp(ui, server)

回答1:


Your problem is that you render all elements to one output, output$textboxes. Changing the input value of one of your numeric inputs leads to the calculation of a new rate, so the reactive Value m gets updated and the output$textboxes is rerendered.

Below I present you a solution where the different columns are rendered separately; you would have to play with HTML/CSS to display the values nicely. However, if you change the numbers of rows with the slider, all inputs are reset. Therefore I also added a solution where every row is a module that can be added.

library(shiny)

mod1UI <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
    hr(),
    fluidRow(
      column(2, 
             strong("Speed")),
      column(2,
             strong("Amount")),
      column(2,
             strong("Run Rates"))
    ),
    hr(),
    fluidRow(
      column(2,
             uiOutput(ns("UI_speed"))),
      column(2,
             uiOutput(ns("UI_amount"))),
      column(2,
             uiOutput(ns("rates")))
    )
  )
}

mod1 <- function(input, output, session, data) {
  ns <- session$ns
  m <- reactiveValues(x=NULL)
  
  output$UI_speed <- renderUI({
    req(input$groups)
    lapply(1:input$groups, function(i) {
      numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
    })
  })
  
  output$UI_amount <- renderUI({
    req(input$groups)
    lapply(1:input$groups, function(i) {
      numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
    })
  })
  
  output$rates <- renderUI({
    req(input$groups)
    text <- lapply(1:input$groups, function(i) {
      m$x[[i]]
    })
    
    HTML(paste0(text, collapse = "<br>"))
  })
  
  observe({
    lapply(1:input$groups, function(i){
      m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
    })
  })
}

ui <- fluidPage(
  fluidRow(
    column(12,
           mod1UI("input1"))
  )
)

server <- function(input, output, session) {
  y <- callModule(mod1, "input1")
}

shinyApp(ui, server)

Every row is a module

You get more flexibility if you have the slider in the main app and then add/remove a module. The module UI now consists of a set of inputs for Speed and Amount and an Output for the Rate. You can use insertUI and removeUI to dynamically control the amount of modules and with this the amount of displayed UI elements.

library(shiny)

mod1UI <- function(id) {
  ns <- NS(id)
  
    fluidRow(
      id = id,
      column(2,
             uiOutput(ns("UI_speed"))),
      column(2,
             uiOutput(ns("UI_amount"))),
      column(2,
             textOutput(ns("rates")))
    )
  
}

mod1 <- function(input, output, session, data) {
  ns <- session$ns
  
  output$UI_speed <- renderUI({
    
    numericInput(inputId = ns("speed"), value = 700, label = NULL, width = 80)
  })
  
  output$UI_amount <- renderUI({
    
    numericInput(inputId = ns("amount"), value = 14, label = NULL, width = 80)
  })
  
  output$rates <- renderText({
    get_rate()
  })
  
  get_rate <- reactive({
    input$speed * input$amount * 60
  })
}

ui <- fluidPage(
  fluidRow(
    column(12,
           sliderInput(inputId = "groups", label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
           hr(),
           fluidRow(
             column(2, 
                    strong("Speed")),
             column(2,
                    strong("Amount")),
             column(2,
                    strong("Run Rates"))
           ),
           hr(),
           tags$div(id = "insert_ui_here")
    )
  )
)

number_modules <- 4
current_id <- 1

server <- function(input, output, session) {
  
  # generate the modules shown on startup
  for (i in seq_len(number_modules)) {
    
    # add the UI
    insertUI(selector = '#insert_ui_here',
             ui = mod1UI(paste0("module_", current_id)))
    # add the logic
    callModule(mod1, paste0("module_", current_id))
    
    # update the id
    current_id <<- current_id + 1
    
  }
  
  observeEvent(input$groups, {
    
    # add modules
    if (input$groups > number_modules) {
      for (i in seq_len(input$groups - number_modules)) {
        # add the UI
        insertUI(selector = '#insert_ui_here',
                 ui = mod1UI(paste0("module_", current_id)))
        
        # add the logic
        callModule(mod1, paste0("module_", current_id))
        
        # update the id
        current_id <<- current_id + 1
      }
    } else {
      # remove modules
      for (i in seq_len(number_modules - input$groups)) {
        # remove the UI
        removeUI(selector = paste0("#module_", current_id - 1))
        current_id <<- current_id - 1
      }
      
    }
    
    # update the number of modules
    number_modules <<- input$groups
    
    
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)


来源:https://stackoverflow.com/questions/62811707/shiny-dynamic-ui-resetting-to-original-values

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!