无法获取 shinyApp 中变量中存在的值的计数

Question

我正在基于 mtcars 数据构建一个 shinyApp。我在计算 disp 变量 的值时遇到问题。当all在carb button中选择时，然后disp显示0 count。如果在 carb 中选择 all 以外的值，则 disp 将给出其值的准确计数。有人可以看看我的代码吗？将不胜感激。

library(shiny)   
library(DT)     
library(dplyr) 
library(shinythemes) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)


data_table<-mtcars    

#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (

      uiOutput("vs_selector"),
      uiOutput("carb_selector"),
      uiOutput("disp_selector"),
      uiOutput("cyl_selector"),
      valueBoxOutput("count_disp"),
      valueBoxOutput("count_cyl")),


    mainPanel(

      DT::dataTableOutput('mytable') 

    )

  ))




#server
server = function(input, output, session) {

  output$vs_selector <- renderUI({

    selectInput(inputId = "vs",
                label = "vs:", multiple = TRUE,
                choices = c( unique(data_table$vs)),
                selected = c(0,1))

  })

  output$carb_selector <- renderUI({

    req(input$vs)

    available0 <- data_table[c(data_table$vs %in% input$vs ), "carb"]  

    selectInput(
      inputId = "carb", 
      label = "carb:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available0))),
      selected = 'All')

  })


  output$disp_selector <- renderUI({
    req(input$vs, input$carb)

    available <- data_table[["disp"]][data_table$vs %in% input$vs]
    if(! "All" %in% input$carb){
      available <- available[data_table$carb %in% input$carb]
    }

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = c(160,108, 258, 360))

  })



  output$cyl_selector <- renderUI({
    req(input$vs, input$carb, input$disp)

    available <- data_table[["cyl"]][data_table$vs %in% input$vs]
    if(! "All" %in% input$disp){
      available <- available[data_table$carb %in% input$carb    &    
data_table$disp %in% input$disp]
    }

    selectInput(
      inputId = "cyl", 
      label = "cyl:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All')

  })





  output$count_disp <- renderValueBox({
    if("All" %in% input$carb) {
      available <- unique(data_table[['disp']][data_table$vs %in% input$vs] 
)
    } else{
      available <- unique(data_table[['disp']][data_table$carb %in% 
input$carb   &    
                                          data_table$vs %in% input$vs ]   )                                                        
    }

    valueBox(
      value = length(available) ,


      subtitle = sprintf("Number of disp values" ))   

  })




  output$count_cyl <- renderValueBox({
    if("All" %in% input$disp) {
      available <- unique(data_table[['cyl']][data_table$vs %in% input$vs] )
    } else{
      available <- unique(data_table[['cyl']][data_table$carb %in% 
input$carb   &    
                                                 data_table$vs %in% input$vs  
&    
                                                data_table$disp %in% 
input$disp ]   )                                                        
    }

    valueBox(
      value = length(available) ,


      subtitle = sprintf("Number of cyl values" ))   

  })







  thedata <- reactive({

    req(input$disp, input$vs, input$carb, input$cyl)

    data_table<-data_table[data_table$vs %in% input$vs,]

    if(! "All" %in% input$carb){
      data_table<-data_table[data_table$carb %in% input$carb,]
    }

    if(! "All" %in% input$disp){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }


    if(! "All" %in% input$cyl){
      data_table<-data_table[data_table$cyl %in% input$cyl,]
    }


    data_table

  })


  output$mytable = DT::renderDataTable({

    DT::datatable( {     

      thedata()   # Call reactive thedata()

    })

  })

}  

shinyApp(ui = ui, server = server)

Answer 1

在 renderValueBox 中您正在尝试子集 data_table[['disp']][data_table$carb %in% input$carb & data_table$vs %in% input$vs] 但是 input$carb == "All"，所以您的子集 return 是一个长度为 0 的数字。

根据您的第一条评论进行编辑。我添加了一个函数，该函数 return 是向量的唯一值（"cyl"、"carb" 等）。我们可以使用此函数 A 填充 selectInput 和 B 以 return 基于所选内容的唯一值的长度。

library(shiny)   
library(DT)     
library(dplyr) 
library(shinythemes) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)

#Input data
data_table<-mtcars

#Function returning all choices for given selector
ReturnChoices <- function(data, xSelector){
  choices <- unique(data[[xSelector]])
  return(choices)
}

#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (

      uiOutput("vs_selector"),
      uiOutput("carb_selector"),
      uiOutput("disp_selector"),
      uiOutput("cyl_selector"),
      valueBoxOutput("count_disp"),
      valueBoxOutput("count_cyl")),


    mainPanel(

      DT::dataTableOutput('mytable') 

    )

  ))




#server
server = function(input, output, session) {


  output$vs_selector <- renderUI({

    selectInput(inputId = "vs",
                label = "vs:", multiple = TRUE,
                choices = c( ReturnChoices(data_table, "vs")),
                selected = c(0,1))

  })

  output$carb_selector <- renderUI({

    selectInput(
      inputId = "carb", 
      label = "carb:",
      multiple = TRUE,
      choices = c('All',as.character( ReturnChoices(data_table, "carb"))),
      selected = 'All')

  })

  output$disp_selector <- renderUI({

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character( ReturnChoices(data_table, "disp"))),
      selected = c(160,108, 258, 360))

  })

  output$cyl_selector <- renderUI({

    selectInput(
      inputId = "cyl", 
      label = "cyl:",
      multiple = TRUE,
      choices = c('All',as.character( ReturnChoices(data_table, "cyl"))),
      selected = 'All')

  })

  output$count_disp <- renderValueBox({

    valueBox(
      value = length( ReturnChoices(thedata(), "disp")) ,


      subtitle = sprintf("Number of disp values" ))   

  })


  output$count_cyl <- renderValueBox({

    valueBox(
      value = length( ReturnChoices(thedata(), "cyl")) ,


      subtitle = sprintf("Number of cyl values" ))   

  })

  thedata <- reactive({

    req(input$disp, input$vs, input$carb, input$cyl)

    if(! "All" %in% input$carb){
      data_table<-data_table[data_table$carb %in% input$carb,]
    }

    if(! "All" %in% input$disp){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }

    if(! "All" %in% input$cyl){
      data_table<-data_table[data_table$cyl %in% input$cyl,]
    }

    data_table<-data_table[data_table$vs %in% input$vs,]

    data_table

  })


  output$mytable = DT::renderDataTable({

    DT::datatable( {     

      thedata()   # Call reactive thedata()

    })

  })

}  

shinyApp(ui = ui, server = server)

让我知道它是否能为您解决问题

无法获取 shinyApp 中变量中存在的值的计数

Unable to get the count of values present in a variable in shinyApp

r

input

radio-button

shiny

dt