{flexdashboard}と{leaflet}で簡易GIS

choropleth_demo.Rmd

---
title: "Choropleth Demo"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
runtime: shiny
---

```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(dplyr)
library(estatapi)
library(rgdal)
library(leaflet)
library(DT)

appId <- "********************"
d <- estat_getStatsData(appId = appId, statsDataId = "0003157723") %>% 
  filter(cat01_code == "0" & cat02_code == "000" & cat03_code == "003") %>% 
  select(area_code, value)
layers <- ogrListLayers("N03-170101_GML/N03-17_170101.shp")
shp <- readOGR("N03-170101_GML/N03-17_170101.shp", layer=layers[1], 
               stringsAsFactors = FALSE)
```

Sidebar {.sidebar}
=======================================================================
### Filter

```{r}
selectInput("pref", label = "都道府県:",
            choices = c("東京都" = "13", 
                        "大阪府" = "27"), selected = "東京都")
```

Map
=======================================================================

Row
-----------------------------------------------------------------------
### Map
```{r}
renderLeaflet({
  d.sub <- d %>% filter(grepl(paste0("^", input$pref), area_code))
  shp.sub <- subset(shp, shp@data$N03_007 %in% d.sub$area_code)
  shp.sub@data <- merge(shp.sub@data, d.sub, by.x = "N03_007", by.y = "area_code")

  # ハイライト表示のラベル
  labels <- sprintf("<strong>%s</strong><br/>%g",
                    paste0(shp.sub@data$N03_001,
                           ifelse(is.na(shp.sub@data$N03_003), "", shp.sub@data$N03_003),
                           ifelse(is.na(shp.sub@data$N03_004), "", shp.sub@data$N03_004)),
                    shp.sub@data$value) %>% 
    lapply(htmltools::HTML)
  
  pal <- colorNumeric("Spectral", domain=shp.sub@data$value, reverse=TRUE)
  
  shp.sub %>% 
    leaflet() %>% 
    addProviderTiles(providers$CartoDB.Positron) %>% 
    addPolygons(fillOpacity = 0.5,
              weight=1,
              fillColor = ~pal(value),
              label = labels,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto"),
              highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE)) %>% 
    addLegend("bottomright", pal = pal, values = ~value,
            title = "転入超過数")
})
```

### Table

```{r}
renderDataTable({
  d.sub <- d %>% filter(grepl(paste0("^", input$pref), area_code))
  shp.sub <- subset(shp, shp@data$N03_007 %in% d.sub$area_code)
  shp.sub@data <- merge(shp.sub@data, d.sub, by.x = "N03_007", by.y = "area_code")
  shp.sub@data %>% 
    mutate(city_name = paste0(N03_001,
                              ifelse(is.na(N03_003), "", N03_003),
                              ifelse(is.na(N03_004), "", N03_004))) %>% 
    select(city_name, value) %>% 
    unique() %>% 
    datatable(options = list(pageLength = 20))
})
```