Data Science Final Report
1613230107 何 紫薇
「ソリューションレポート」では、「イヌノミクスの経済波及効果と共存社会の挑戦」というテーマを分析する予定です。犬産業の現状を視覚的に示すために、各種グラフを作成してみました。
①都道府県別の犬の飼育率を示す棒グラフ
library(ggplot2)
library(dplyr)##
## 次のパッケージを付け加えます: 'dplyr'## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, union# データをデータフレームに変換します
data <- data.frame(
都道府県 = c("北海道", "青森県", "岩手県", "宮城県", "秋田県", "山形県", "福島県", "茨城県", "栃木県", "群馬県",
"埼玉県", "千葉県", "東京都", "神奈川県", "新潟県", "富山県", "石川県", "福井県", "山梨県", "長野県",
"岐阜県", "静岡県", "愛知県", "三重県", "滋賀県", "京都府", "大阪府", "兵庫県", "奈良県", "和歌山県",
"鳥取県", "島根県", "岡山県", "広島県", "山口県", "徳島県", "香川県", "愛媛県", "高知県", "福岡県",
"佐賀県", "長崎県", "熊本県", "大分県", "宮崎県", "鹿児島県", "沖縄県"),
飼育率 = c(0.04591868, 0.04238040, 0.04862743, 0.04609956, 0.03766129, 0.03636599, 0.04997821, 0.05613732, 0.05428339, 0.04941558,
0.04737931, 0.04847095, 0.05270316, 0.04794422, 0.03731816, 0.04212488, 0.04265921, 0.04096414, 0.05260224, 0.04624653,
0.05952312, 0.05462088, 0.05671328, 0.06542652, 0.05525266, 0.06737255, 0.04491608, 0.05319715, 0.04157963, 0.05385604,
0.04950551, 0.04755015, 0.06392213, 0.05202065, 0.05010739, 0.05834375, 0.07387366, 0.05937519, 0.06001775, 0.04809558,
0.04765668, 0.05356041, 0.04775204, 0.05120687, 0.05194772, 0.04503199, 0.04288692)
)
# データを飼育率で降順に並び替え
data_sorted <- data %>% arrange(desc(飼育率))
# 飼育率の棒グラフを作成し、グラデーションを適用
ggplot(data_sorted, aes(x = reorder(都道府県, 飼育率), y = 飼育率, fill = 飼育率)) +
geom_bar(stat = "identity") +
scale_fill_gradient(low = "lightblue", high = "skyblue") + # グラデーションの色を指定
coord_flip() +
labs(title = "都道府県別の犬の飼育率を示す棒グラフ", x = "都道府県", y = "飼育率") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 15, face = "bold", color = "black"),
axis.title = element_text(size = 8, face = "bold", color = "darkgrey"),
axis.text.x = element_text(size = 8, color = "darkgrey"),
axis.text.y = element_text(size = 8, face = "bold", color = "darkgrey")
)
香川県（0.07387366）、京都府（0.06737255）、三重県（0.06542652）などが高い飼育率を示している。一方で、秋田県（0.03766129）、山形県（0.03636599）、新潟県（0.03731816）などが低い飼育率を示している。
②地方別の犬の飼育率を地図で示したヒートマップ
library(leaflet)
library(dplyr)
library(RColorBrewer)data <- data.frame(
地域 = c("北海道", "青森県", "岩手県", "宮城県", "秋田県", "山形県", "福島県", "茨城県", "栃木県", "群馬県",
"埼玉県", "千葉県", "東京都", "神奈川県", "新潟県", "富山県", "石川県", "福井県", "山梨県", "長野県",
"岐阜県", "静岡県", "愛知県", "三重県", "滋賀県", "京都府", "大阪府", "兵庫県", "奈良県", "和歌山県",
"鳥取県", "島根県", "岡山県", "広島県", "山口県", "徳島県", "香川県", "愛媛県", "高知県", "福岡県",
"佐賀県", "長崎県", "熊本県", "大分県", "宮崎県", "鹿児島県", "沖縄県"),
飼育率 = c(4.59, 4.24, 4.86, 4.61, 3.77, 3.64, 5.00, 5.61, 5.43, 4.94, 4.74, 4.85, 5.27, 4.79, 3.73, 4.21, 4.27, 4.10, 5.26, 4.62,
5.95, 5.46, 5.67, 6.54, 5.53, 6.74, 4.49, 5.32, 4.16, 5.39, 4.95, 4.76, 6.39, 5.20, 5.01, 5.83, 7.39, 5.94, 6.00, 4.81,
4.77, 5.36, 4.78, 5.12, 5.19, 4.50, 4.29),
緯度 = c(43.0642, 40.8246, 39.7036, 38.2682, 39.7199, 38.2404, 37.7503, 36.3418, 36.5657, 36.3907, 35.8569, 35.6051,
35.6895, 35.4475, 37.9022, 36.6953, 36.5947, 36.0652, 35.6631, 36.6513, 35.3912, 34.9756, 35.1802, 34.7303,
35.0045, 35.0116, 34.6937, 34.6913, 34.6851, 34.226, 35.5036, 35.4723, 34.6618, 34.3966, 34.1859, 34.0657,
34.3401, 33.8416, 33.5597, 33.5902, 33.2494, 32.7503, 32.7898, 33.2382, 31.9111, 31.5602, 26.2124),
経度 = c(141.3469, 140.7406, 141.1527, 140.8694, 140.1033, 140.3633, 140.4675, 140.4468, 139.8836, 139.0604, 139.6489,
140.1233, 139.6917, 139.6423, 139.0236, 137.2113, 136.6256, 136.2219, 138.5684, 138.1809, 136.7223, 138.3828,
136.9066, 136.5086, 135.8686, 135.768, 135.5023, 135.183, 135.8048, 135.1675, 134.2381, 133.0505, 133.9344,
132.4596, 131.4714, 134.5594, 134.0434, 132.7657, 133.5311, 130.4017, 130.2998, 129.8777, 130.7417, 131.6126,
131.4239, 130.5581, 127.6809)
)# 色のパレットを作成（ライトパープルからダークパープルのグラデーション）
pal <- colorNumeric(palette = colorRampPalette(c("lavender", "purple"))(10), domain = data$飼育率)
# ヒートマップを作成
leaflet(data) %>%
addTiles() %>%
addCircleMarkers(~経度, ~緯度, color = ~pal(飼育率), fillOpacity = 0.7, radius = 12, # 半径を12に設定
label = ~paste(地域, "<br>", "飼育率: ", 飼育率, "%")) %>%
addLegend(pal = pal, values = ~飼育率, opacity = 0.7, title = "飼育率",
position = "bottomright")地方別の犬の飼育率について、地図の分布で見ると、四国地域の飼育率が最も高く、北海道・東北地域の飼育率が最も低いことが分かった。
③2022年の一年間に犬にかけた年間支出額
# パッケージの読み込み
library(readxl)
library(ggplot2)
library(dplyr)
# Excelファイルの読み込み
file_path <- "pet_expenses.xlsx"
data <- read_excel(file_path)
# 2022年のデータを取り出し、割合を計算して並び替え
data_2022 <- data %>%
select(項目, `2022年`) %>%
mutate(割合 = `2022年` / sum(`2022年`) * 100) %>%
arrange(desc(割合))
# パステルカラーの薄色のパレットを定義
pastel_colors <- c("#FFC1CC", "#FFD1DC", "#FFB6C1", "#FFA07A", "#FF69B4", "#FFB347", "#FFD700", "#FFEC8B", "#B0E0E6", "#ADD8E6", "#87CEEB", "#E6E6FA", "#DDA0DD", "#E0B0FF", "#FFB6C1")
# 円グラフの作成
ggplot(data_2022, aes(x = "", y = 割合, fill = reorder(項目, -割合))) +
geom_bar(width = 1, stat = "identity", color = "white") +
coord_polar(theta = "y") +
scale_fill_manual(values = pastel_colors) +
labs(title = "2022年の一年間に犬にかけた年間支出額", x = NULL, y = NULL) +
theme_void() +
theme(legend.title = element_blank()) +
geom_text(aes(label = paste0(round(割合, 1), "%")), position = position_stack(vjust = 0.5))
④2023年の一年間に犬にかけた年間支出額
# パッケージの読み込み
library(readxl)
library(ggplot2)
library(dplyr)
# Excelファイルの読み込み
file_path <- "pet_expenses.xlsx"
data <- read_excel(file_path)
# 2022年のデータを取り出し、割合を計算して並び替え
data_2023 <- data %>%
select(項目, `2023年`) %>%
mutate(割合 = `2023年` / sum(`2023年`) * 100) %>%
arrange(desc(割合))
# パステルカラーの薄色のパレットを定義
pastel_colors <- c("#FFC1CC", "#FFD1DC", "#FFB6C1", "#FFA07A", "#FF69B4", "#FFB347", "#FFD700", "#FFEC8B", "#B0E0E6", "#ADD8E6", "#87CEEB", "#E6E6FA", "#DDA0DD", "#E0B0FF", "#FFB6C1")
# 円グラフの作成
ggplot(data_2023, aes(x = "", y = 割合, fill = reorder(項目, -割合))) +
geom_bar(width = 1, stat = "identity", color = "white") +
coord_polar(theta = "y") +
scale_fill_manual(values = pastel_colors) +
labs(title = "2023年の一年間に犬にかけた年間支出額", x = NULL, y = NULL) +
theme_void() +
theme(legend.title = element_blank()) +
geom_text(aes(label = paste0(round(割合, 1), "%")), position = position_stack(vjust = 0.5))