In syunsuke/repoco: report tool collection with templates

title_string <- paste0(target_name,"に於ける",report_theme,"")

`r title_string`の取引総額の推移

取引総額の推移動向の概観

r title_stringの取引動向を概観するため、回帰分析曲線(モデルは出力メッセージ参照)、及び、各事例の描画を行うと以下の通りとなります。

\hspace{1cm}

# スムース曲線に事例ポイントを重ねる
target_data %>%
  mutate(q_label = retiex::style_quarter_date(t_date)) %>% 
  ggplot() +
  geom_smooth(mapping = aes(x = t_date, y = `取引総額`)) +
  # geom_smooth(mapping = aes(x = t_date, y = `取引総額`),
  #             method = "gam", formula = y ~ s(x, bs = "cs")) +
  geom_jitter(mapping = aes(x = t_date, y = `取引総額`, color = q_label), alpha = 0.5) +
  ggtitle(paste0(title_string,"の取引総額に関する動向")) + 
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_yen(v, 3, "千円")
                       }) +
  xlab(label = "取引時点（四半期毎）") +
  theme(legend.position = "none")

\newpage

四半期毎に集計された結果の分析

各種数値とその推移

######################################################
# 四半期毎の集計データの作成
######################################################
table_summary <- 
  target_data %>%
  retiex::retiex_summary() %>% 
  retiex::add_change_rate_diff_cols() %>% 
  dplyr::transmute(`取引時点` = retiex::style_quarter_date(date),
         `平均` = retiex::style_yen(mean, 3, "千円"),
         `平均の増減比` = retiex::style_percent(crd_mean, keta = 1, diff = T),
         `中央値` = retiex::style_yen(median, 3, "千円"),
         `中央値の増減比` = retiex::style_percent(crd_median, keta = 1, diff = T),
         `事例数` = format(count, scientific = F, big.mark = ","),
         `事例数の増減比` = retiex::style_percent(crd_count, keta = 1, diff = T), 
         `標準偏差` = retiex::style_yen(sd, 3, "千円"),
         `最小値` = retiex::style_yen(min, 3, "千円"),
         `第１四分位` = retiex::style_yen(qu1, 3, "千円"),
         `第３四分位` = retiex::style_yen(qu3, 3, "千円"),
         `最大値` = retiex::style_yen(max, 3, "千円"),
         ) %>% 
  dplyr::arrange(desc(`取引時点`))

######################################################
# 表の表示
######################################################
table_summary %>% 
  kableExtra::kbl(booktabs = T, 
      align = "r",
      caption = stringr::str_c(title_string, "の取引総額に関する各種数値")) %>%
  kableExtra::add_header_above(c(" ", "平均" = 2, "中央値" = 2, "事例件数" = 2)) %>%
  kableExtra::kable_styling(latex_options = c("striped", "scale_down", "hold_position"))

\hspace{1cm}

# 平均を含むデータ
mean_data <- target_data %>% 
  dplyr::mutate(q_date = factor(retiex::style_quarter_date(t_date))) %>% 
  dplyr::group_by(q_date) %>% 
  dplyr::summarise(m = mean(`取引総額`))

# 箱ひげ　プラス　平均ラインの上書き
target_data %>%
  dplyr::mutate(q_date = factor(retiex::style_quarter_date(t_date))) %>% 
  ggplot() +
  geom_boxplot(mapping = aes(x = q_date, y = `取引総額`), 
               varwidth = TRUE) +

  #平均表示の重ね書き
  geom_point(data = mean_data, mapping = aes(x = q_date, y = m), 
             color = "red", shape = 4) +
  geom_line(data = mean_data, 
            mapping = aes(x = q_date, y = m, group = 1), 
            color = "blue") +

  # 以下は同じ処理
  ggtitle(paste0(title_string,"の取引総額の推移"))+
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_yen(v, 3, "千円")
                       }) +
  xlab(label = "取引時点") +
  theme(axis.text.x = element_text(angle = 40, hjust = 1))

\newpage

各期間毎の分布と対前期間増減比の推移

# バイオリンプロット  
target_data %>%
  dplyr::mutate(q_date = factor(retiex::style_quarter_date(t_date))) %>% 
  ggplot() +
  geom_violin(mapping = aes(x = q_date, y = `取引総額`))+
  ggtitle(paste0(title_string,"の取引総額の分布"))+
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_yen(v, 3, "千円")
                       }) +
  xlab(label = "取引時点") + 
  theme(axis.text.x = element_text(angle = 40, hjust = 1))

\hspace{1cm}

# 増減比の折れ線グラフ

target_data %>%
  retiex::retiex_summary() %>% 
  retiex::add_change_rate_diff_cols() %>% 
  dplyr::mutate(q_date = factor(retiex::style_quarter_date(date))) %>% 
  dplyr::group_by(q_date) %>% 

  ggplot() +
  geom_line(mapping = aes(x = q_date, y = crd_mean, group = 1), 
            color = "red") +
  geom_hline(yintercept = 0) +

  # 以下は同じ処理
  ggtitle(paste0(title_string,"の取引総額平均の増減比"))+
  xlab(label = "取引時点") +
  ylab(label = "増減比") +
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_percent(v, 1, T)
                       }) +
  theme(axis.text.x = element_text(angle = 40, hjust = 1))

\newpage

1年を１周期として四半期毎に移動集計された結果について

各種数値とその推移

######################################################
# 1年を１周期として集計したデータの作成
######################################################
table_rolling_summary <- 
  target_data %>%
  retiex::retiex_rolling_summary() %>% 
  retiex::add_change_rate_diff_cols() %>% 
  dplyr::transmute(`取引時点` = retiex::style_rolling_term_quarter(date),
         `平均` = retiex::style_yen(mean, 3, "千円"),
         `平均の増減比` = retiex::style_percent(crd_mean, keta = 1, diff = T),
         `中央値` = retiex::style_yen(median, 3, "千円"),
         `中央値の増減比` = retiex::style_percent(crd_median, keta = 1, diff = T),
         `事例数` = format(count, scientific = F, big.mark = ","),
         `事例数の増減比` = retiex::style_percent(crd_count, keta = 1, diff = T), 
         `標準偏差` = retiex::style_yen(sd, 3, "千円"),
         `最小値` = retiex::style_yen(min, 3, "千円"),
         `第１四分位` = retiex::style_yen(qu1, 3, "千円"),
         `第３四分位` = retiex::style_yen(qu3, 3, "千円"),
         `最大値` = retiex::style_yen(max, 3, "千円"),
         ) %>% 
  dplyr::arrange(desc(`取引時点`))

######################################################
# 表の表示
######################################################
table_rolling_summary %>% 
  kableExtra::kbl(booktabs = T, 
      align = "r",
      caption = stringr::str_c(title_string, "の各種数値")) %>%
  kableExtra::add_header_above(c(" ", "平均" = 2, "中央値" = 2, "事例件数" = 2)) %>%
  kableExtra::kable_styling(latex_options = c("striped", "scale_down", "hold_position"))

\hspace{1cm}

# 平均を含むデータ
mean_data <- 
  target_data %>%
  retiex::retiex_rolling_summary() %>% 
  dplyr::mutate(factor_date = 
           factor(retiex::style_rolling_term_quarter(date)))

# 箱ひげ　プラス　平均ラインの上書き
target_data %>%
  retiex::transform_quarter_rolling_format(t_date) %>% 
  dplyr::mutate(factor_date = 
           factor(retiex::style_rolling_term_quarter(roll_label))) %>% 

  ggplot() +
  geom_boxplot(mapping = aes(x = factor_date, y = `取引総額`), 
               varwidth = TRUE) +

  #平均表示の重ね書き
  geom_point(data = mean_data, mapping = aes(x = factor_date, y = mean), 
             color = "red", shape = 4) +
  geom_line(data = mean_data, 
            mapping = aes(x = factor_date, y = mean, group = 1), 
            color = "blue") +

  # 以下は同じ処理
  ggtitle(paste0(title_string,"の取引総額の推移"))+
  xlab(label = "取引時点") +
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_yen(v, 3, "千円")
                       }) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

\newpage

各期間毎の分布と対前期間増減比の推移

# バイオリンプロット  
target_data %>%
  retiex::transform_quarter_rolling_format(t_date) %>% 
  dplyr::mutate(factor_date = 
           factor(retiex::style_rolling_term_quarter(roll_label))) %>% 
  ggplot() +
  geom_violin(mapping = aes(x = factor_date, y = `取引総額`))+
  ggtitle(paste0(title_string,"の取引総額の分布"))+
  xlab(label = "取引時点") + 
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_yen(v, 3, "千円")
                       }) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

\hspace{1cm}

# 増減比の折れ線グラフ
target_data %>%
  retiex::retiex_rolling_summary() %>% 
  retiex::add_change_rate_diff_cols() %>% 
  dplyr::mutate(q_date = factor(retiex::style_rolling_term_quarter(date))) %>% 
  ggplot() +
  geom_line(mapping = aes(x = q_date, y = crd_mean, group = 1), 
            color = "red") +
  geom_hline(yintercept = 0) +

  # 以下は同じ処理
  ggtitle(paste0(title_string,"の取引総額移動平均の増減比"))+
  xlab(label = "取引時点") +
  ylab(label = "増減比") +
  scale_y_continuous(labels =
                       function(v){
                         retiex::style_percent(v, 1, T)
                       }) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))