首先，这是一个可运行的示例：
library(shiny)
library(shinyjs)
library(dplyr)
###################################################################################
MTX_UI <- fluidPage(
fluidRow(column(6, titlePanel("Calculator"))),
fluidRow(numericInput("Ninf", "Ninf", 1,
min = 1, max = 12, step = 1) %>% column(., width = 3)),
tags$div(id = "InfPanel"),
hr(),
fluidRow(column(3, actionButton("calculate", "Calculate")))
)
###################################################################################
MTX_Server <- function(input, output, session) {
#UI creation
change_Ninf <- reactive({input[["Ninf"]]})
ExistNinf <<- 0
#Creating inf panels
observeEvent(change_Ninf(), {
Ninf <- change_Ninf()
if (Ninf>ExistNinf) {
#Decide list to insert
if (ExistNinf==0) {lstToIns <- seq(Ninf)} else {lstToIns <- seq(Ninf)[-seq(ExistNinf)]}
#Update list inserted
ExistNinf <<- Ninf
#Insert UI & reactive component
for (InfN in lstToIns) {
#Insert UI
insertUI(
selector = '#InfPanel',
ui = conditionalPanel(paste0("input.Ninf >= ", InfN),
hr(),
wellPanel(
fluidRow(column(3, titlePanel(paste0("Inf #", InfN)))),
fluidRow(column(3, numericInput(paste0("Nobs_", InfN),
"Nobs:", 2, min = 2, max = 12, step = 1)),
column(3, textInput(paste0("Var10_", InfN), "Var10:", 12)),
column(3, textInput(paste0("Var11_", InfN), "Var11:", 1.3)),
column(3, textInput(paste0("Var12_", InfN), "Var12:", 6))
),
fluidRow(column(2, "VAR1:"),
column(2, "VAR2:"),
column(1, "VAR3:"),
column(1, "VAR4:"),
column(2, "VAR5:"),
column(1, "VAR6:"),
column(1, "VAR7:")
),
fluidRow(
column(1, offset = 4, checkboxInput(paste0("fix_VAR3_", InfN), "Same", FALSE)),
column(1, checkboxInput(paste0("fix_VAR4_", InfN), "Same", FALSE)),
column(2, checkboxInput(paste0("fix_VAR5_", InfN), "Same", FALSE)),
column(1, checkboxInput(paste0("fix_VAR6_", InfN), "Same", FALSE)),
column(1, checkboxInput(paste0("fix_VAR7_", InfN), "Same", FALSE))
),
tags$div(id = paste0("ObsPanel_", InfN))
))
)
#Create fixation reactive components
assign(paste0("react_fix_VAR3_", InfN), reactive({input[[paste0("fix_VAR3_", InfN)]]}), inherits = T)
assign(paste0("react_fix_VAR4_", InfN), reactive({input[[paste0("fix_VAR4_", InfN)]]}), inherits = T)
assign(paste0("react_fix_VAR5_", InfN), reactive({input[[paste0("fix_VAR5_", InfN)]]}), inherits = T)
assign(paste0("react_fix_VAR6_", InfN), reactive({input[[paste0("fix_VAR6_", InfN)]]}), inherits = T)
assign(paste0("react_fix_VAR7_", InfN), reactive({input[[paste0("fix_VAR7_", InfN)]]}), inherits = T)
#Update Obs reactive components
assign(paste0("change_Nobs_", InfN), reactive({input[[paste0("Nobs_", InfN)]]}), inherits = T)
#Creating Obs components
if (!exists(paste0("ExistNobs_", InfN))) {assign(paste0("ExistNobs_", InfN), 0)}
observeEvent(get(paste0("change_Nobs_", InfN))(), {
Nobs <- get(paste0("change_Nobs_", InfN))()
ExistNobs <- get(paste0("ExistNobs_", InfN))
if (Nobs>ExistNobs) {
#Decide list to insert
if (ExistNobs==0) {lstToIns_obs <- seq(Nobs)} else {lstToIns_obs <- seq(Nobs)[-seq(ExistNobs)]}
#Update list inserted
assign(paste0("ExistNobs_", InfN), Nobs, inherits = T)
#Insert UI
for (ObsN in lstToIns_obs) {
if (ObsN==1) {
insertUI(
selector = paste0("#ObsPanel_", InfN),
ui = conditionalPanel(paste0("input.Nobs_", InfN, " >= ", 1),
fluidRow(
column(2, textInput(paste0("VAR1_", InfN, "_", 1), NULL, 0)),
column(2, textInput(paste0("VAR2_", InfN, "_", 1), NULL, 0)),
column(1, textInput(paste0("VAR3_", InfN, "_", 1), NULL, 1)),
column(1, textInput(paste0("VAR4_", InfN, "_", 1), NULL, 1)),
column(2, textInput(paste0("VAR5_", InfN, "_", 1), NULL, 1)),
column(1, textInput(paste0("VAR6_", InfN, "_", 1), NULL, 1)),
column(1, textInput(paste0("VAR7_", InfN, "_", 1), NULL, 1))
))
)
shinyjs::useShinyjs()
shinyjs::disable(paste0("VAR1_", InfN, "_1"))
shinyjs::disable(paste0("VAR2_", InfN, "_1"))
} else {
insertUI(
selector = paste0("#ObsPanel_", InfN),
ui = conditionalPanel(paste0("input.Nobs_", InfN, " >= ", ObsN),
fluidRow(
column(2, textInput(paste0("VAR1_", InfN, "_", ObsN), NULL, 1)),
column(2, textInput(paste0("VAR2_", InfN, "_", ObsN), NULL, 1)),
column(1, textInput(paste0("VAR3_", InfN, "_", ObsN), NULL, 1)),
column(1, textInput(paste0("VAR4_", InfN, "_", ObsN), NULL, 1)),
column(2, textInput(paste0("VAR5_", InfN, "_", ObsN), NULL, 1)),
column(1, textInput(paste0("VAR6_", InfN, "_", ObsN), NULL, 1)),
column(1, textInput(paste0("VAR7_", InfN, "_", ObsN), NULL, 1))
))
)
local({
observeEvent(get(paste0("react_fix_VAR3_", InfN))(), {
shinyjs::toggleState(paste0("VAR3_", InfN, "_", ObsN), !(get(paste0("react_fix_VAR3_", InfN))()))
})
observeEvent(get(paste0("react_fix_VAR4_", InfN))(), {
shinyjs::toggleState(paste0("VAR4_", InfN, "_", ObsN), !(get(paste0("react_fix_VAR4_", InfN))()))
})
observeEvent(get(paste0("react_fix_VAR5_", InfN))(), {
shinyjs::toggleState(paste0("VAR5_", InfN, "_", ObsN), !(get(paste0("react_fix_VAR5_", InfN))()))
})
observeEvent(get(paste0("react_fix_VAR6_", InfN))(), {
shinyjs::toggleState(paste0("VAR6_", InfN, "_", ObsN), !(get(paste0("react_fix_VAR6_", InfN))()))
})
observeEvent(get(paste0("react_fix_VAR7_", InfN))(), {
shinyjs::toggleState(paste0("VAR7_", InfN, "_", ObsN), !(get(paste0("react_fix_VAR7_", InfN))()))
})
})
}
}
}
})
}
}
})
}
###################################################################################
shinyApp(MTX_UI, MTX_Server)
我期待以下内容：
- 当用户更改时
Ninf（在应用程序的顶部），wellPanel显示的 Inf 数量会相应更改。（顶层反应式）- 对于每个 Inf
wellPanel，当用户更改时Nobs，要输入的观察行数将相应更改。（第二层反应）wellPanel生成每个 Inf 时，每个和textInput下的第一个框应自动禁用（按）。VAR1VAR2shinyjs::disable- 对于每个 Inf
wellPanel，当Same每个VAR3to下的框VAR7被选中时，其下方的所有textInput框VARx（第一个除外）都应禁用（byshinyjs::toggleState）。（第三层反应）
到目前为止，我在#1 和#2 上都是成功的。但是到目前为止，我为实现#3 和#4 所做的努力是徒劳的，并且一直在挣扎……
我开始对所有内容进行硬编码（使用max.Ninf=12and max.Nobs=12），但结果显示加载时间很长，因为它必须一次加载所有对象 - 事实上，通常用户只会使用前两个 Inf 面板。所以我转向这种嵌套结构的方法并尝试使用insertUI. 但是上面的问题阻止了我前进。
谢谢！