【R】オーストリアの地域別牛乳生産量

2020年8月19日

こちらのページでは、ドイツの地域別の牛乳生産量（2018年）をコロプレス図にて表現しました。

今回は、お隣のオーストリアの地域別の牛乳生産量（2018年）を同じくコロプレス図にて描いてみます。

データは、”Eurostat“というサイトから、EU統計を取得してローカルに保存しておきます。
今回も、国・地域別の牛乳の生産量（Production of cow’s milk on farms by NUTS 2 regions (tgs00046)）を取得し、そのうちオーストリアの生産量のみを抽出、地方別にコロプレス図を描いてみます。

こちらから
　Data >
MAIN TABLES >
Regional statistics(t_reg) >
Regional agriculture statistics(t_reg_agr) >
Productionof cow’s milk on farms by NUTS2 region
のデータをTSV形式で保存します（tgs00046.tsv）。

EUの国々の地方は、NUTSという体系で分類されています。各国のNUTSの詳しい分類は、こちらのページにあります。

今回は、NUTS２で分類、表示しますが、このコードと地域名の一覧をあらかじめCSVファイルにまとめておきました。

http://www.dinov.tokyo/Data/World/NUTS2_Code_AT.csv

また、地図を描くシェープファイルは、DIVA-GISの”Spatial Data Download”から、Administrative areaのデータをとってきます。今回は、Austriaの地図(NUTS.2) AUT_adm1.shp です。カレントディレクトリに作った”AUT_adm”ディレクトリに入れておきます。

下記のコードで、2018年のオーストリアの地方の牛乳生産量を取得、表示できます。

library(tidyverse)
require(data.table)
library(ggplot2)
library(ggrepel)
library(sf)
library(kableExtra)

Sys.setlocale("LC_CTYPE", "german")

nuts <- read.csv("http://www.dinov.tokyo/Data/World/NUTS2_Code_AT.csv", header = TRUE, encoding="UTF-8")

milk_data<-as.data.frame(fread("tgs00046.tsv")) %>%
  separate(col = V1, into=c("x1", "x2", "Code"), sep=",",  remove=TRUE, convert=FALSE) %>%
  left_join(., nuts, by="Code", copy=FALSE) %>%
  drop_na() %>%
  rename("NAME_1" = NUTS_2_org)

map <- read_sf("AUT_adm/AUT_adm1.shp")

dat <- map %>%
  left_join(., milk_data, by="NAME_1", copy=FALSE) %>%
  mutate("Milk_t"=as.numeric(V12)) %>%
  arrange(desc(Milk_t)) %>%
  mutate( # 重心計算と座標値の抽出
    centroid = st_centroid(geometry),
    x = st_coordinates(centroid)[, 1],
    y = st_coordinates(centroid)[, 2]
  ) 

dat %>%
  ggplot() +
  geom_sf(aes(fill = Milk_t)) +  
  coord_sf(datum = NA) +
  scale_fill_viridis_c(alpha = 0.6) +
  theme_void()+ 
  geom_text_repel(aes(x = x, y = y, label = NAME_1), col="black", size = 3)


table_df<-data.frame(Name=dat$NAME_1, Milk_t=dat$Milk_t)

library(clipr)
table_df %>% 
  kable(align = "c", row.names=FALSE) %>%
  kable_styling(full_width = F) %>%
  column_spec(1, bold = T) %>%
  collapse_rows(columns = 1, valign = "middle") %>% 
  write_clip