R闪亮调查中的相关调查问题：矩阵问题

Question

我目前正在尝试使用shinysurveys 包在R 中创建一项调查。我的目标是创建相关矩阵问题（例如李克特量表）。只要我不使用矩阵问题，一切都很好。但是，通过使用下面的代码，R 返回错误消息，并且第二个相关问题不会出现。

为了澄清，我希望第二个问题出现，前提是第一个问题回答为“1”。

如果有人能帮助我那就太好了:)

df_1 <- data.frame(question = rep("A", 7),
                   option = rep(c("1", "2", "3", "4", "5", "6", "I don't know"), 1),
                   input_type = rep("matrix", 7),
                   input_id = rep("ID1", 7),
                   dependence = NA,
                   dependence_value = NA,
                   required = TRUE
)


df_2 <- data.frame(question = c(rep("B", 7)),
                   option = rep(c("1", "2", "3", "4", "5", "6", "I don't know"), 1),
                   input_type = rep("matrix", 7),
                   input_id = rep("ID2", 7),
                   dependence = rep("ID1", 7),
                   dependence_value = rep("1", 7),
                   required = TRUE
)

df_merged <- rbind(df_1, df_2)

#create user interface
ui <- fluidPage(
  surveyOutput(df = df_merged,
               survey_title = "Title",
               survey_description = "Description"))


#specify server function
server <- function(input, output, session) {
  renderSurvey()

  observeEvent(input$submit, {
    showModal(modalDialog(
      title = "Survey End!"
    ))
  })
}


shinyApp(ui, server)

Answer 1

您可以尝试注册一个“extendInpuTtype”。这将有助于实现您的目标。但是，使用闪亮的小部件扩展输入存在一些限制，例如在用户界面中显示选项时。请参阅下面的代码示例。您可以尝试各种闪亮的输入，看看什么会美观且符合您的用户界面需求。

library(shiny)
library(shinysurveys)

df_1 <- data.frame(question = "what is your favorite food",
                   option = NA,
                   input_type = "slider",
                   input_id = rep("ID1", 7),
                   dependence = NA,
                   dependence_value = NA,
                   required = TRUE
)


df_2 <- data.frame(question = "Why is this your favorite food?",
                   option = NA,
                   input_type = "textSlider",
                   input_id = rep("ID2", 7),
                   dependence = rep("ID1", 7),
                   dependence_value = rep("1", 7),
                   required = TRUE
)

  extendInputType(input_type = "slider", {
  shiny::sliderInput(
    inputId = surveyID(),
    label = surveyLabel(),
    min = 0,
    max = 5,
    value = 0
  ) 
})


  extendInputType("textSlider", {
    shinyWidgets::sliderTextInput(
      inputId = surveyID(),
      label = surveyLabel(),
      force_edges = TRUE,
      choices = c("I Love it",  "It's all I can afford")
    )
  })

df_merged <- rbind(df_1, df_2)

#create user interface
ui <- fluidPage(
  surveyOutput(df = df_merged,
               survey_title = "Dependant Qustionaire",
               survey_description = "This is a two part survey that only shows the next question when the correct answer is provided to the first"))



#specify server function
server <- function(input, output, session) {
  renderSurvey()
  
  observeEvent(input$submit, {
    showModal(modalDialog(
      title = "Survey End!"
    ))
  })
}


shinyApp(ui, server)