【R】ワクチン接種　都道府県別コロプレス図

新型コロナウイルスが猛威を振るっています。そのワクチン接種が、医療従事者と高齢者から進められています。

こちらのサイトでその状況をデータにて公開しているので、ダッシュボード風にデータを表示してみたいと思います。こちらのサイトで、すばらしくまとまっていましたので、触発されました。

今回は、医療従事者へのワクチン接種状況をプロットします。データは、あらかじめ取得して、整形してCSVファイルに保存しておきます。日本地図をleafletで描くためにシェープファイルをGADMから取得しておきます。

インタラクティブな地図の書き方は、”RでGIS：塗り分け地図（コロプレス図）を作る”を参考に、シェープファイルの扱い方は、”sfパッケージを用いたデータの読み込みから可視化まで”を参考にさせていただきました。

で、コードはこんな感じです。

---
title: "Covid19-vaccination in Japan"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(leaflet)
library(maps)
library(mapproj)
library(DT)
```


Column {data-width=60%}
-----------------------------------------------------------------------
### Map

```{r choropleths}


jpn.shp <- readRDS("gadm36_JPN_1_sp.rds")

vacc_dat <- read.csv("vacc.csv", fileEncoding = "UTF-8") %>% 
  slice(2:48)

va <- vacc_dat %>% mutate(NL_NAME_1=pref)
sp_data <- jpn.shp@data %>% 
  inner_join(va, by="NL_NAME_1") %>% 
  select(pref, vacc, vacc1, vacc2)

jpn.shp@data$pref <- sp_data$pref
jpn.shp@data$vacc <- sp_data$vacc
jpn.shp@data$vacc1 <- sp_data$vacc1
jpn.shp@data$vacc2 <- sp_data$vacc2

pal <- colorNumeric("YlOrRd", domain=jpn.shp@data$vacc, reverse=F)

labels <- sprintf("<strong>%s</strong><br/>接種回数：%5.0f<br/>内1回目：%5.0f<br/>内2回目：%5.0f",
                  paste0(jpn.shp@data$NL_NAME_1),
                  jpn.shp@data$vacc,
                  jpn.shp@data$vacc1,
                  jpn.shp@data$vacc2) %>% lapply(htmltools::HTML)

jpn.shp %>% 
  leaflet() %>% 
  setView(lat=37.5, lng=139, zoom=5) %>% 
  addProviderTiles(providers$CartoDB.Positron) %>% 
  addPolygons(fillOpacity = 0.5,
              weight=1,
              fillColor = ~pal(jpn.shp@data$vacc),
              color = "orange",
              label = labels,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "16px",
                direction = "auto"),
              highlight = highlightOptions(
                weight = 5,
                color = "#888",
                fillOpacity = 0.5,
                bringToFront = TRUE)
              ) %>% 
  addLegend("bottomright", pal = pal, values = ~jpn.shp@data$vacc,
            title = "新型コロナウイルス<br/>ワクチン接種状況<br/>as of 21/05/2021"  )


```

Column {data-width=40%}
-----------------------------------------

### Table

```{r vacctination_table}


vacc_dat %>% 
  datatable(rownames=FALSE, 
            colnames=c("都道府県", "接種回数", "内1回目", "内2回目"),
            filter='top', 
            options=list(
              autoWidth=TRUE,
              pageLength=16
            )
          )

```

flexdashboardを使って、こんな風に出力されます。

実際のサイトはこちら。