circlepackeR in R-Shiny - create circle packing graph based on user inputs

688 views Asked by At

I'm trying to make a circlepackeR graph based on user inputs. I'm wondering if that's even possible within the packages I'm using, if I should use a different approach altogether, or if maybe there's just a mistake with my code. I've been staring at it for too long.

Here's the basics of what I'm trying to accomplish. When the user selects a county from the selectInput() options, a modal dialog should appear with the circle packing displayed of that selected county's racial/ethnic/gender makeup. Works great until I try to subset the dataframe by using a reactive function to filter the data based on select inputs. Errors arise when I convert my data to nodes from reactive filters ("subscript out of bounds", "Please provide a json object or list", "Operation not allowed without an active reactive context..")

Here's my code:

#libraries
library(shiny)
library(shinydashboard)
library(data.tree)
library(circlepackeR) 
library(dplyr)

UI:

ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
        selectInput("selectcounty", "Select County", unique(counties1$NAME))
    ),
    dashboardBody()
   )

Server:

server <- function(session, input, output) {
#1. observe event, render modal dialogue for select input  
    observeEvent(input$selectcounty, {
        click <- input$selectcounty
        if(is.null(click))
            return() 
        {showModal(modalDialog(
            footer = NULL,
            easyClose = T,
            circlepackeROutput(outputId = "race1", width = "100%", height = "400px")
        ))
            }
    }) 

    ###### CIRCLE TREE MAP OF SELECT INPUT #######
#2. subset data
    subset_race<- reactive({
     dplyr::filter(race, race[NAME]==input$selectcounty)
    })

 ### *this is where the problem is I think --- can't convert to nodes from a reactive function?   
    subset_nodes <- reactive({as.Node(subset_race())})
  
#3. display in circle packer graph
    output$race1 <- renderCirclepackeR({
      circlepackeR(subset_nodes, size = "r_count", color_min = "hsl(56,80%,80%)", color_max = "hsl(341,30%,40%)")
    })   
}
shinyApp(ui = ui, server = server)

And here's my data:

#ETHNICITY/RACE/GENDER DATA
dput(head(race))
structure(list(NAME = c("Autauga-AL", "Autauga-AL", "Autauga-AL", 
"Autauga-AL", "Autauga-AL", "Autauga-AL"), STATE_NAME = c("AL", 
"AL", "AL", "AL", "AL", "AL"), gender = structure(c(2L, 1L, 2L, 
1L, 2L, 1L), .Label = c("female", "male"), class = "factor"), 
    hispanic = structure(c(2L, 2L, 1L, 1L, 2L, 2L), .Label = c("hispanic", 
    "nonhispanic"), class = "factor"), race = structure(c(12L, 
    12L, 12L, 12L, 3L, 3L), .Label = c("asian", "asian in combination", 
    "black", "black in combination", "HNAC_FEMALE", "HNAC_MALE", 
    "native", "native in combination", "NHNAC_FEMALE", "NHNAC_MALE", 
    "two or more", "white", "white in combination"), class = "factor"), 
    r_count = c(20138L, 21077L, 740L, 652L, 5171L, 5927L), pathString = c("world/male/nonhispanic/white", 
    "world/female/nonhispanic/white", "world/male/hispanic/white", 
    "world/female/hispanic/white", "world/male/nonhispanic/black", 
    "world/female/nonhispanic/black")), row.names = c(1L, 3109L, 
6217L, 9325L, 12433L, 15541L), class = "data.frame")


###US COUNTY DATA
dput(head(counties1))
structure(list(NAME = "Autauga-AL", Year = 2018L, ID = 1001L, 
    STATE_NAME.x = "AL", All.Ages.in.Poverty.Percent = 13.8, 
    GEOID = "01001", ALAND = "1539614693", AWATER = "25744269", 
    INTPTLAT = "+32.5322367", INTPTLON = "-086.6464395", X = -86.643, 
    Y = 32.535, charpov = "13.8", not_pov = 86.2, charnot_pov = "86.2"), row.names = 98L, class = "data.frame")

This is my first attempt at circle packing. What information am I missing?

1

There are 1 answers

0
Melissa Allen On

This question is answered by @Limey in my other SO question about nesting reactive functions here: R Shiny - Is it possible to nest reactive functions?

Basically, I needed req() to require the user's selected input in the reactive filter:

subset_race <- reactive({
  req(input$selectcounty)
  subset.data.frame(race, NAME==input$selectcounty)
})