R Shiny Dynamic UI - uiOutput возвращает значение NULL? - PullRequest
0 голосов
/ 21 марта 2019

Я искал в интернете ответ на мою проблему, и я посмотрел здесь:

https://shiny.rstudio.com/articles/dynamic-ui.html

https://shiny.rstudio.com/articles/req.html

Ошибка в filter_impl (.data, quo): результат должен иметь длину 259, а не 399

Shiny renderUI selectInput вернул NULL

Динамический пользовательский интерфейс в блестящем: невозможно распечатать результаты из uiOutput, созданного с помощью renderUI

Как получить значение в uioutput в ui.R и отправить его обратно на server.R?

https://community.rstudio.com/t/dynamic-ui-cant-print-results-from-uioutput-created-with-renderui/6937

Ничто из этого не помогло.

Настройка:

У меня есть набор данных различных отраслей и финансовых коэффициентов для этих отраслей. Выбор коэффициентов зависит от выбора отрасли. Кроме того, выбор переменных зависит от размера компаний в отраслях. Например, я могу захотеть взглянуть только на компании в Industry1 с активами менее 5 миллиардов долларов и соответствующими коэффициентами для компаний такого размера в этой отрасли. Следовательно, динамический пользовательский интерфейс зависит от выбора и отрасли, а затем от выбора размера ранга, который я хочу исследовать, исходя из отрасли. Не все отрасли будут сегментированы по размеру одинаково, некоторые имеют 2 ранжирования по размеру, другие могут иметь 4 или 5. Наконец, коэффициенты измеряют различные измерения финансовых показателей компании, такие как задолженность, доход, эффективность и т. Д., Поэтому я должен выделить четыре столбца. для каждого измерения с набором отношений, рядом с которым стоит флажок.

Проблема:

Функция, которую я должен отфильтровать в data.frame по отрасли, возвращает столбец рангов размера для выбора из renderUI. Однако где-то между следующими тремя шагами этот вывод превращается в NULL. Поэтому я не могу отфильтровать соотношения, которые я хочу выбрать, по отрасли и размеру, и блестящая страница возвращает страницу с заголовками и выпадающими меню, но без переменных.

Шаг 1.

    output$secondSelection = renderUI({
    size_filter_choice = dummyData %>% filter(Industry == input$industry) %>% distinct(Size)
    print("Step 1.")
    print(size_filter_choice)
    selectInput(inputId = "size",label="Sizes",choices = as.list(size_filter_choice[,"Size"]),selectize=FALSE) 
  })

Шаг 2.

uiOutput("secondSelection")

Шаг 3.

main_ratio_set <- reactive({

    print("Step 3")
    print(input$size)
    print(input$industry)
    req(input$size)

    user_filter <- dummyData %>% filter(Industry == input$industry & Size == input$size)

    return(user_filter)

  })

  outputOptions(output,"secondSelection",suspendWhenHidden = FALSE)

Функции печати возвращают следующее:

Прослушивание http://127.0.0.1:5301

[

1] "Step 1."
   Size
1 Size1
2 Size2
[1] "Step 3"
NULL
[1] "Industry1"

Ниже приведен код с фиктивным набором данных, который максимально приближен к проблеме, с которой я сталкиваюсь с этими частными данными. Я использую версию RStudio 0.98.1103 с версией R 3.4.1. Заранее благодарю за помощь.

library(plyr)
library(dplyr)
library(shiny)
library(shinydashboard)

dummyData <- data.frame(matrix(nrow=0,ncol=4,dimnames=list(c(),c("Ratio","Dimensions","Industry","Size"))))

industry_n <- 5
dims <- 4

for(i in 1:industry_n){
  s = sample(1:5,1)
  for(sz in 1:s){
    for(d in 1:dims){
      ratios <- sample(1:10,1)
      df <- data.frame(Ratio = paste0("Ratio",ratios))
      df <- df %>% mutate(Dimensions = paste0("Dimension",d),
                       Industry = paste0("Industry",i),
                       Size = paste0("Size",sz))
      dummyData <- rbind(dummyData,df)
    }
  }
}


ind_n <- paste0("Industry",1:industry_n)

runApp(list(
  ui = fluidPage(
    fluidRow(
      column(5,
             selectInput("industry",label="Industry",choices = ind_n,selected="Industry1"),
             uiOutput("secondSelection")
      ),
      fluidRow(
        column(width = wd,
               list(h3("Dimension 1"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim1")))),
        column(width = wd,
               list(h3("Dimension 2"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim2")))),
        column(width = wd,
               list(h3("Dimension 3"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim3")))),
        column(width = wd,
               list(h3("Dimension 4"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim4"))))
      )
      )),

server = function(input, output,session) {

  output$secondSelection = renderUI({
    size_filter_choice = dummyData %>% filter(Industry == input$industry) %>% distinct(Size)
    print("Step 1.")
    print(size_filter_choice)
    selectInput(inputId = "size",label="Sizes",choices = as.list(size_filter_choice[,"Size"]),selectize=FALSE) 
  })

  main_ratio_set <- reactive({

    print("Step 3")
    print(input$size)
    print(input$industry)
    req(input$size)

    user_filter <- dummyData %>% filter(Industry == input$industry & Size == input$size)

    return(user_filter)

  })

  outputOptions(output,"secondSelection",suspendWhenHidden = FALSE)

ratio_filter_dim1 = reactive({

  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension1") %>% distinct(Ratio)
  ratio_select <- as.list(as.character(ratio_select[,"Ratio"]))
  return(ratio_select)
})


output$dim1 = renderUI({
  checkboxGroupInput(inputId = "dim1",label=NULL,choices = ratio_filter_dim1(),inline=F)
})

ratio_filter_dim2 = reactive({
    ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension2") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})


output$dim2 = renderUI({
  checkboxGroupInput(inputId = "dim2",label=NULL,choices = ratio_filter_dim2(),inline=F)
})

ratio_filter_dim3 = reactive({
  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension3") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})


output$dim3 = renderUI({
  checkboxGroupInput(inputId = "dim3",label=NULL,choices = ratio_filter_dim3(),inline=F)
})

ratio_filter_dim4 = reactive({

  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension4") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})

output$dim4 = renderUI({
  checkboxGroupInput(inputId = "dim4",label=NULL,choices = ratio_filter_dim4(),inline=F)
})
}
))

1 Ответ

0 голосов
/ 21 марта 2019

Создайте справочную таблицу или справочный список и используйте его для поиска в отрасли, размере и размерах перед запуском сервера.Я поместил поиск отраслевого размера вне файла server.R, потому что он не должен быть реактивным, а ratio_filter_dim_x внутри файла server.R, потому что он должен быть реактивным.

Кроме того, какВ порядке этикета, пожалуйста, постарайтесь убедиться, что ваш пример выдает только наименьшее количество ошибок при публикации в Интернете и содержит наименьшее количество возможных строк кода, воспроизводящих проблему.

Вот мое исправление:

library(plyr)
library(dplyr)
library(shiny)
library(shinydashboard)

dummyData <- data.frame(matrix(nrow=0,ncol=4,dimnames=list(c(),c("Ratio","Dimensions","Industry","Size"))))

industry_n <- 5
dims <- 4

for(i in 1:industry_n){
  s = sample(1:5,1)
  for(sz in 1:s){
    for(d in 1:dims){
      ratios <- sample(1:10,1)
      df <- data.frame(Ratio = paste0("Ratio",ratios))
      df <- df %>% mutate(Dimensions = paste0("Dimension",d),
                          Industry = paste0("Industry",i),
                          Size = paste0("Size",sz))
      dummyData <- rbind(dummyData,df)
    }
  }
}

colnames(dummyData)[which(colnames(dummyData)=="Dimensions")]<- "Risk.Dimension"

ind_n <- paste0("Industry",1:industry_n)
wd=6

# Generating a non-reactive lookup list, could also be a dataframe if so desired

industry_size_lookup_list<- lapply(unique(dummyData$Industry), function(x){unique(dummyData[which(dummyData$Industry == x), "Size"])})
names(industry_size_lookup_list)<- unique(dummyData$Industry)

runApp(list(
  ui = fluidPage(
    fluidRow(
      column(5,
             selectInput("industry",label="Industry",choices = names(industry_size_lookup_list),selected=names(industry_size_lookup_list)[1]),
             uiOutput("secondSelection")
      ),
      fluidRow(
        column(width = wd,
               list(h3("Dimension 1"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim1")))),
        column(width = wd,
               list(h3("Dimension 2"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim2")))),
        column(width = wd,
               list(h3("Dimension 3"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim3")))),
        column(width = wd,
               list(h3("Dimension 4"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim4"))))
      )
    )),

  server = function(input, output,session) {

    output$secondSelection<- shiny::renderUI({
      if(!is.null(input$industry)){
        the_valid_choices<- industry_size_lookup_list[[which(names(industry_size_lookup_list)==input$industry)]]
      }
      if(is.null(input$industry)){
        the_valid_choices<- "Please Select An Industry"
      }
      selectInput(inputId = "size",label="Sizes",choices = the_valid_choices,selectize=FALSE, multiple = FALSE)
    })

    main_ratio_set<- shiny::reactive({
      if(!is.null(input$industry)){
        if(!is.null(input$size)){
          tmp<- dummyData[which(dummyData$Industry ==  input$industry & dummyData$Size == input$size),]
        }
      }
    })
    # The reactive lookup list
    ratio_filter_dim_x<- shiny::reactive({
      if(!is.null(main_ratio_set())){
        tmp<- lapply(unique(main_ratio_set()$Risk.Dimension), function(x){as.character(unique(main_ratio_set()[which(main_ratio_set()$Risk.Dimension == x), "Ratio"]))})
        names(tmp)<- unique(main_ratio_set()$Risk.Dimension)
        tmp
      }
    })

    observe({
      if(!is.null(ratio_filter_dim_x())){
        cat("STR of ratio_filter_dim_x", str(ratio_filter_dim_x()), "\n")
        cat("names of ratio_filter_dim_x", names(ratio_filter_dim_x()), "\n")
        }
      })

    # Use modules for the below. See link:
    # https://www.cultureofinsight.com/blog/2018/01/05/2017-11-13-reproducible-shiny-app-development-with-modules/

    output$dim1 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim1",label=NULL,choices = ratio_filter_dim_x()[["Dimension1"]],inline=F)
      }
    })
    output$dim2 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim2",label=NULL,choices = ratio_filter_dim_x()[["Dimension2"]],inline=F)
      }
    })
    output$dim3 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim3",label=NULL,choices = ratio_filter_dim_x()[["Dimension3"]],inline=F)
      }
    })
    output$dim4 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim4",label=NULL,choices = ratio_filter_dim_x()[["Dimension4"]],inline=F)
      }
    })


  }
))

Надеюсь, это поможет.Это может все еще быть далее упрощено и оптимизировано.

...