Как добавить рекурсивные модули в блестящую реактивность - PullRequest
Новая
       13

Как добавить рекурсивные модули в блестящую реактивность

0 голосов
/ 23 января 2020

Я новичок в Блестящем, и я пытаюсь создать приложение, в котором после первого выбора от пользователя функция выполняет некоторые манипуляции с предопределенным набором данных и должна открыть новый пользовательский интерфейс селектора. В этом новом пользовательском интерфейсе селектора пользователь снова выбирает новое значение, другая функция выполняет некоторые манипуляции с новым набором данных и т. Д. Еще 3–4 раза.

edit:

Plus каждый раз, когда пользователь выбирает значение, он открывает следующее selectUI, и когда он делает выбор, появляется следующий пользовательский интерфейс. Я использовал несколько примеров с блестящего сайта, но каждый раз получаю разные ошибки:

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)

1 Ответ

1 голос
/ 23 января 2020

Я не могу полностью понять топи c, над которыми вы работаете, но я бы использовал реактивные выражения и 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)

С уважением, Павел

...