Rで解析：機能性表示食品の届出情報を解析してみよう

#パッケージのインストール
install.packages("tidyverse")

#パッケージの読込み
library("tcltk")
library("tidyverse")

#Function_Food.rdaの読み込み
load(paste0(as.character(
  tkgetOpenFile(title = "Function_Food.rdaを選択",
                filetypes = '{"rdaファイル" {".rda"}}',
                initialfile = c("*.rda"))), collapse = " "))

###全登録商品に使用されている上位15の機能性関与成分#####
#データを準備
Function_Food %>%
  #列を選択
  select(販売状況, 統一機能性関与成分名) %>%
  #機能性関与成分を分割
  mutate(Component = str_split(統一機能性関与成分名, "、")) %>%
  #統一機能性関与成分名を削除
  select(-統一機能性関与成分名) %>%
  #Componentの内容がnestされているので解除
  unnest(cols = c(Component)) %>%
  #販売状況, Componentでグループ化
  group_by(販売状況, Component) %>%
  #販売状況による統一機能性関与成分の出現数を確認
  summarize(Count = n(), .groups = "keep") %>%
  #グループ解除
  ungroup() %>%
  #機能性関与成分でグループ化
  group_by(Component) %>%
  #全統一機能性関与成分の出現数を確認
  mutate(All_Count = sum(Count)) %>%
  ungroup() %>%
  #販売状況をSallsに変更
  rename("Salls" = 販売状況) %>%
  #販売状況を因子化
  mutate(Salls = factor(Salls, c("販売中", "販売休止中", "チェックなし"))) %>%
  #全出現数,機能性関与成分名,販売状況で並び替え
  arrange(desc(All_Count), desc(Component), Salls) %>%
  #機能性関与成分名を因子化
  mutate(Component = factor(Component,
                            unique(Component))) %>%
  group_by(Component) %>%
  #総出現数の降順で機能性関与成分名を基準にidを付与
  mutate(No = cur_group_id()) %>%
  ungroup() -> PlotData

#ggplot2で上位15をプロット
ggplot(data = filter(PlotData, No <= 15),
       aes(x = Component, y = Count, fill = Salls)) +
  geom_bar(stat = "identity") +
  labs(x = "&#19978;&#20301;15&#12398;&#27231;&#33021;&#24615;&#38306;&#19982;&#25104;&#20998;", fill = "&#36009;&#22770;&#29366;&#27841;") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

###上位15の届出者名#####
#データを準備
Function_Food %>%
  select(届出者名, 販売状況) %>%
  rename("Company" = 届出者名, "Salls" = 販売状況) %>%
  group_by(Company, Salls) %>%
  summarize(Count = n(), .groups = "keep") %>%
  ungroup() %>%
  group_by(Company) %>%
  mutate(All_Count = sum(Count)) %>%
  ungroup() %>%
  mutate(Salls = factor(Salls, c("販売中", "販売休止中", "チェックなし"))) %>%
  arrange(desc(All_Count), desc(Company),　Salls) %>%
  mutate(Company = factor(Company, unique(Company))) %>%
  group_by(Company) %>%
  mutate(No = cur_group_id()) %>%
  ungroup() -> PlotData

#ggplot2で上位15をプロット
ggplot(data = filter(PlotData, No <= 15 & Salls == "&#36009;&#22770;&#20013;"),
       aes(x = Company, y = Count, fill = Salls)) +
  geom_bar(stat = "identity") +
  labs(x = "&#19978;&#20301;15&#12398;&#23626;&#20986;&#32773;&#21517;", fill = "&#36009;&#22770;&#29366;&#27841;") +
  theme(axis.text.x = element_text(angle = 60, hjust = 1))