Search code examples
rshinyinfobox

Changing the values of infoBox from selectInput

I have a dashboard with select Input for species and info Boxes to display total species by state. Running the code below will display for one of the boxes. How can the other values be displayed? The output for the boxes should be as shown below e.g for info box Arizona AZ elk 5 etc. There are 3 info boxes for the states and select input has three options. The screen shot of the output is also attachedenter image description here

suppressPackageStartupMessages(library(tidyverse))
library(sf)
library(shiny)
library(shinydashboard)

ungulates = c("elk", "mule deer", "pronghorn")
regions = c("AZ", "NV", "WY")

ung_shape1 <- tibble("species" = rep(ungulates[1], 5), "state" = rep(regions[1], 5))

ung_shape2 <- tibble("species" = rep(ungulates[1], 3), "state" = rep(regions[2], 3))

ung_shape3 <- tibble("species" = rep(ungulates[1], 4), "state" = rep(regions[3], 4))

ung_shape4 <- tibble("species" = rep(ungulates[2], 6), "state" = rep(regions[1], 6))

ung_shape5 <- tibble("species" = rep(ungulates[2], 7), "state" = rep(regions[2], 7))

ung_shape6 <- tibble("species" = rep(ungulates[2], 4), "state" = rep(regions[3], 4))

ung_shape7 <- tibble("species" = rep(ungulates[3], 4), "state" = rep(regions[1], 4))

ung_shape8 <- tibble("species" = rep(ungulates[3], 2), "state" = rep(regions[2], 2))

all_ung <- bind_rows(ung_shape1, ung_shape2, ung_shape3, ung_shape4, ung_shape5, ung_shape6, ung_shape7, ung_shape8)

geomt <- tibble(x = runif(n=35), y = runif(n = 35))
ung_sff <- bind_cols(all_ung, geomt)
ung_sf <- ung_sff %>% st_as_sf(coords = c("x", "y"))



ui <- dashboardPage(skin = "red", 
                    dashboardHeader(title = "Ungulates"), 
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      fluidRow(
                        box(width = 10, title = "Select input", #background = "fuchsia",
                            status = "primary", solidHeader = TRUE,
                            br(),
                            
                            selectInput("ungul", "Choose a species",
                                        choices = unique(ung_sf$species)))
                        
                        
                      ),
                      br(),
                      br(),
                      br(),
                      
                      
                      fluidRow(
                        
                        infoBoxOutput("azCount"),
                        infoBoxOutput("nvCount"),
                        infoBoxOutput("wyCount")
                      )
                      
                    )
)








server <- function(input, output, session){
  
  
  output$azCount <- renderInfoBox({
    
    species_state <- ung_sf %>% select(species, state)
    species_state <- st_drop_geometry(species_state)
    infoaz <- filter(species_state, species %in% input$ungul)
    countaz <- infoaz %>% group_by(state) %>% count(species)
    
    infoBox(
      "Arizona", icon = icon("tree"), color = "maroon", head(countaz, 1)
      
    )
    
    
    
  })
  
  output$nvCount <- renderInfoBox({
    
    
    
    infoBox(
      "Nevada", icon = icon("tree"), color = "navy"
    )
  })
  
  output$wyCount <- renderInfoBox({
    
    
    
    infoBox(
      "Wyoming", icon = icon("tree"), color = "olive"
    )
  })
}



shinyApp(ui, server)
Solution

  • The server function should be

    server <- function(input, output, session){
  
  
  output$azCount <- renderInfoBox({
    
    species_state <- ung_combined %>% select(species, state)
    species_state <- st_drop_geometry(species_state)
    infoaz <- filter(species_state, species %in% input$ungul)
    countaz <- subset(infoaz, state == "AZ") %>% count(species)
    
    infoBox(
      "Arizona", icon = icon("tree"), color = "maroon", head(countaz, 1)
     
    )
    
    
    
  })
  
  output$nvCount <- renderInfoBox({
             species_state <- ung_sf %>% select(species, state)
             species_state <- st_drop_geometry(species_state)
             infonv <- filter(species_state, species %in% input$ungul)
              countnv <- subset(infonv, state == "NV") %>% count(species)
    
    infoBox(
      "Nevada", icon = icon("tree"), color = "navy", head(countnv, 1)
    )
  })
  
  output$wyCount <- renderInfoBox({
         species_state <- ung_sf %>% select(species, state)
         species_state <- st_drop_geometry(species_state)
         infowy <- filter(species_state, species %in% input$ungul)
         countwy <- subset(infowy, state == "WY") %>% count(species)


    infoBox(
      "Wyoming", icon = icon("tree"), color = "olive", head(countwy, 1)
    )
  })
}



shinyApp(ui, server)