---
title: "Connection to other Shiny elements"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Connection to other Shiny elements}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```
In this article, we demonstrate how to connect a `leafdown` map to other Shiny elements. <br>

```{r, echo=FALSE, out.width="100%"}
knitr::include_graphics("../man/figures/app_election_map.png")
```
Click here for the [full demo app](https://pega.shinyapps.io/election16/)

## Data
As described in the [Introduction article.](https://hoga-it.github.io/leafdown/articles/Introduction.html), we need two 
types of data:

- **SpatialPolygonsDataFrames**, the shapes of the US-States and Counties, taken from the `raster` package.

- **Election Results and Census Data**, the data we want to display on the map, taken from the example data sets that 
  come with the `leafdown` package. (The original data comes from [Deleetdk](https://github.com/Deleetdk/USA.county.data). 
  For more information about the data, please see `?us_election_states` or `?us_election_counties` respectively)

## The Map itself
The structure of the map is pretty similar to the map from the [Introduction article.](https://hoga-it.github.io/leafdown/articles/Introduction.html)
Here we show the results of the US Presidential Election from 2016.

## Connecting Graphs to our Map
In this section, we want to demonstrate how simple it is to connect graphs or similar UI-elements with the map.

We create two graphs that give more insight into the currently selected shapes: </br>

- As the map only shows the winner, we create a bar chart to show the percentages from every party.
- Additionally, we add a graph showing the racial makeup.

The changes in the UI are straightforward:
```{r, eval = FALSE}
column(
  width = 5,
  # box for racial makeup graph
  bs4Card(
    width = 12,
    closable = F,
    collapsible = F,
    title = "Racial makeup in percentages",
    echarts4rOutput("socio")
  ),
  # box for party percent graph
  bs4Card(
    width = 12,
    closable = F,
    collapsible = F,
    title = "Votes in percent",
    echarts4rOutput("party")
  )
)
```

To connect the graphs with the map, we can use the `$curr_sel_data()` attribute.
This attribute is a `reactiveValue` which allows us to update the graphs whenever the user selects a shape on the map or drills a level up or down.

In the server, we obtain the data using `df <- my_leafdown$curr_sel_data()`. 

Creating the rest of the graph is again straightforward.

```{r, eval = FALSE}
output$party <- renderEcharts4r({
  # get the currently selected data from the map
  df <- my_leafdown$curr_sel_data()

  # check whether any shape is selected, show general election-result if nothing is selected
  if (nrow(df) > 0) {
    if (my_leafdown$curr_map_level == 1) {
      df <- df[, c("state_abbr", "Democrats2016", "Republicans2016", "Libertarians2016", "Green2016")]
      df <- df %>%
        pivot_longer(2:5, "party") %>%
        group_by(party)
    } else {
      df <- df[, c("County", "Democrats2016", "Republicans2016", "Libertarians2016", "Green2016")]
      df <- df %>%
        pivot_longer(2:5, "party") %>%
        group_by(party)
      df$value <- df$value
      names(df)[1] <- "state_abbr"
    }
  } else {
    # show general election-result as no state is selected
    df <- data.frame(
      party = c("Democrats2016", "Republicans2016", "Libertarians2016", "Green2016"),
      state_abbr = "USA",
      value = c(0.153, 0.634, 0.134, 0.059)
    ) %>%
      group_by(party)
  }
  # create the graph
  df %>%
    e_charts(state_abbr, stack = "grp") %>%
    e_bar(value) %>%
    e_y_axis(formatter = e_axis_formatter("percent", digits = 2)) %>%
    e_tooltip(trigger = "axis", axisPointer = list(type = "shadow")) %>%
    e_legend(right = 10, top = 10) %>%
    e_color(c("#232066", "#E91D0E", "#f3b300", "#006900")) %>%
    e_tooltip(formatter = e_tooltip_item_formatter("percent", digits = 2))
})
```

# Final Demo App
<details>
<summary>The full code of the election map...</summary>
**Note:** The shapes have to be manually downloaded before the app can be used.</br>
In the given election app the shapes have also been simplified to 0.5% of their original size. 
```{r, eval=FALSE}
states <- raster::getData(country = "USA", level = 1)
counties <- raster::getData(country = "USA", level = 2)
# TODO replace the path to your downloaded shapes in the server code
```

```{r, eval=FALSE}
library(shiny)
library(bs4Dash)
library(shinyjs)
library(leaflet)
library(leafdown)
library(echarts4r)
library(dplyr)
library(tidyr)
library(RColorBrewer)

ui <- bs4DashPage(
  title = "Leafdown Showcase - USA Election Data",
  navbar = bs4DashNavbar(tags$h3("Leafdown Showcase - USA Election Data", style = "margin-bottom: .2rem;")),
  bs4DashSidebar(disable = TRUE),
  body = bs4DashBody(
    # set the background of the map-container to be white
    tags$head(
      tags$style(HTML(".leaflet-container { background: #fff; height: 100%}")),
      # workaround for the NA in leaflet legend see https://github.com/rstudio/leaflet/issues/615
      tags$style(HTML(".leaflet-control div:last-child {clear: both;}")),
      tags$style(HTML(".card {height: 100%;}")),
      tags$style(HTML(".col-sm-12:last-child .card {margin-bottom: 0 !important;}")),
      tags$style(HTML("#leafdown {height: 80% !important; margin-top: 10px; margin-bottom: 10px;}"))
    ),
    # we need shinyjs for the leafdown map
    useShinyjs(),
    fluidRow(
      # a card for the map
      bs4Card(
        title = "Map",
        closable = FALSE,
        collapsible = FALSE,
        width = 6,
        # a dropdown to select what KPI should be displayed on the map
        selectInput(
          "map_sel", "Select what KPI to display on the map:",
          c("Votes" = "votes", "Unemployment" = "unemployment")
        ),
        # the two buttons used for drilling
        actionButton("drill_down", "Drill Down"),
        actionButton("drill_up", "Drill Up"),
        # the actual map element
        leafletOutput("leafdown")
      ),

      # a column with the two graphs
      column(
        width = 6,
        # box for racial makeup graph
        bs4Card(
          width = 12,
          closable = F,
          collapsible = F,
          title = "Racial makeup in percentages",
          echarts4rOutput("socio")
        ),
        # box for party percent graph
        bs4Card(
          width = 12,
          closable = F,
          collapsible = F,
          title = "Votes in percent",
          echarts4rOutput("party")
        )
      )
    )
  )
)

# Create user-defined function
percent <- function(x, digits = 2, format = "f", ...) { 
  paste0(formatC(x * 100, format = format, digits = digits, ...), "%")
}

create_labels <- function(data, map_level) {
  labels <- sprintf(
    "<strong>%s</strong><br/>
    Democrats: %s<br/>
    Republicans: %s<br/>
    Libertarians: %s<br/>
    Green: %s<br/>
    </sup>",
    data[, paste0("NAME_", map_level)],
    percent(data$Democrats2016),
    percent(data$Republicans2016),
    percent(data$Libertarians2016),
    percent(data$Green2016)
  )
  labels %>% lapply(htmltools::HTML)
}

# Define server for leafdown app
server <- function(input, output) {
  # load the shapes for the two levels
  # TODO load the shapes you have downloaded via the raster package
  states <- readRDS("../inst/app_election/us1.RDS")
  counties <- readRDS("../inst/app_election/us2.RDS")
  spdfs_list <- list(states, counties)

  # create leafdown object
  my_leafdown <- Leafdown$new(spdfs_list, "leafdown", input)

  rv <- reactiveValues()
  rv$update_leafdown <- 0

  # observers for the drilling buttons
  observeEvent(input$drill_down, {
    my_leafdown$drill_down()
    rv$update_leafdown <- rv$update_leafdown + 1
  })

  observeEvent(input$drill_up, {
    my_leafdown$drill_up()
    rv$update_leafdown <- rv$update_leafdown + 1
  })

  data <- reactive({
    req(rv$update_leafdown)
    # fetch the current metadata from the leafdown object
    data <- my_leafdown$curr_data

    # join the metadata with the election-data.
    # depending on the map_level we have different election-data so the 'by' columns for the join are different
    if (my_leafdown$curr_map_level == 2) {
      data$ST <- substr(data$HASC_2, 4, 5)
      # there are counties with the same name in different states so we have to join on both
      data <- left_join(data, us_election_counties, by = c("NAME_2", "ST"))
    } else {
      data$ST <- substr(data$HASC_1, 4, 5)
      data <- left_join(data, us_election_states, by = "ST")
    }
    # add the data back to the leafdown object
    my_leafdown$add_data(data)
    data
  })

  # this is where the leafdown magic happens
  output$leafdown <- renderLeaflet({
    req(spdfs_list)
    req(data)

    data <- data()

    # depending on the selected KPI in the dropdown we show different data
    if (input$map_sel == "unemployment") {
      data$y <- data$Unemployment * 100
      fillcolor <- leaflet::colorNumeric("Greens", data$y)
      legend_title <- "Unemployment in Percent"
    } else {
      data$y <- ifelse(data$Republicans2016 > data$Democrats2016, "Republicans", "Democrats")
      fillcolor <- leaflet::colorFactor(c("#232066", "#E91D0E"), data$y)
      legend_title <- "Winning Party"
    }

    labels <- create_labels(data, my_leafdown$curr_map_level)
    # draw the leafdown object
    my_leafdown$draw_leafdown(
      fillColor = ~ fillcolor(data$y),
      weight = 3, fillOpacity = 1, color = "white", label = labels
    ) %>%
      # set the view to be center on the USA
      setView(-95, 39, 4) %>%
      # add a nice legend
      addLegend(
        pal = fillcolor,
        values = ~ data$y,
        title = legend_title,
        opacity = 1
      )
  })

  # plots
  output$socio <- renderEcharts4r({
    df <- my_leafdown$curr_sel_data()
    # check whether any shape is selected, show basic info for the whole usa if nothing is selected
    if (nrow(df) > 0) {
      if (my_leafdown$curr_map_level == 1) {
        df <- df[, c("State", "Hispanic", "White", "Black", "Asian", "Amerindian", "Other")]
        df <- df %>%
          pivot_longer(2:7, "race") %>%
          group_by(State)
        df$value <- round(df$value, 2)
      } else {
        df <- df[, c("County", "Hispanic", "White", "Black", "Asian", "Amerindian", "Other")]
        df <- df %>%
          pivot_longer(2:7, "race") %>%
          group_by(County)
        df$value <- round(df$value / 100, 2)
      }
    } else {
      # show basic info for the whole usa as no state is selected
      df <- data.frame(
        ST = "USA",
        race = c("Hispanic", "White", "Black", "Asian", "Amerindian", "Other"),
        value = c(0.15, 0.634, 0.134, 0.059, 0.015, 0.027)
      ) %>%
        group_by(ST)
    }
    # create the graph
    df %>%
      e_charts(race) %>%
      e_bar(value) %>%
      e_tooltip(trigger = "axis", axisPointer = list(type = "shadow")) %>%
      e_y_axis(
        splitArea = list(show = FALSE),
        splitLine = list(show = FALSE),
        formatter = e_axis_formatter("percent", digits = 2)
      ) %>%
      e_legend(orient = "vertical", right = 10, top = 10) %>%
      e_color(brewer.pal(nrow(df), "Set3")) %>%
      e_tooltip(formatter = e_tooltip_item_formatter("percent"))
  })

  output$party <- renderEcharts4r({
    df <- my_leafdown$curr_sel_data()
    # check whether any shape is selected, show general election-result if nothing is selected
    if (nrow(df) > 0) {
      if (my_leafdown$curr_map_level == 1) {
        df <- df[, c("ST", "Democrats2016", "Republicans2016", "Libertarians2016", "Green2016")]
        df <- df %>%
          pivot_longer(2:5, "party") %>%
          group_by(party)
      } else {
        df <- df[, c("County", "Democrats2016", "Republicans2016", "Libertarians2016", "Green2016")]
        df <- df %>%
          pivot_longer(2:5, "party") %>%
          group_by(party)
        df$value <- df$value
        names(df)[1] <- "ST"
      }
    } else {
      # show general election-result as no state is selected
      df <- data.frame(
        party = c("Democrats2016", "Republicans2016", "Libertarians2016", "Green2016"),
        ST = "USA",
        value = c(0.153, 0.634, 0.134, 0.059)
      ) %>%
        group_by(party)
    }
    # create the graph
    df %>%
      e_charts(ST, stack = "grp") %>%
      e_bar(value) %>%
      e_y_axis(formatter = e_axis_formatter("percent", digits = 2)) %>%
      e_tooltip(trigger = "axis", axisPointer = list(type = "shadow")) %>%
      e_legend(right = 10, top = 10) %>%
      e_color(c("#232066", "#E91D0E", "#f3b300", "#006900")) %>%
      e_tooltip(formatter = e_tooltip_item_formatter("percent", digits = 2))
  })
}

shinyApp(ui, server)

```
</details>

You can find the [full demo app](https://pega.shinyapps.io/election16/) hosted on shinyapps.io