闪亮：sliderinput，可观察多个事件并更改默认值

免责声明：我刚开始学习R为我的论文设计一个实验，所以很抱歉提前问了一些可能是超基本的问题

我正在制作一份由多页组成的交互式问卷（德语）

我想加载页面

HSV8G1

如果任何操作按钮

input$HSV1G1eq，input$HSV2G1eq，input$HSV3G1eq，input$HSV5G1eq，input$HSV6G1eq，input$HSV7G1eq，input$HSV7G1A，input$HSV7G1B，input$HSV6G1A，input$HSV4G1B，input$HSV3G1A，已切换输入$HSV3G1B

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

HSV8S1

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

请在下面找到我提出的代码-我知道这可能是一个愚蠢和不切实际的方法来构建它，但我还是刚刚开始：-）

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

####说明
您已经共享了300行代码。不太可能有人会通过它们来提供解决方案。你能把代码减少到只包含相关部分，并使这篇文章具有可复制性吗？
###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",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einwilligung zur Teilnahme"),
          p("Platzhalter"),
          br(),
  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",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einleitung Teil 1"),
          p("Platzhalter"),
          br(),
          actionButton("W3", W)
      ))
  
}

###HSV

#G1

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

HSV2G1 <- function(...) {
  div(class = 'container', id = "HSV2G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV2G1A", A),
          actionButton("HSV2G1B", B),
          actionButton("HSV2G1eq", C),
          sliderInput("HSV2S1", D, 0, ty, 15, step = 0.1)
      ))
  
}

HSV3G1 <- function(...) {
  div(class = 'container', id = "HSV3G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV3G1A", A),
          actionButton("HSV3G1B", B),
          actionButton("HSV3G1eq", C),
          sliderInput("HSV3S1", D, 0, ty, 17.5, step = 0.1)
      ))
  
}

HSV4G1 <- function(...) {
  div(class = 'container', id = "HSV4G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV4G1A", A),
          actionButton("HSV4G1B", B),
          actionButton("HSV4G1eq", C),
          sliderInput("HSV4S1", D, 0, ty, 12.5, step = 0.1)
      ))
  
}

HSV5G1 <- function(...) {
  div(class = 'container', id = "HSV5G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV5G1A", A),
          actionButton("HSV5G1B", B),
          actionButton("HSV5G1eq", C),
          sliderInput("HSV5S1", D, 0, ty, 5, step = 0.1)
      ))
  
}

HSV6G1 <- function(...) {
  div(class = 'container', id = "HSV6G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV6G1A", A),
          actionButton("HSV6G1B", B),
          actionButton("HSV6G1eq", C),
          sliderInput("HSV6S1", D, 0, ty, 7.5, step = 0.1),
      ))
  
}

HSV7G1 <- function(...) {
  div(class = 'container', id = "HSV7G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          actionButton("HSV7G1A", A),
          actionButton("HSV7G1B", B),
          actionButton("HSV7G1eq", C),
          sliderInput("HSV7S1", D, 0, ty, 2.5, step = 0.1)
      ))
  
}

HSV8G1 <- function(...) {
  div(class = 'container', id = "HSV8G1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1(E),
          p(G1),
          br(),
          sliderInput("HSV8S1", D, 0, ty, 2.5, step = 0.1),
          actionButton("HSV8G1C", W)
      ))
  
}

###conclusive elicitation
concl <- function(...) {
  div(class = 'container', id = "concl",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschliessende Erhebung"),
          p("Bitte beantworten Sie zuletzt die folgenden Fragen."),
          br(),
          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",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschluss"),
          p("Platzhalter"),
          br(),
          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$HSV2G1eq, input$HSV3G1eq, input$HSV4G1eq, input$HSV5G1eq, input$HSV6G1eq, input$HSV7G1eq, input$HSV7G1eq, input$HSV7G1A, input$HSV7G1B, input$HSV6G1A, input$HSV6G1B, input$HSV4G1A, input$HSV4G1B, input$HSV3G1A, 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)