Changing the values of infoBox from selectInput

107 Views Asked by At

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)


1

There are 1 best solutions below

0
Intrepid Nutrepidation On BEST ANSWER

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)