Shiny Dynami c Сброс пользовательского интерфейса к исходным значениям - PullRequest
Новая
       5

Shiny Dynami c Сброс пользовательского интерфейса к исходным значениям

0 голосов
/ 09 июля 2020

Я создал динамический c UI с количеством строк «таблицы», определяемым ползунком. Я хотел бы использовать numericInputs из пользовательского интерфейса для выполнения дальнейших вычислений. В приведенном ниже примере я попытался вычислить скорость из двух входов numeri c, которые, кажется, работают, когда вводятся новые значения, но сразу же по умолчанию возвращаются к исходным начальным значениям.

Я попытался использовать кнопку и изменив наблюдение на наблюдениеEvent, чтобы вычислить скорости, которые помогли сгенерировать результат, но не остановили значение numericInputs по умолчанию обратно к начальным значениям.

Я также попытался создать текстовые поля как реактивные, а затем вызовите его в renderUI, который дает ту же «сломанную» функциональность. 

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

I think Мне нужно создать вектор или данные для хранения входных данных, чтобы я мог вызывать их позже У меня пока ничего не получалось. Мой рабочий пример ниже: 

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 Ответ

0 голосов
/ 09 июля 2020

Ваша проблема в том, что вы выводите все элементы на один вывод, output$textboxes. Изменение входного значения одного из ваших числовых c входов приводит к вычислению новой скорости, поэтому реактивное значение m обновляется, а output$textboxes повторно отображается.

Ниже я представляю вам решение, в котором разные столбцы отображаются отдельно; вам придется поиграться с HTML / CSS, чтобы правильно отображать значения. Однако, если вы измените количество строк с помощью ползунка, все входы будут сброшены. Поэтому я также добавил решение, в котором каждая строка представляет собой модуль, который можно добавить. 

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)

Каждая строка представляет собой модуль

Вы получите большую гибкость, если у вас есть ползунок в основном приложении, а затем добавляете / удаляете модуль. Пользовательский интерфейс модуля теперь состоит из набора входов для скорости и суммы и выхода для скорости. Вы можете использовать insertUI и removeUI для динамического управления количеством модулей и, соответственно, количеством отображаемых элементов пользовательского интерфейса. 

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)
...