Question

我根据输入文件动态生成一组单选按钮，其中包含问题和可能的答案。我发现我可以用lapply做到这一点。它花了一段时间，但我认为我已经正确构造了代码来制作按钮并在选择时读取结果。

但我无法从模块中得到结果，我不知道为什么。

以下是示例代码：

ui.R：

library(shiny)

shinyUI(
  fluidRow(
    questListInput("occList1")
  )
)

server.R

library(shiny)

source("global.R")                      #Sources the modules used in the app

questionSet <<- read.csv("./Data/QuestData.csv")
occQuestSet <- questionSet[questionSet$Category == "Occurrence",]

shinyServer(function(input, output, session) {
  observe({
    occAnswer1 <- callModule(questList,"occList1",occQuestSet,"Occur1")
  })    

  output$answerseT <- renderText(answerSeto1())
})

模块在global.R

questListInput <- function(id){
  ns <- NS(id)

  uiOutput(ns("c1"))

}

questList <- function(input, output, session, q, l) {

  ###This function requires the type of question to be specified

  #  ns <- session$ns

  output$c1 <- renderUI({
    lapply(1:nrow(q),
           function(i) {

             createLabel <- function(name,j) {
               paste0(name,": ",q$Element.Question[j],sep = "")
             }

             labelQ <- createLabel(q[i,]$QID,i)


             createOptions <- function() {
               as.matrix(q[i,5:length(q)])
             }
             tagList(
               tags$hr(style="border-color: darkblue;"),
               h4((paste0(labelQ))),
               radioButtons(session$ns(paste0(l,i)), "Please Select:", choices = c(createOptions()))
             )
           }
    )
  })

  answer <- NULL

  observe({
    lapply(1:nrow(q), 
           function(i) {
             answer[[paste0(l,i)]] <- input[[paste0(l,i)]] 
             #input[[paste0(l,i)]] 
             print(answer)
           }
     )
   })
  print("Inside the Module")
 # print(input$c1)
  # return(
  #  list(
  #    answer1 = reactive({paste0(l,1)})
  #  )
  # )
}

在所有这些之后，如果我打开observe lapply中的打印功能，我可以看到通过单选按钮选择进行的三个选择。如果我更改了一个选项，则会列出三个更新。

但我无法弄清楚如何访问结果以便我可以在模块外部使用它！

这是从QuestionSet.csv

中读取的数据

类别，QID，元素，元素问题，低，中，高结果，C01，类型1，问题1，解决方案1，解决方案2，解决方案3 结果，CO 2，类型2，问题2，解决方案1，解决方案2，解决方案3 结果，C03，类型3，问题3，解决方案1，解决方案2，解决方案3 结果，C04，Type4，问题4，解决方案1，解决方案2，解决方案3 检测，D01，类型5，问题5，解决方案1，解决方案2，解决方案3 检测，D02，类型6，问题6，溶液1，溶液2，溶液3 检测，D03，类型7，问题7，溶液1，溶液2，溶液3 检测，D04，类型8，问题8，解决方案1，解决方案2，解决方案3 检测，D05，类型9，问题9，解决方案1，解决方案2，解决方案3 出现，O01，类型10，问题10，解决方案1，解决方案2，解决方案3 出现，O02，类型11，问题11，解决方案1，解决方案2，解决方案3 出现，O03，类型12，问题12，解决方案1，解决方案2，解决方案3

Answer 1

这是模块的问题。变量始终保持在模数内，并且在外部不可见。你可以使用shinyjs。还有关于callModule的问题，只需在服务器函数中调用它，它就可以正常工作。请查看下面的代码。

<强> global.r

# Send array as a whole.
> Write-Output -NoEnumerate 1, 2 | Measure-Object

Count: 1
...

# Converting the Write-Output -NoEnumerate command to an expression
# by enclosing it in in (...) forces enumeration
> (Write-Output -NoEnumerate 1, 2) | Measure-Object

Count: 2
...

<强> ui.R

library(shinyjs)

questListInput <- function(id){
  ns <- NS(id)

  uiOutput(ns("c1"))

}

questList <- function(input, output, session, q, l) {


  ###This function requires the type of question to be specified

  #  ns <- session$ns

  output$c1 <- renderUI({
    lapply(1:nrow(q),
           function(i) {

             createLabel <- function(name,j) {
               paste0(name,": ",q$Element.Question[j],sep = "")
             }

             labelQ <- createLabel(q[i,]$QID,i)


             createOptions <- function() {
               as.matrix(q[i,5:length(q)])
             }
             tagList(
               tags$hr(style="border-color: darkblue;"),
               h4((paste0(labelQ))),
               radioButtons(session$ns(paste0(l,i)), "Please Select:", choices = c(createOptions()))
             )
           }
    )
  })

  answer <- NULL

  observe({
    lapply(1:nrow(q), 
           function(i) {
             answer[[paste0(l,i)]] <- input[[paste0(l,i)]]
             runjs(paste0("Shiny.onInputChange(",session$ns(paste0(l,i)),",",input[[paste0(l,i)]],");"))
             #input[[paste0(l,i)]] 
             # print(answer)
           }
    )
  )
  })
  print("Inside the Module")
  # print(input$c1)
  # return(
  #  list(
  #    answer1 = reactive({paste0(l,1)})
  #  )
  # )
}

<强> server.R

library(shiny)
library(fullcalendar)

ui <- shinyUI(
  fluidRow(
    shinyjs::useShinyjs(),
    questListInput("occList1")
  )
)

Answer 2

我无法弄清楚如何使这个动态化，以便我可以访问n个radiobuttons，并获取每个的值。我试图使用它来访问它，但即使它复制了上面print语句中的输入$ occList1-Occur11，它也不会访问该值。

observeEvent({input$`occList1-Occur11`},
{
aa <- noquote(paste0("`occList1-Occur1",1,"`"))
bb <- (eval(noquote(paste0("input$",aa))))
print(get(bb))
})

aa返回occList1-Occur12 bb返回输入$ occList1-Occur12 但是print语句出错了。

Answer 3

您的模块需要返回：

一个返回答案列表的反应式表达式
一个反应式表达列表，每个答案一个

如果您只是立即对所有答案进行操作，那么前者更容易使用。后者的优势在于您可以让下游反应式表达式和观察者对特定问题作出反应（即，不会通过更改他们不关心的问题的答案来触发下游反应，只有他们实际阅读的答案）。 / p>

1的例子：

questList <- function(input, output, session, q, l) {
  ...

  # Return a reactive expression that yields a list of all answers
  return(reactive({
    lapply(1:nrow(q), function(i) input[[paste0(l, i)]])
  }))
}

你会像这样使用它（来自server.R）：

function(input, output, session) {
  answers <- callModule(questList, "occList1", occQuestSet, "Occur1")

  output$answerSet <- renderPrint({
    lapply(answers(), print)
  })
}

2的例子：

questList <- function(input, output, session, q, l) {
  ...

  # Return a list of reactive expressions that yield a scalar
  return(lapply(1:nrow(q), function(i) {
    reactive(input[[paste0(l, i)]])
  }))
}

你会像这样使用它（来自server.R）：

function(input, output, session) {
  answers <- callModule(questList, "occList1", occQuestSet, "Occur1")

  output$answerSet <- renderPrint({
    lapply(answers, function(answer) {
      print(answer())
    })
  })
}

在Shiny中恢复radioButton选择 - 使用模块和lapply

3 个答案: