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

Question

我是 shiny 的新手我正在尝试创建一个应用程序，其中在用户第一次选择之后，一个函数会执行对预定义数据集进行一些操作并且必须打开一个新的选择器 UI。在那个新选择器 UI 中，用户再次选择一个新值，另一个函数对新数据集进行一些操作等等 3~4次。

edit:

Plus each time the user selects the value it will open the next selectUI and when he does the selection the next ui will pop. I used some examples from the shiny website but I get each time a different error:

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>

The dataset:

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"
))

The functions:

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()     
}

The ui:


## 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")
)

The server:

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)

问候帕维尔

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

How to add recursively modules in shiny through reactivity

r

shiny

shiny-reactivity