Question

我一直在互联网上寻找问题的答案，而我一直在这里查看：

这些都没有帮助。

设置：

我有一个不同行业的数据集以及这些行业的财务比率。比率的选择取决于行业的选择。此外，变量的选择取决于行业中公司的规模。例如，我可能只想看一下Industry1中资产少于50亿美元的公司，以及该行业中该规模公司的相关比率。因此，动态UI来自选择和行业，然后根据行业选择我要调查的大小等级。并非所有行业都按大小进行相同的细分，有些行业具有2个规模排名，另一些行业可以具有4或5个级别。最后，比率用于衡量公司财务状况的各个方面，例如债务，收入，效率等，因此，我应该用四列每个具有一组比率的维度，每个比率旁边都有一个复选框。

问题：

我必须按行业过滤我的data.frame的函数返回一列大小等级，以从renderUI中选择。但是，在以下三个步骤之间的某个地方，输出将变为NULL。因此，我无法按行业和规模过滤要选择的比率，而闪亮的页面会返回带有标题和下拉菜单的页面，但没有可供选择的变量。

第1步。

<div class="first box">
</div>
<div class="second box">
</div>
<div class="last box">
</div>

第2步。

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

第3步。

uiOutput("secondSelection")

打印功能返回以下内容：

听http://127.0.0.1:5301

[

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)

下面是带有伪数据集的代码，这与我使用此专有数据所遇到的问题非常接近。我正在运行RStudio 0.98.1103和R版本3.4.1。预先感谢您的帮助。

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

Answer 1

构建查找表或查找列表，并在启动服务器之前将其用于您的行业，规模和尺寸查找。我将行业规模查询放在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)
      }
    })


  }
))

希望这会有所帮助。它仍然可以进一步简化和简化。

R闪亮的动态UI-uiOutput返回NULL吗？

1 个答案: