我正在开发RShiny应用程序。有一个完整的按钮。它的ID是“提交”只有在填写某些详细信息时才应启用完整按钮。最初有三个数字输入。 ID是“current”,“next”,“next1”。
数字输入的屏幕截图是:
在它之后,有三个选择输入。 ID是“sel1”,“sel2”,“sel3”。
Selectize Input的截图是:
后来有三个textOutputs。 ID是“text2”,“text3”,“text4”。它应该是100%。为了获得100%,使用3 “反应性()”。
这是使用的RCode。
require(shiny)
require(shinyjs)
#install.packages("shinyjs")
ui = fluidPage( useShinyjs(),
inlineCSS(list('.lightpink' = "background-color: lightpink",'.red' = "background-color: red", "textarea" = 'text-align: center', '#text3 ' = 'text-align: center', '.form-control' = 'padding:8.5px ')),
fluidRow(
column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
),
column(3, actionButton("submit", "Complete"))
),
fluidRow(
column(3,tags$h3("Actual Work Hours")
),
column(3, wellPanel(
numericInput("current", "Current Week",value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next1", "Next Week", value = 40, min = 40, max = 80)
)),
column(3, wellPanel(
numericInput("next2", "Two weeks from now", value = 40, min = 40, max = 80)
))),
fluidRow(
column(3,tags$h3("About Your Work-Week")
),
column(3, wellPanel(
selectizeInput("sel1", "How was your current week?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Current week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel2", "How busy will be the next week?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Next week",
onInitialize = I('function() { this.setValue(""); }')
)))),
column(3, wellPanel(
selectizeInput("sel3", "How busy will be the next two weeks?",
choices = c("aa",
"bb",
"cc"),
options = list(
placeholder = "Next two week",
onInitialize = I('function() { this.setValue(""); }')
))))),
fluidRow(uiOutput("inputGroup")),
fluidRow(column(3,wellPanel(textOutput("text3")),
tags$head(tags$style("#text3{color: white;
font-style: italic;
}"
)
)))
)
# takes in two arguments
sumN <- function(a, x){
a <- sum(a, as.numeric(x),na.rm=T)
return(a)
}
server <- function(input, output, session) {
Widgets <- eventReactive(input$View,{ input_list <- lapply(1:(input$count),
function(i) {
inputName <- paste("id", i, sep = "")
textInputRow <- function (inputId,value) {
textAreaInput(inputName,"", width = "200px", height = "43px", resize = "horizontal" )
#numericInput(inputName,"",1,0,100)
}
column(4,textInputRow(inputName, "")) })
do.call(tagList, input_list)},ignoreInit = T)
output$inputGroup = renderUI({Widgets()})
getvalues <- reactive({
val <- 0
for(lim in 1:input$count){
observeEvent(input[[paste0("id",lim)]], {
updateTextAreaInput(session,paste0("id",lim), value = ({
x = as.numeric(input[[paste0("id",lim)]])
if(!(is.numeric(x))){0}
else if(!(is.null(x) || is.na(x))){
if(x < 0){
0
}else if(x > 100){
100
} else{
return (isolate(input[[paste0("id",lim)]]))
}
}
else if((is.null(x) || is.na(x))){
0
}
})
)
})
req(as.numeric(input[[paste0("id",lim)]]) >= 0 & as.numeric(input[[paste0("id",lim)]]) <= 100)
val <- sumN(val,as.numeric(input[[paste0("id",lim)]]))
}
val
})
output$text3 <- renderText({
getvalues()
})
observeEvent(getvalues(), {
nn <- getvalues()
if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn)) & nn == 100) {
removeClass("text3", 'red')
addClass('text3','lightpink')
} else { addClass('text3','red')}
})
}
shinyApp(ui=ui, server = server)
上述代码不会产生所需的输出。简而言之,只有在填充数字输入,选择输入并且textOutput应为100%时,才应启用“完成”按钮。任何人都可以为这个问题提供解决方案吗?
答案 0 :(得分:0)
使用disable
的{{1}}和enable
更新了代码,并考虑了工作周选择的条件。
shinyjs