【R】都道府県別 ソフトボール投げ

総務省統計局が発表している「都道府県・市区町村のすがた(社会・人口統計体系)」から、都道府県別の小学校5年生のソフトボール投げ(m)の距離を示します。2018年のデータです。

都道府県 ソフトボール投げ_男 ソフトボール投げ_女
北海道 22.6 13.8
青森 22.5 14.1
岩手 23.5 15.0
宮城 22.9 13.9
秋田 24.2 15.2
山形 22.8 14.7
福島 22.0 14.2
茨城 21.7 14.6
栃木 21.5 14.1
群馬 21.1 13.8
埼玉 21.2 13.7
千葉 21.1 13.3
東京 21.6 13.1
神奈川 21.4 12.7
新潟 22.6 14.3
富山 23.1 14.6
石川 23.4 14.6
福井 23.9 15.5
山梨 21.2 14.0
長野 22.7 14.1
岐阜 22.3 14.5
静岡 21.2 14.0
愛知 21.1 13.3
三重 22.2 14.0
都道府県 ソフトボール投げ_男 ソフトボール投げ_女
滋賀 21.9 13.5
京都 22.3 13.7
大阪 21.6 13.2
兵庫 22.5 13.2
奈良 22.4 14.1
和歌山 22.8 14.7
鳥取 22.7 13.9
島根 23.9 14.3
岡山 21.8 13.6
広島 24.9 15.0
山口 21.9 13.2
徳島 22.3 14.3
香川 22.2 14.4
愛媛 21.7 13.7
高知 22.2 14.4
福岡 23.8 14.2
佐賀 23.4 14.3
長崎 23.0 14.3
熊本 23.1 14.4
大分 24.6 15.3
宮崎 23.4 14.6
鹿児島 23.0 14.3
沖縄 24.5 14.7
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

table_df<-data.frame(都道府県=dat$都道府県, ソフトボール投げ_男=dat$ソフトボール投げ_男, ソフトボール投げ_女=dat$ソフトボール投げ_女)

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$ソフトボール投げ_女, hist(dat$ソフトボール投げ_女, 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("plot1.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="ソフトボール投げ_女")
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

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