Shiny Dynamic UI 重置为原始值
Shiny Dynamic UI Resetting to Original Values
我创建了一个动态 UI,其中 'table' 的行数由滑块定义。我想使用 UI 中的 numericInputs 来执行进一步的计算。在下面的示例中,我尝试从两个数字输入中计算一个比率,这似乎在输入新值时起作用,但立即默认返回到原始起始值。
我尝试使用按钮并将 observe 更改为 observeEvent 以计算生成结果的速率,但没有阻止 numericInputs 默认返回到起始值。
我还尝试将文本框创建为响应式,然后将其调用以呈现 UI,它提供相同的 'broken' 功能。
output$groupings <- renderUI({ textboxes() })
textboxes <- reactive ({
我 认为 我需要创建向量或数据表来存储输入,以便稍后调用它们,但是到目前为止我一直没有成功。我的工作示例如下:
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)
您的问题是您将所有元素渲染到一个输出,output$textboxes
。更改其中一个数字输入的输入值会导致计算新的比率,因此反应值 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)
每一行都是一个模块
如果您在主应用程序中有滑块,然后 add/remove 有一个模块,您将获得更大的灵活性。模块 UI 现在由一组速度和数量的输入以及一个速率的输出组成。您可以使用 insertUI
和 removeUI
来动态控制模块的数量以及显示的 UI 元素的数量。
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)
我创建了一个动态 UI,其中 'table' 的行数由滑块定义。我想使用 UI 中的 numericInputs 来执行进一步的计算。在下面的示例中,我尝试从两个数字输入中计算一个比率,这似乎在输入新值时起作用,但立即默认返回到原始起始值。
我尝试使用按钮并将 observe 更改为 observeEvent 以计算生成结果的速率,但没有阻止 numericInputs 默认返回到起始值。
我还尝试将文本框创建为响应式,然后将其调用以呈现 UI,它提供相同的 'broken' 功能。
output$groupings <- renderUI({ textboxes() })
textboxes <- reactive ({
我 认为 我需要创建向量或数据表来存储输入,以便稍后调用它们,但是到目前为止我一直没有成功。我的工作示例如下:
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)
您的问题是您将所有元素渲染到一个输出,output$textboxes
。更改其中一个数字输入的输入值会导致计算新的比率,因此反应值 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)
每一行都是一个模块
如果您在主应用程序中有滑块,然后 add/remove 有一个模块,您将获得更大的灵活性。模块 UI 现在由一组速度和数量的输入以及一个速率的输出组成。您可以使用 insertUI
和 removeUI
来动态控制模块的数量以及显示的 UI 元素的数量。
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)