Saya telah membuat UI dinamis dengan jumlah baris 'tabel' yang ditentukan oleh penggeser. Saya ingin menggunakan input numerik dari UI untuk melakukan perhitungan lebih lanjut. Dalam contoh di bawah ini saya telah mencoba menghitung tarif dari dua input numerik, yang tampaknya berfungsi ketika nilai baru dimasukkan tetapi langsung kembali ke nilai awal semula.

Saya mencoba menggunakan tombol dan mengubah observasi menjadi observEvent untuk menghitung tarif yang berfungsi untuk menghasilkan hasil, tetapi tidak menghentikan NumericInputs kembali ke nilai awal.

Saya juga mencoba membuat kotak teks sebagai reaktif dan kemudian memanggilnya ke renderUI yang memberikan fungsionalitas 'rusak' yang sama.

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

Saya berpikir saya perlu membuat vektor atau datatable untuk menyimpan input sehingga saya dapat memanggilnya nanti, namun sejauh ini saya tidak berhasil. Contoh kerja saya di bawah ini:

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)
0
BenS 9 Juli 2020, 12:26

1 menjawab

Jawaban Terbaik

Masalah Anda adalah Anda membuat semua elemen menjadi satu keluaran, output$textboxes. Mengubah nilai input dari salah satu input numerik Anda mengarah ke penghitungan tarif baru, sehingga Nilai reaktif m diperbarui dan output$textboxes dirender ulang.

Di bawah ini saya menyajikan solusi di mana kolom yang berbeda diberikan secara terpisah; anda harus bermain dengan HTML/CSS untuk menampilkan nilai dengan baik. Namun, jika Anda mengubah jumlah baris dengan penggeser, semua input akan diatur ulang. Oleh karena itu saya juga menambahkan solusi dimana setiap baris adalah modul yang dapat ditambahkan.

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)

Setiap baris adalah modul

Anda mendapatkan lebih banyak fleksibilitas jika Anda memiliki penggeser di aplikasi utama dan kemudian menambah/menghapus modul. UI modul sekarang terdiri dari satu set input untuk Kecepatan dan Jumlah dan Output untuk Tarif. Anda dapat menggunakan insertUI dan removeUI untuk mengontrol jumlah modul secara dinamis dan dengan ini jumlah elemen UI yang ditampilkan.

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)
0
starja 9 Juli 2020, 13:34