Navigation Menu

Skip to content

Instantly share code, notes, and snippets.

@kashitan
Created June 14, 2017 07:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kashitan/9bd81c967ecf8e100f82e31ac9f00771 to your computer and use it in GitHub Desktop.
Save kashitan/9bd81c967ecf8e100f82e31ac9f00771 to your computer and use it in GitHub Desktop.
{flexdashboard}と{leaflet}で簡易GIS
---
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))
})
```
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment