【R】都道府県別 スポーツ時間数

健康維持のためには、適度な運動が必要です。みなさんはどの程度運動をしているのでしょう?都道府県で差があるのでしょうか?総務省統計局が発表している「都道府県・市区町村のすがた(社会・人口統計体系)」から、都道府県別の2016年のスポーツの平均時間(分)(10歳以上)を男女それぞれで表示してみます。

都道府県 スポーツ時間_男 スポーツ時間_女
北海道 16 9
青森 14 7
岩手 14 8
宮城 18 9
秋田 18 8
山形 17 10
福島 14 10
茨城 20 10
栃木 22 11
群馬 19 12
埼玉 19 11
千葉 19 11
東京 18 11
神奈川 17 10
新潟 13 9
富山 23 10
石川 20 10
福井 19 11
山梨 19 11
長野 19 11
岐阜 19 10
静岡 17 11
愛知 18 10
三重 20 13
都道府県 スポーツ時間_男 スポーツ時間_女
滋賀 21 14
京都 23 11
大阪 18 9
兵庫 20 10
奈良 18 10
和歌山 16 10
鳥取 15 8
島根 18 8
岡山 16 9
広島 18 10
山口 19 9
徳島 17 11
香川 20 10
愛媛 19 10
高知 16 11
福岡 20 9
佐賀 20 10
長崎 18 11
熊本 21 9
大分 19 11
宮崎 17 9
鹿児島 17 11
沖縄 22 12
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("0plot1.png", width = 1600, height = 800)
par(family="JP4")
layout(matrix(1:2, 1, 2))
JapanPrefMap(datc_kcol, main="スポーツ時間_男【h】")
legend("bottomright", fill=rainbow(length(levels(datc_k)), start = col_start, end=col_end), legend=names(table(datc_k)))
JapanPrefMap(datc_mcol, main="スポーツ時間_女【h】")
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

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