如何通过反应性在闪亮中添加递归模块

Question

我是新来的闪亮和 我正在尝试创建一个应用程序，其中 在用户第一次选择之后，一个函数 对预定义的数据集进行一些操作，并且必须打开 新的选择器 UI。 在那个新的选择器 UI 中，用户再次选择了一个新值， 另一个函数对新数据集进行一些操作，依此类推 3~4次以上。

编辑：

加上每次用户选择该值时，它将打开下一个selectUI 当他进行选择时，下一个 ui 将弹出。 我使用了来自闪亮网站的一些示例，但每次都会得到不同的错误：

1)

     Listening on http://127.0.0.1:7178
            Warning: Error in if: argument is not interpretable as logical
              52: server [#12]
            Error in if (reactive(input$Strength_1)) { : 
              argument is not interpretable as logical

2)

    Listening on http://127.0.0.1:7178
    Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
      61: stop
      60: .getReactiveEnvironment()$currentContext
      59: getCurrentContext
      55: .subset2(x, "impl")$get
      54: $.reactivevalues
      52: server [#12]
    Error in .getReactiveEnvironment()$currentContext() : 
      Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

3)

 Listening on http://127.0.0.1:7178
 Warning: Error in force: argument "ui" is missing, with no default [No stack trace available]
 Warning: Error in : evaluation nested too deeply: infinite recursion / options(expressions=)? 93: <Anonymous>

数据集：

Attr_scores %>% head %>% dput
structure(list(scope = c("Sel1", "Sel2", "Sel3", "Sel4", "Sel5", 
"Sel6"), A1 = c(14, 14, 14, 15, 15, 15), A2 = c(13, 14, 14, 14, 
15, 15), A3 = c(13, 13, 14, 13, 12, 15), A4 = c(13, 13, 13, 12, 
12, 11), A5 = c(13, 13, 10, 12, 11, 8), A6 = c(12, 10, 8, 11, 
11, 8)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))

功能：

Attr_score_select <- function(x){
    Attr_scores %>%
        filter(scope == x) %>%
        pivot_longer(-scope) %>% 
        select(value) %>% 
        group_by(value) %>% 
        summarise(n=n())
}
Attr_score_remove <- function(df, score){
    df %>% 
        mutate(n = ifelse(value == score, n-1, n)) %>% 
        mutate(n = ifelse(n == 0, NA, n)) %>% 
        drop_na()     
}

用户界面：

## ui
ui <- fluidPage(
  titlePanel("Dynamically generated user interface components"),
  selectInput(inputId = 'scores',
              label = "Choose scores", 
              choices = c(Choose='', Attr_scores$scope ),
              selectize=TRUE),
  uiOutput("Strength_ui")
)

服务器：

server <- function(input, output) {
  Scores <- reactive(Attr_score_select(input$scores))

  output$Strength_ui <- renderUI({
    #Strength
           selectInput('Strength_1', 
                       label = "Choose Strength score for your character:", 
                       c(Choose='', as.character(Scores()$value))
           )
  })
 # from here on it creates the errors ------------

 if (input$Strength_1){
    observeEvent(input$Strength_1,{
               Scores <- reactive( Scores() %>% 
                                     Attr_score_remove(input$Strength_1))
               insertUI(
                  #Dexterity
                  selectInput('Dexterity_1',
                   label = "Choose Dexterity score for your character:",
                   c(Choose='',as.character(Scores()$value))
                  )  

               ) 
              })

    }
 # if you remove it then it runs ---------------
  }
shinyApp(ui = ui, server = server)

Answer 1

我无法完全理解您的工作主题，但我会使用反应式表达式和 renderUI 来构建这样的应用程序。

我的解决方案来了：

library(shiny)
library(tidyverse)

Attr_scores <- structure(list(scope = c(
  "Sel1", "Sel2", "Sel3", "Sel4", "Sel5",
  "Sel6"
), A1 = c(14, 14, 14, 15, 15, 15), A2 = c(
  13, 14, 14, 14,
  15, 15
), A3 = c(13, 13, 14, 13, 12, 15), A4 = c(
  13, 13, 13, 12,
  12, 11
), A5 = c(13, 13, 10, 12, 11, 8), A6 = c(
  12, 10, 8, 11,
  11, 8
)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))

Attr_score_select <- function(x){
  Attr_scores %>%
    filter(scope == x) %>%
    pivot_longer(-scope) %>% 
    select(value) %>% 
    group_by(value) %>% 
    summarise(n=n())
}
Attr_score_remove <- function(df, score){
  df %>% 
    mutate(n = ifelse(value == score, n-1, n)) %>% 
    mutate(n = ifelse(n == 0, NA, n)) %>% 
    drop_na()     
}


ui <- fluidPage(
  titlePanel("Dynamically generated user interface components"),
  selectInput(
    inputId = "scores",
    label = "Choose scores",
    choices = c(Choose = "", Attr_scores$scope),
    selectize = TRUE
  ),
  uiOutput("Strength_ui"),
  uiOutput("Dexterity_1")
)


server <- function(input, output) {
  Scores <- reactive(Attr_score_select(input$scores))
  output$Strength_ui <- renderUI({
    #Strength
    selectInput('Strength_1', 
                label = "Choose Strength score for your character:", 
                Scores()$value)
  })
  Scores1 <- reactive(Scores() %>% Attr_score_remove(input$Strength_1) %>% select(value))
  output$Dexterity_1 = renderUI(
        selectInput('Dexterity_1', label = "Choose Dexterity score for your character:",Scores1())
        )  

}

shinyApp(ui = ui, server = server)

问候 帕维尔