【R】都道府県別 医師数

総務省統計局が発表している「都道府県・市区町村のすがた(社会・人口統計体系)」から、都道府県別の医師数を示します。また、各都道府県の総人口で割った人口10万人あたりの医師数も示します。2018年のデータです。

都道府県 医師数 医師数_人口10万あたり
北海道 13309 256.0
青森 2702 213.8
岩手 2631 211.8
宮城 5653 247.1
秋田 2384 241.0
山形 2597 237.7
福島 3888 208.3
茨城 5513 192.9
栃木 4498 232.4
群馬 4620 239.8
埼玉 12172 170.3
千葉 12278 200.7
東京 44136 331.5
神奈川 19476 217.2
新潟 4698 209.1
富山 2723 261.9
石川 3405 304.1
福井 2002 261.0
山梨 1990 244.1
長野 4930 240.4
岐阜 4358 218.8
静岡 7662 211.4
愛知 16410 222.8
三重 4081 229.7
都道府県 医師数 医師数_人口10万あたり
滋賀 3270 235.0
京都 8723 340.9
大阪 25003 287.8
兵庫 13979 257.4
奈良 3407 255.2
和歌山 2868 305.3
鳥取 1805 325.1
島根 1975 295.1
岡山 5975 319.3
広島 7534 271.6
山口 3615 266.5
徳島 2500 342.7
香川 2813 296.5
愛媛 3745 278.0
高知 2276 324.9
福岡 15997 322.5
佐賀 2377 295.3
長崎 4218 318.5
熊本 5230 302.7
大分 3230 287.0
宮崎 2754 258.3
鹿児島 4461 281.1
沖縄 3609 258.0
library(leaflet)
library(knitr)
library(kableExtra)
library(dplyr)
library(tidyr)
library(stringr)

dat <- read.csv("http://www.dinov.tokyo/Data/JP_Pref/Pref_data.csv", header = TRUE, fileEncoding="UTF-8")
col_start <- 0.2
col_end <- 0.0

dat$医師数_10万<-round(dat$医師数/dat$総人口*100000, 1)

table_df<-data.frame(都道府県=dat$都道府県, 医師数=dat$医師数, 医師数_人口10万あたり=dat$医師数_10万)

datc_k <- cut(dat$医師数, hist(dat$医師数, plot=FALSE)$breaks, right=FALSE)
datc_kcol <- rainbow(length(levels(datc_k)), start = col_start, end=col_end)[as.integer(datc_k)]
datc_m <- cut(dat$医師数_10万, hist(dat$医師数_10万, plot=FALSE)$breaks, right=FALSE)
datc_mcol <- rainbow(length(levels(datc_m)), start = col_start, end=col_end)[as.integer(datc_m)]

library(NipponMap)
windowsFonts(JP4=windowsFont("Biz Gothic"))
windows(width=1600, height=800)

png("0plot1.png", width = 1600, height = 800)
par(family="JP4")
layout(matrix(1:2, 1, 2))
JapanPrefMap(datc_kcol, main="医師数(人)")
legend("bottomright", fill=rainbow(length(levels(datc_k)), start = col_start, end=col_end), legend=names(table(datc_k)))
JapanPrefMap(datc_mcol, main="医師数(人口10万人あたり)")
legend("bottomright", fill=rainbow(length(levels(datc_m)), start = col_start, end=col_end), legend=names(table(datc_m)))
dev.off()

library(clipr)
t1=kable(table_df[c(1:24),], align = "c", row.names=FALSE) %>%
  kable_styling(full_width = F) %>%
  column_spec(1, bold = T) %>%
  collapse_rows(columns = 1, valign = "middle") 
t2=kable(table_df[c(25:47),], align = "c", row.names=FALSE) %>%
  kable_styling(full_width = F) %>%
  column_spec(1, bold = T) %>%
  collapse_rows(columns = 1, valign = "middle") 
paste(c('<table><tr valign="top"><td>', t1, '</td><td>', t2, '</td><tr></table>'), sep = '') %>% write_clip

Add a Comment

メールアドレスが公開されることはありません。