闪亮：滑块输入观察多个事件和不同的默认值

问题描述

免责声明：我刚刚开始学习 R 来为我的论文编写一个实验程序，所以很抱歉提前询问可能是超级基本的问题。

我正在构建一个由多个页面组成的交互式问卷（德语）。

如果任何操作按钮 HSV8G1 被切换，我想加载页面 input$HSV1G1eq,input$HSV2G1eq,input$HSV3G1eq,input$HSV4G1eq,input$HSV5G1eq,input$HSV6G1eq,input$HSV7G1eq,input$HSV7G1A,input$HSV7G1B,input$HSV6G1A,input$HSV6G1B,input$HSV4G1A,input$HSV4G1B,input$HSV3G1A,input$HSV3G1B。

我尝试实施另一篇文章中建议的解决方案，但它返回错误“缺少 TRUE/FALSE 需要的值”。

HSV8S1 的默认值应该取决于用于访问页面的操作按钮 - 如何实现它？我尝试使用 if 函数，但无法使其工作。

请在下面找到我想出的代码 - 我知道这可能是一种愚蠢且不切实际的构建方式，但我还是刚刚开始:-)

非常感谢您的理解和支持。（如果我问的问题太多，请原谅！）

###instructions
W <-c("Weiter")
A <-c("Option A")
B <-c("Option B")
C <-c("Beiden Optionen haben den gleichen Wert")
D <-c("Fuer wie viele Jahre in perfekter Gesundheit waeren Sie indifferent zwischen Option A und Option B?")
E <-c("Welche Option bevorzugen Sie?")

###TTO input
tx <- 10
ty <- 20



library(shiny)

###################################################
#ui
###################################################

ui <- (htmlOutput("page"))

###intro
intro <- function(...) {
  div(class = 'container',id = "intro",div(class = 'col-sm-2'),div(class = 'col-sm-8',h1("Startseite"),p("Platzhalter"),br(),actionButton("W1",W)
      ))
  
}

###declaration of consent
decl <- function(...) {
  div(class = 'container',id = "decl",h1("Einwilligung zur Teilnahme"),radioButtons("Einwilligung",label = NULL,choices = c("Ich stimme zu","Ich stimme nicht zu")),actionButton("W2",W)
      ))
  
}

###explanation HSV
expl1 <- function(...) {
  div(class = 'container',id = "expl1",h1("Einleitung Teil 1"),actionButton("W3",W)
      ))
  
}

###HSV

#G1

HSV1G1 <- function(...) {
  div(class = 'container',id = "HSV1G1",h1(E),p(G1),actionButton("HSV1G1A",A),actionButton("HSV1G1B",B),actionButton("HSV1G1eq",C),sliderInput("S1",D,ty,10,step = 0.1)
      ))
  
}

HSV2G1 <- function(...) {
  div(class = 'container',id = "HSV2G1",actionButton("HSV2G1A",actionButton("HSV2G1B",actionButton("HSV2G1eq",sliderInput("HSV2S1",15,step = 0.1)
      ))
  
}

HSV3G1 <- function(...) {
  div(class = 'container',id = "HSV3G1",actionButton("HSV3G1A",actionButton("HSV3G1B",actionButton("HSV3G1eq",sliderInput("HSV3S1",17.5,step = 0.1)
      ))
  
}

HSV4G1 <- function(...) {
  div(class = 'container',id = "HSV4G1",actionButton("HSV4G1A",actionButton("HSV4G1B",actionButton("HSV4G1eq",sliderInput("HSV4S1",12.5,step = 0.1)
      ))
  
}

HSV5G1 <- function(...) {
  div(class = 'container',id = "HSV5G1",actionButton("HSV5G1A",actionButton("HSV5G1B",actionButton("HSV5G1eq",sliderInput("HSV5S1",5,step = 0.1)
      ))
  
}

HSV6G1 <- function(...) {
  div(class = 'container',id = "HSV6G1",actionButton("HSV6G1A",actionButton("HSV6G1B",actionButton("HSV6G1eq",sliderInput("HSV6S1",7.5,step = 0.1),))
  
}

HSV7G1 <- function(...) {
  div(class = 'container',id = "HSV7G1",actionButton("HSV7G1A",actionButton("HSV7G1B",actionButton("HSV7G1eq",sliderInput("HSV7S1",2.5,step = 0.1)
      ))
  
}

HSV8G1 <- function(...) {
  div(class = 'container',id = "HSV8G1",sliderInput("HSV8S1",actionButton("HSV8G1C",W)
      ))
  
}

###conclusive elicitation
concl <- function(...) {
  div(class = 'container',id = "concl",h1("Abschliessende Erhebung"),p("Bitte beantworten Sie zuletzt die folgenden Fragen."),selectInput("Geschlecht","Mein Geschlecht ist",c("maennlich","weiblich","divers")),numericInput("Alter","Mein Alter ist",value = NULL),actionButton("W4",W)
      ))
  
}

###outro
outro <- function(...) {
  div(class = 'container',id = "outro",h1("Abschluss"),textInput("Email","Email"),actionButton("Senden","Senden"),actionButton("end","Beenden")
      ))

}





render_page <- function(...,f,title = "Test") {
  page <- f(...)
  renderUI({
    fluidPage(page,title = title)
  })
}

###################################################
###server
###################################################
server <- function(input,output){
  
  #intro
  output$page <- render_page(f = intro)
  
  #declaration of consent
  observeEvent(input$W1,{
    output$page <- render_page(f = decl)
  })
  
  #explanation HSV
  observeEvent(input$W2,{
    if (input$Einwilligung == "Ich stimme zu") output$page <- render_page(f = expl1)
  })
  
  #HSV
  observeEvent(input$W3,{
    output$page <- render_page(f = HSV1G1)
  })
  
  #HSV1G1
  observeEvent(input$HSV1G1A,{
    output$page <- render_page(f = HSV5G1)
  })
  
  observeEvent(input$HSV1G1B,{
    output$page <- render_page(f = HSV2G1)
  })
  
  #HSV2G1
  observeEvent(input$HSV2G1A,{
    output$page <- render_page(f = HSV4G1)
  })
  
  observeEvent(input$HSV2G1B,{
    output$page <- render_page(f = HSV3G1)
  })
  
  #HSV5G1
  observeEvent(input$HSV5G1A,{
    output$page <- render_page(f = HSV7G1)
  })
  
  observeEvent(input$HSV5G1B,{
    output$page <- render_page(f = HSV6G1)
  })
  
  #HSV8G1
  loadSlider <- reactive({
    list(input$HSV1G1eq,input$HSV3G1B)
  })
  observeEvent(loadSlider(),{
    if(input$HSV1G1eq == 0 && input$HSV2G1eq == 0 && input$HSV3G1eq == 0 && input$HSV4G1eq == 0 && input$HSV5G1eq == 0 && input$HSV6G1eq == 0 && input$HSV7G1eq == 0 && input$HSV7G1A == 0 && input$HSV7G1B == 0 && input$HSV6G1A == 0 && input$HSV6G1B == 0 && input$HSV4G1A == 0 && input$HSV4G1B == 0 && input$HSV3G1A == 0 && input$HSV3G1B == 0){
      return()
    }
    output$page <- render_page(f = HSV8G1)
  })
  
  
  #outro
  observeEvent(input$W4,{
    output$page <- render_page(f = outro)
  })
  
  #end
  observeEvent(input$end,{
    stopApp()
  })

}



###################################################
###run
###################################################
shinyApp(ui = ui,server = server)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

action-button r r shiny slider slider survey