【R】都道府県別 メディア行動率

総務省統計局が発表している「都道府県・市区町村のすがた(社会・人口統計体系)」から、都道府県別のテレビ・ラジオ・新聞・雑誌行動者率(15歳以上)を男女それぞれで表示してみます。どれだけメディアに影響されているか見えるはずです。データが2006年と古いので現在(2020年)は異なりそうです。インターネットの影響が大きくなっていそうですし。

都道府県 メディア行動者率_男 メディア行動者率_女
北海道 75.0 80.1
青森 73.0 79.8
岩手 75.6 78.1
宮城 73.3 75.1
秋田 74.1 79.5
山形 71.8 77.4
福島 74.6 80.4
茨城 75.8 78.3
栃木 74.3 77.0
群馬 71.1 72.1
埼玉 68.8 75.3
千葉 65.1 72.7
東京 67.8 75.6
神奈川 68.2 72.7
新潟 71.9 77.7
富山 75.8 77.7
石川 70.6 74.1
福井 73.6 75.9
山梨 74.8 76.9
長野 75.3 76.8
岐阜 72.6 78.6
静岡 73.1 77.2
愛知 71.7 77.8
三重 73.0 75.2
都道府県 メディア行動者率_男 メディア行動者率_女
滋賀 72.0 76.5
京都 70.2 77.7
大阪 67.4 72.8
兵庫 68.9 77.7
奈良 69.7 76.6
和歌山 74.5 79.5
鳥取 75.0 75.8
島根 77.5 76.8
岡山 70.0 74.0
広島 75.4 76.6
山口 76.3 79.5
徳島 78.3 78.8
香川 76.1 79.1
愛媛 74.7 78.2
高知 72.9 75.8
福岡 71.4 78.9
佐賀 72.5 75.5
長崎 79.4 77.3
熊本 74.2 75.3
大分 77.3 81.7
宮崎 78.8 79.6
鹿児島 74.7 78.0
沖縄 78.1 74.3
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="メディア行動者率_男【%】")
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

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