library(dplyr)
library(ggplot2)
library(patchwork)
install.packages("ggiraph")
library(ggiraph)
# Load the data
dat <- gapminder::gapminder %>% # gapminderとは、国ごとの人口、GDP、寿命などのデータを提供するパッケージ # year, continent, country, lifeExp, pop, gdpPercap # このデータは、1952年から2007年までの各国の人口、GDP、寿命などを提供している janitor::clean_names() %>% # janitor::clean_names() は、データフレームの列名を小文字に変換する mutate( # ID that is shared for boxplots (this one uses factors, i.e. numbers, as ID instead of continents) id = as.numeric(continent), # continentを数値に変換してidに代入している continent = forcats::fct_reorder(continent, life_exp) # forcats::fct_reorder() は、ファクターのレベルを再配置する # ここでは、continentをlife_expの値に基づいて再配置している # つまり、life_expの値が大きい順にcontinentを並べ替えている )
color_palette <- thematic::okabe_ito(5)
# thematic::okabe_ito() は、カラーパレットを返す関数
# ここでは、5色のカラーパレットを取得している
names(color_palette) <- unique(dat$continent)
# names() は、ベクトルの要素に名前を付ける関数
# ここでは、color_paletteにcontinentの名前を付けている
base_size <- 24 # Base font size
mean_life_exps <- dat %>% group_by(continent, year, id) %>% summarise(mean_life_exp = mean(life_exp)) %>% mutate(mean_text = glue::glue('In {year}, the mean life expectancy in\n{continent} was {scales::number(mean_life_exp, accuracy = 0.01)}')) # \n は改行を表す # {}には、変数を埋め込むことができる # scales::number() は、数値を指定した精度でフォーマットする関数 # accuracy = 0.01 は、小数点以下2桁まで表示することを意味する
line_chart <- mean_life_exps %>% ggplot(aes(x = year, y = mean_life_exp, col = continent, data_id = id)) + # data_id は、ggiraphで使用するためのデータID、つまり、ツールチップやクリックイベントを設定するためのID # ツールチップやクリックイベントとは、マウスをホバーしたときに表示される情報や、クリックしたときに表示される情報のこと geom_line_interactive(linewidth = 2.5) + # geom_line_interactive() は、ggiraphで対話的な線グラフを描画する関数 geom_point_interactive(size = 6, aes(tooltip = mean_text)) + # tooltip は、ツールチップに表示する情報を指定する theme_minimal(base_size = base_size) + # base_size は、フォントサイズを指定する labs( x = element_blank(), # x軸のラベルを非表示にする y = 'Life expectancy (in years)', # y軸のラベルを設定する title = 'Life expectancy over time' # グラフのタイトルを設定する ) + theme( text = element_text( # テキストの色を設定する color = 'grey20' ), legend.position = 'none', # 凡例を非表示にする panel.grid.minor = element_blank(), # グリッド線を非表示にする plot.title.position = 'plot' # タイトルを中央に配置する ) + scale_color_manual(values = color_palette) # カラーパレットを設定する
selected_year <- 2007
box_stats <- dat %>% filter(year == selected_year) %>% group_by(continent) %>% summarise( n = n(), # n() は、グループ内の行数を返す関数 iqr = IQR(life_exp) %>% round(2), # IQR() は、四分位範囲を計算する関数 # round(2) は、小数点以下2桁まで表示する range = paste(range(life_exp) %>% round(2), collapse = ' - '), # range() は、最小値と最大値を返す関数 # paste() は、文字列を連結する関数 # collapse = ' - ' は、連結するときに区切り文字として' - 'を使用することを意味する mean = mean(life_exp) %>% round(2) )
box_plot <- dat %>% filter(year == selected_year) %>% full_join(box_stats) %>% # full_join() は、2つのデータフレームを結合する関数 ggplot(aes(x = life_exp, y = continent, fill = continent, data_id = id)) + geom_boxplot_interactive( # geom_boxplot_interactive() は、ggiraphで対話的な箱ひげ図を描画する関数 aes( tooltip = glue::glue( ' {levels(dat$continent)[continent]}\n {n} Countries\n Mean life expectancy: {mean}\n Range: {range}\n IQR: {iqr} ' ), onclick = glue::glue('window.open("http://en.wikipedia.org/wiki/{levels(dat$continent)[continent]}")') # onclick は、クリックしたときに実行するJavaScriptコードを指定する # ここでは、クリックしたときに、Wikipediaのcontinentのページを開くようにしている # levels() は、ファクターのレベルを返す関数、これはcontinentのレベルを取得している ), position = position_nudge(y = 0.25), # 位置を微調整する width = 0.5 # 箱ひげ図の幅を設定する ) + geom_point_interactive( aes(col = continent), position = position_nudge(y = -0.2), size = 11, shape = '|', # ポイントの形を設定する alpha = 0.75 ) + scale_fill_manual(values = color_palette) + scale_color_manual(values = color_palette) + labs( x = 'Life expectancy (in years)', y = element_blank(), title = glue::glue('Distribution of Life Expectancy in {selected_year}') ) + theme_minimal(base_size = base_size) + theme( text = element_text( color = 'grey20' ), legend.position = 'none', panel.grid.minor = element_blank(), plot.title.position = 'plot' )
ggiraph( ggobj = box_plot + plot_spacer() + line_chart + plot_layout(widths = c(0.45, 0.1, 0.45)), # ggobj は、ggiraphで対話的なグラフを描画するためのggplotオブジェクト # plot_spacer() は、プロットの間にスペースを挿入する関数 # plot_layout() は、プロットのレイアウトを設定する関数 options = list( # オプションを設定する opts_hover_inv(css = "opacity:0.1;"), # ホバー時の透明度を設定する opts_tooltip(offx = 0, offy = 0, css = 'font-size: larger;') # ツールチップのオフセットとCSSを設定する ), hover_css = "", # ホバー時のCSSを設定する height_svg = 9, # SVGの高さを設定する width_svg = 16 # SVGの幅を設定する
)

# 変数の中身のユニークな値を確認する ----
unique(mpg$drv)
# 出現頻度を確認する
table(mpg$drv)
head(mpg$drv)
summary(mpg$drv)
# 全体確認 ----
skim(dat)
# チラ見 ----
glimpse(dat)

# 現状把握
version()
library(pkgbuild)
has_rtools(debug = TRUE)
sessionInfo()

install.packages("oskeyring")
library(gitcreds) # gitcredsパッケージを読み込む
gitcreds_list() # 登録されている認証情報を確認
gitcreds_delete(url = "https://github.com")　
# 登録されている認証情報を削除
Sys.unsetenv("GITHUB_PAT")　# GITHUB_PATを削除。空で帰る場合には問題解決。
# 公開リポジトリのインストールには認証は不要：
# corrmorantは公開リポジトリなので、認証なしでインストールできます。
# そのため、環境変数GITHUB_PATやシステムの資格情報ストアに認証情報が設定されていない状態が望ましいです。
# remotes::install_github("r-link/corrmorant", auth_token = NULL, force = TRUE)
# 特定のバージョンのggplot2をインストール
renv::install("ggplot2@3.3.6")

# LIBRARIES ----
library(broom)
library(ggfortify)
library(plotly)
library(tidyverse)
# DATA ----
mpg
# DATA WRANGLING ----
# - dplyr is covered in DS4B 101-R Weeks 2 & 3
# * Extract Target (Y) ----
y_tbl <- mpg %>% select(manufacturer, model) %>% mutate(vehicle = str_c(manufacturer, "_", model)) %>% # str_c() で文字列を連結 rowid_to_column() # rowid_to_column() で行番号を追加
y_tbl
# * Encode Features (X) ----
x_tbl <- mpg %>% # Get features for consideration select(displ:class) %>% # Add Row ID to maintain order rowid_to_column() %>% # One Hot Encode: transmission mutate( trans_auto = str_detect(trans, "auto") %>% as.numeric(), trans_man = str_detect(trans, "man") %>% as.numeric() # str_detect() で文字列に特定の文字列が含まれているかを判定 # as.numeric() でTRUE/FALSEを1/0に変換 # auto or manualに分類。Binary列を各々で作成。= one hot encode ) %>% select(-trans) %>% # One Hot Encode: drv mutate(val_drv = 1) %>% # まず元々のデータテーブルにval_drv列を追加する。 # val_drv に1を代入。すべての行に1を代入することで、後でpivot_wider()でワイド形式に変換する際に、NAを0で埋めることができる。 pivot_wider( names_from = drv, # names_from でカラム名を指定 # 例えば、drv列には、"f" "4" "r"、という3通りの文字列を持つ。 # この文字列をそれぞれ列名として指定する。 # 行数は変更されていないため、増えた列数（"f" "4" "r"）に対して、該当する場合には1、そうでない場合には0になるように設定している。 values_from = val_drv, # values_from で値を指定 # ここでは、val_drv列の値（1）を指定している。 # これにより、各行のdrv列の値に対応する列に1が代入される。 values_fill = 0, # values_fill でNAを0で埋める names_prefix = "drv_" # names_prefix でカラム名の接頭辞を指定 ) %>% # pivot_wider() でワイド形式に変換 # names_from でカラム名を指定 # values_from で値を指定 # values_fill でNAを0で埋める # names_prefix でカラム名の接頭辞を指定 # One Hot Encode: class mutate(val_class = 1) %>% pivot_wider( names_from = class, values_from = val_class, values_fill = 0, names_prefix = "class_" ) %>% # One Hot Encode: fl mutate(val_fl = 1) %>% pivot_wider( names_from = fl, values_from = val_fl, values_fill = 0, names_prefix = "fl_" )
x_tbl %>% glimpse()
# PCA ----
# - Modeling the Principal Components
# - Modeling & Machine Learning is covered in DS4B 101-R Week 6
fit_pca <- prcomp( # prcomp() で主成分分析を実行 # 主成分分析は、多変量データの次元を削減するための手法。 # 主成分分析を行うことで、データの特徴を抽出し、データの構造を理解することができる。 # 主成分分析は、データの分散が最大となる方向を見つけ、その方向を主成分として抽出する。 # 分散が最大となる変数を見つけるという事ですか? はい、その通りです。 # その組み合わせは自動で全通りを調べてくれるという事ですか？ はい、その通りです。 # なぜ分散が最大となる組合せを考えますか？ それは、データの情報を最大限に保持するためです。 # データの情報を最大限に保持するとはどういう意味ですか？ それは、データの特徴を最大限に抽出することです。 # 分散が大きい成分：データの主要な変動を表す。重要な情報が含まれているので保持する。 # 分散が小さい成分：データの変動が小さいため、その成分はデータの説明にはあまり寄与しない。したがって、無視しても良い。 # これにより、PCAは次元削減を行いながら、データの本質的なパターンを保持できるようになります。 formula = ~ . - rowid, # formula で主成分分析の対象となる列を指定 # ~ . - rowid でrowid列を除いたすべての列を対象とする。 data = x_tbl, # data でデータを指定 # ここでは、x_tbl を指定している。 scale. = TRUE # scale. でデータをスケーリングするかを指定 # TRUE でスケーリングを行う。 # スケーリングを行うことで、主成分分析の結果がより正確になる。 # スケーリングとは、データの平均を0、標準偏差を1に変換すること。
)
fit_pca %>% head()
fit_pca %>% tidy() %>% view()
# tidy() で主成分分析の結果を整形
# 主成分分析の結果は、主成分の寄与率、主成分の累積寄与率、主成分の固有値、主成分の固有ベクトルなどが含まれる。
# pcとは何ですか？ 主成分のことです。
# rowは何を表していますか？ 主成分の番号を表しています。
# 主成分の番号は小さいところから順に何を表していますか？ 主成分の重要度を表しています。
# valueは何を表していますか？ 主成分の値を表しています。
# 主成分の値はわかりますが、元々のどの変数がどの変数に対して、重要度の高い変数なのかが分かりません。
# どうしたらわかりますか？ 主成分の固有ベクトルを見ることで、元々の変数がどの変数に対して、重要度の高い変数なのかが分かります。
# どうやって固有ベクトルを見ますか？ tidy()関数で固有ベクトルを見ることができます。
# fit_pca %>% tidy() %>% view() で固有ベクトルを見ることができます。
# 固有ベクトルとはvalueの値の事ですか？ はい、その通りです。
# rowとPCの番号の違いは何ですか？ rowは主成分の番号を表しています。PCは主成分の番号を表しています。
# VISUALIZE PCA ----
# - Visualization with ggplot is covered in DSRB 101-R Week 4
g <- autoplot( # autoplot() で主成分分析の結果を可視化 object = fit_pca, # object で主成分分析の結果を指定 x = 1, # x でx軸に使用する主成分の番号を指定 y = 2, # y でy軸に使用する主成分の番号を指定 # Labels data = y_tbl, # data でデータを指定 # ここでは、y_tbl を指定している。 label = TRUE, # label でラベルを表示するかを指定 label.label = "vehicle", # label.label でラベルに表示する列を指定 label.size = 3, # label.size でラベルのサイズを指定 # LOADINGS loadings.label = TRUE, # loadings.label で固有ベクトルを表示するかを指定 loadings.label.size = 7, # loadings.label.size で固有ベクトルのサイズを指定 scale = 0 # scale でスケールを指定
) + labs(title = "Visualizing PCA in R")+ theme_minimal()
g
plotly::ggplotly(g)

# 変数の中身のユニークな値を確認する
unique(mpg$drv)
# 出現頻度を確認する
table(mpg$drv)
head(mpg$drv)
summary(mpg$drv)

# 現状把握
version()
library(pkgbuild)
has_rtools(debug = TRUE)
sessionInfo()

install.packages("oskeyring")
library(gitcreds) # gitcredsパッケージを読み込む
gitcreds_list() # 登録されている認証情報を確認
gitcreds_delete(url = "https://github.com")　
# 登録されている認証情報を削除
Sys.unsetenv("GITHUB_PAT")　# GITHUB_PATを削除。空で帰る場合には問題解決。
# 公開リポジトリのインストールには認証は不要：
# corrmorantは公開リポジトリなので、認証なしでインストールできます。
# そのため、環境変数GITHUB_PATやシステムの資格情報ストアに認証情報が設定されていない状態が望ましいです。
# remotes::install_github("r-link/corrmorant", auth_token = NULL, force = TRUE)
# 特定のバージョンのggplot2をインストール
renv::install("ggplot2@3.3.6")

# LIBRARIES ----
library(tidyverse)
library(maps)
library(mapproj)
# 1.0 MAP DATA -----
?map_data()
# 2.0 WORLD MAP ----
# - ggplot is covered in DS4B 101-R Week 4
world_tbl <- map_data("world") %>% # map_data() で地図データを取得 as_tibble() # as_tibble() でデータをtibble型に変換
world_tbl
# * World Base ----
world_base <- world_tbl %>% ggplot() + geom_map( aes(long, lat, map_id = region), # aes() でx軸、y軸、map_idを指定 map = world_tbl, # map_id で地図データを指定 color = "gray80", fill = "gray30", size = 0.3 ) # geom_map() で地図をプロット
world_base
# * Ortho Projection ----
world_base + coord_map("ortho", orientation = c(39, -98, 0)) # coord_map() で地図の投影法を指定、"ortho" は正射投影法を指定。 # orientation で地図の中心を指定している。
# 3.0 STATE MAPS ----
# - ggplot is covered in DS4B 101-R Week 4
usa_tbl <- map_data("state") %>% as_tibble() # state はアメリカ合衆国の州の地図データを取得
usa_tbl %>% ggplot(aes(long, lat, map_id = region)) + geom_map( map = usa_tbl, color = "gray80", fill = "gray30", size = 0.3 ) + coord_map("ortho", orientation = c(39, -98, 0))
# 4.0 REPUBLICAN VOTING BY US STATE ----
# - dplyr is covered in DS4B 101-R Weeks 2 & 3
# - ggplot2 is covered in DS4B 101-R Week 4
# * Wrangle & Join Data (dplyr) ----
republican_voting_tbl <- maps::votes.repub %>% # maps::votes.repub はアメリカ合衆国の州ごとの共和党の投票率データ as_tibble(rownames = "state") %>% # as_tibble() でデータをtibble型に変換 select(state, `1976`) %>% # select() で必要な列を抽出 (state, 1976年の共和党の投票率) rename(repub_prop = `1976`) %>% # rename() で列名を変更 mutate(repub_prop = repub_prop / 100) %>% # mutate() で共和党の投票率を割合に変換 mutate(state = str_to_lower(state)) # mutate() で州名を小文字に変換 # str_to_lower() で文字列を小文字に変換
usa_voting_tbl <- usa_tbl %>% left_join(republican_voting_tbl, by = c("region" = "state")) # left_join() で地図データと共和党の投票率データを結合
usa_voting_tbl
# * Make Map (ggplot2) ----
usa_voting_tbl %>% ggplot(aes(long, lat, group = subregion)) + geom_map( aes(map_id = region), map = usa_tbl, color = "gray80", fill = "gray30", size = 0.3 ) + coord_map("ortho", orientation = c(39, -98, 0)) + geom_polygon(aes(group = group, fill = repub_prop), color = "black") + # geom_polygon() で共和党の投票率をプロット # fill で色を指定 # color で線の色を指定 scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0.5, labels = scales::percent) + # scale_fill_gradient2() で色のグラデーションを指定 # low で最小値の色を指定 # mid で中間値の色を指定 # high で最大値の色を指定 theme_minimal() + labs( title = "Voting Republican in 1976", x = "", y = "", fill = "" ) + theme( plot.title = element_text(size = 26, face = "bold", color = "red3"), legend.position = "bottom" )
# 日本の地図をよみこむ
# 必要なパッケージをインストール
install.packages("leaflet")
install.packages("geojsonio")
install.packages("dplyr")
# パッケージを読み込み
library(leaflet)
library(geojsonio)
library(dplyr)
# 日本全体のGeoJSONデータのURL
japan_geojson_url <- "https://raw.githubusercontent.com/dataofjapan/land/master/japan.geojson"
# GeoJSONデータを読み込み
japan_geojson <- geojson_read(japan_geojson_url, what = "sp")
# 東京都のデータのみを抽出
tokyo_geojson <- japan_geojson[japan_geojson$name == "東京都", ]
# 地図に東京都をハイライト
leaflet() %>% setView(lng = 139.6917, lat = 35.6895, zoom = 10) %>% addTiles() %>% addPolygons(data = tokyo_geojson, color = "red", weight = 2, fillOpacity = 0.5)
# 必要なパッケージをインストール
install.packages("leaflet")
install.packages("sf")
install.packages("rnaturalearth")
install.packages("rnaturalearthdata")
# パッケージを読み込み
library(leaflet)
library(sf)
library(dplyr)
library(rnaturalearth)
library(rnaturalearthdata)
# 日本の都道府県データを取得
japan_sf <- ne_states(country = "Japan", returnclass = "sf")
# データの属性名を確認
names(japan_sf)
# 東京都のデータを抽出
tokyo_sf <- japan_sf %>% filter(name == "Tokyo")
# 地図に日本全体を描画
leaflet() %>% addTiles() %>% addPolygons(data = japan_sf, color = "gray", weight = 1, fillOpacity = 0.5) %>% # 東京都を赤色でハイライト addPolygons(data = tokyo_sf, color = "red", weight = 2, fillOpacity = 0.7) %>% # 東京都にズーム setView(lng = 139.6917, lat = 35.6895, zoom = 7)

# 現状把握
version()
library(pkgbuild)
has_rtools(debug = TRUE)
sessionInfo()

install.packages("oskeyring")
library(gitcreds) # gitcredsパッケージを読み込む
gitcreds_list() # 登録されている認証情報を確認
gitcreds_delete(url = "https://github.com")　
# 登録されている認証情報を削除
Sys.unsetenv("GITHUB_PAT")　# GITHUB_PATを削除。空で帰る場合には問題解決。
# 公開リポジトリのインストールには認証は不要：
# corrmorantは公開リポジトリなので、認証なしでインストールできます。
# そのため、環境変数GITHUB_PATやシステムの資格情報ストアに認証情報が設定されていない状態が望ましいです。
# remotes::install_github("r-link/corrmorant", auth_token = NULL, force = TRUE)
# 特定のバージョンのggplot2をインストール
renv::install("ggplot2@3.3.6")

# LIBRARIES ----
library(modeltime)
library(tidymodels)
library(timetk)
library(tidyverse)
# DATA ----
# - Time Series Visualization - Covered in Module 02 of DS4B 203-R Time Series Course
walmart_sales_weekly　# this data is coming from the modeltime package.
walmart_sales_weekly %>% group_by(id) %>% plot_time_series(Date, Weekly_Sales, .facet_ncol = 2) # plot_time_series() 関数は、時系列データをプロットします。 # .facet_ncol = 2 は、2列でプロットすることを指定しています（グラフ画面）。 # Date がx軸、Weekly_Sales がy軸になっている。 # id ごとにプロットされている。
# 1.0 NESTING 101 ----
# - Nesting & Iteration - Covered in Week 5 of DS4B 101-R R for Business Course
# Nesting
data_nested <- walmart_sales_weekly %>% select(id, Date, Weekly_Sales) %>% nest(nested_column = -id) # nest() 関数は、データをネスト化します。 # -id でid列を除いたデータをネスト化している。 # ネスト化とは具体的には、データフレームの列をリストに変換することです。 # ここでは、id列を除いたデータをリストに変換しています。 # 実際には、nested_column という列にリスト（Date, Weekly_Sales列）が格納されています。
data_nested$nested_column # nested_column にはリストが格納されている。 # リストの中身は、Date, Weekly_Sales列が格納されている。
# Unnesting
data_nested %>% unnest(nested_column) # unnest() 関数は、ネスト化されたデータを元に戻します。
# 2.0 MULTIPLE ARIMA FORECASTS ----
# - Modeltime (ARIMA) - Covered in Module 8 of DS4B 203-R Time Series Course
# - Nesting, Functions, & Iteration - Covered in Week 5 of DS4B 101-R R for Business Course
# * Making Multiple ARIMA Models ----
model_table <- data_nested %>% # Map Fitted Models mutate(fitted_model = map(nested_column, .f = function(df) { # map() 関数は、リストの各要素に対して関数を適用します。 # .f = function(df) で関数を指定しています。ここでは、df にリストの各要素が格納されています。このdfはデータフレームです。 # dfという文字列は任意の文字列を記載できますか? はい、任意の文字列を記載できます。ここではdfと名付けたという事ですね。 # 実際の無名関数の役割は、{}に挟まれている内容ですね？ はい、{}に挟まれている内容が無名関数の内容です。 arima_reg(seasonal_period = 52) %>% # arima_reg() 関数は、ARIMAモデルを作成します。 # seasonal_period = 52 で季節性を指定しています。52週間の季節性を指定しています。 # つまり、週次データの季節性を指定しています。 # 週次データの季節性を指定することで、季節性を考慮したARIMAモデルを作成します。 # 週次データの季節性を考慮することで、より正確な予測が可能になります。 # なぜ52週ですか？年間のデータをとる為ですか？ はい、年間のデータを取るためです。 # その場合、なぜ48週間ではないのですか？ 52週間のデータを取ることで、年間のデータを取ることができます。 set_engine("auto_arima") %>% # set_engine() 関数は、モデルのエンジンを指定します。 # "auto_arima" で自動ARIMAモデルを指定しています。 # 自動ARIMAモデルは、ARIMAモデルのパラメータを自動的に決定します。 # つまり、ARIMAモデルのパラメータを手動で設定する必要がなくなります。 # 自動ARIMAモデルは、ARIMAモデルのパラメータを自動的に決定するため、モデルの作成が簡単になります。 # ARIMAとは何ですか？ ARIMAは、自己回帰和分移動平均モデルです。英語では、AutoRegressive Integrated Moving Average Modelです。 # 特徴は、時系列データの自己相関と季節性を考慮したモデルです。 # 自己相関とは、時系列データの過去のデータとの相関関係を指します。 # 過去のデータで何をしますか？ 過去のデータを使って、未来のデータを予測します。 fit(Weekly_Sales ~ Date, data = df) # fit() 関数は、モデルを学習します。 # Weekly_Sales ~ Date でWeekly_SalesをDateで回帰分析することを指定しています。 # data = df でデータフレームを指定しています。このdfはfunction()の引数で指定しているデータフレームです。 })) %>% # Map Forecasts mutate(nested_forecast = map2(fitted_model, nested_column, .f = function(arima_model, df) { # map2() 関数は、2つのリストの要素に対して関数を適用します。 # .f = function(arima_model, df) で関数を指定しています。ここでは、arima_model にARIMAモデル、df にリストの各要素が格納されています。このdfはデータフレームです。 modeltime_table( arima_model # modeltime_table() 関数は、モデルの予測を作成します。 # arima_model にARIMAモデルを指定しています。 ) %>% modeltime_forecast( h = 52, actual_data = df ) # modeltime_forecast() 関数は、モデルの予測を作成します。 # h = 52 で52週間の予測を指定しています。 # actual_data = df でデータフレームを指定しています。このdfはfunction()の引数で指定しているデータフレームです。 # つまり、52週間の予測を作成しています。未来のですか？ はい、未来のデータです。 }))
model_table
# * Unnest ----
model_table %>% select(id, nested_forecast) %>% unnest(nested_forecast) %>% group_by(id) %>% plot_modeltime_forecast(.facet_ncol = 2)

# LIBRARIES ----
library(tidyquant)
library(tidyverse)
library(broom)
# devtools::install_github("rstudio/fontawesome")
library(gt)
library(fontawesome)
library(htmltools)
# DATA ----
mpg
# 1.0 GROUP SPLIT ----
# - Turns a grouped data frame into an list of data frames (iterable)
# - Iteration & functions - Covered in Week 5 of DS4B 101-R
# Group Split
mpg %>% mutate(manufacturer = as_factor(manufacturer)) %>%　 # as_factor()でmanufacturer列をfactor型に変換 # factor型に変換することで、group_by()でグループ化した際に、グループごとにデータを分割しやすくなる。 group_by(manufacturer) %>% group_split() # group_split()でグループごとにデータを分割し、リスト形式で返す。 # この場合、manufacturer列でグループ化しているので、manufacturerごとにデータを分割している（各データはtibble型）。
# We can now iterate with map()
mpg %>% mutate(manufacturer = as_factor(manufacturer)) %>% group_by(manufacturer) %>% group_split() %>% map(.f = function(df) { # map()でリストの各要素に対して関数を適用 lm(hwy ~ cty, data = df) # ここでは、リストの各要素（データフレーム）に対してlm()関数を適用している。 # lm()関数は、線形回帰モデルを作成する関数。 # hwy ~ cty でhwyをctyで回帰分析することを指定している。 # data = df でデータフレームを指定している。 })
# 2.0 POWER OF BROOM ----
# - Tidy up our linear regression metrics with glance()
# - Modeling & Machine Learning - Covered in Week 6 of DS4B 101-R Course
hwy_vs_city_tbl <- mpg %>% mutate(manufacturer = as_factor(manufacturer)) %>% group_by(manufacturer) %>% group_split() %>% map_dfr(.f = function(df) { lm(hwy ~ cty, data = df) %>% glance() %>% # glance()で線形回帰モデルの統計量を取得 # 具体的には、r.squared, adj.r.squared, p.valueなどの統計量を取得している。 add_column(manufacturer = unique(df$manufacturer), .before = 1) # add_column()でデータフレームに列を追加 # manufacturer列を追加している。 # unique(df$manufacturer) でdfのmanufacturer列のユニークな値を取得している。 # .before = 1 でmanufacturer列を先頭に追加している。 })
# 3.0 SUPER AWESOME TABLE WITH GT PACKAGE ----
# Source: https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/
rating_stars <- function(rating, max_rating = 5) { # Function to create star ratings # rating: rating value # max_rating: maximum rating rounded_rating <- floor(rating + 0.5) # always round up # floor()で小数点以下を切り捨て、+0.5して四捨五入している。 # これにより、ratingの値を四捨五入している。 # 例えば、ratingが3.4の場合、3.4 + 0.5 = 3.9 となり、floor()で3に切り捨てられる。 stars <- lapply(seq_len(max_rating), function(i) { # lapply()で1からmax_ratingまでの数値に対して関数を適用 # ここでは、1からmax_ratingまでの数値に対して、以下の処理を行っている。 # seq_len(max_rating) で1からmax_ratingまでの数値を生成している。 # 生成した数値に対して、以下の処理を行っている。 if (i <= rounded_rating) { fontawesome::fa("star", fill= "orange") } else { fontawesome::fa("star", fill= "grey") } }) # iがrating以下の場合は、星を黄色で表示し、それ以外は灰色で表示する。 # これにより、ratingの値に応じて星の表示を変えている。 label <- sprintf("%s out of %s", rating, max_rating) # sprintf()で文字列をフォーマット. フォーマットとは、文字列の中に変数を埋め込むこと。 # ratingとmax_ratingを表示するための文字列を作成している。 # 例えば、ratingが3.4、max_ratingが5の場合、"3.4 out of 5" となる。 div_out <- div(title = label, "aria-label" = label, role = "img", stars) # div()でdiv要素を作成. divとは、HTMLの要素の一つで、他の要素をグループ化するために使用される。 # title, aria-label, role, starsを指定してdiv要素を作成している。 # title: ツールチップに表示されるテキスト # aria-label: 要素の役割を説明するための属性 # role: 要素の役割を指定するための属性 # stars: 星の表示 as.character(div_out) %>% # as.character()でdiv_outを文字列に変換 gt::html() # gt::html()でHTML要素を作成
}
hwy_vs_city_tbl %>% select(manufacturer, nobs, r.squared, adj.r.squared, p.value) %>% mutate(manufacturer = str_to_title(manufacturer)) %>% # str_to_title()で文字列をタイトルケースに変換 mutate(rating = cut_number(r.squared, n = 5) %>% as.numeric()) %>% # cut_number()で数値を指定した数のグループに分割 # ここでは、r.squaredを5つのグループに分割している。 # as.numeric()で数値型に変換 # これにより、r.squaredの値を5つのグループに分割している。 # 例えば、r.squaredが0.2の場合、1に分類される。# 0.4の場合、2に分類される。 # 分割基準は、0.2, 0.4, 0.6, 0.8。どのように分割されるかは、cut_number()関数のnで指定している。５等分の場合は、n=5。 mutate(rating = map(rating, rating_stars)) %>% # map()でrating列にrating_stars()関数を適用 arrange(desc(r.squared)) %>% # arrange()でデータを並び替え # desc()で降順に並び替え gt() %>% # gt()でgtオブジェクトを作成. gtオブジェクトとは、表を作成するためのオブジェクト。 tab_header(title = gt::md("__Highway vs City Fuel Mileage__")) %>% # tab_header()で表のヘッダーを設定 tab_spanner( label = gt::html("<small>Relationship Strength (hwy ~ cty)</small>"), columns = vars(r.squared, adj.r.squared, p.value) ) %>% # tab_spanner()で列のグループ化を行う # Relationship Strength (hwy ~ cty) というラベルを設定して、r.squared, adj.r.squared, p.valueをグループ化している。 # vars()で列を指定 fmt_number(columns = vars(r.squared, adj.r.squared)) %>% # fmt_number()で数値をフォーマット fmt_number(columns = vars(p.value), decimals = 3) %>% # 小数点以下3桁まで表示 tab_style( style = cell_text(size = px(12)), locations = cells_body( columns = vars(r.squared, adj.r.squared, p.value)) ) %>% # tab_style()でスタイルを設定 # cell_text()でセルのテキストのスタイルを設定 cols_label( manufacturer = gt::md("__MFG__"), nobs = gt::md("__#__"), r.squared = gt::html(glue::glue("<strong>R-Squared ", fontawesome::fa("arrow-down", fill = "orange"), "</strong>")), adj.r.squared = gt::md("__R-Squared (Adj)__"), p.value = gt::md("__P-Value__"), rating = gt::md("__Rating__") ) # cols_label()で列のラベルを設定 # gt::md()でマークダウンを設定 # gt::html()でHTMLを設定 # glue::glue()で文字列を結合 # fontawesome::fa()でフォントアイコンを設定 # fill = "orange"でアイコンの色をオレンジに設定 # これにより、列のラベルを設定している。 # 例えば、manufacturer列のラベルを"MFG"として設定している。 # R-Squaredのラベルを設定している。 # その他の列のラベルを設定している。 # これにより、表の列のラベルを設定している。

# LIBRARIES ----
library(tidyquant)
library(tidyverse)
# DATA ----
mpg
# PIVOTING DATA ----
# 1.0 Pivot Wider ----
# - Reshaping to wide format
mpg_pivot_table_1 <- mpg %>% group_by(manufacturer) %>% count(class, name = "n") %>% # class列の数をカウント。name = "n" でカウント結果をn列に格納。 ungroup() %>% pivot_wider( # wider formatに変換。横持ちデータ。クロス集計表。 names_from = class,　# class列の値を列に変換 values_from = n, # n列の値を取得 values_fill = 0　# NAを0で埋める )
# 2.0 Pivot Table ----
# - Making Summary "Pivot Tables"
mpg_pivot_table_2 <- mpg %>% pivot_table(　# クロス集計表を作成 .columns = class,　# class列を列に変換 .rows = manufacturer,　# manufacturer列を行に変換 .values = ~ n(),　# n()でカウント　# ~ はformulaの意味. formulaとは、関数の引数に渡す関数のこと。 fill_na = 0 # NAを0で埋める )
# - Using lists to capture complex objects
mpg %>% pivot_table( .rows = class, .values = ~ list(lm(hwy ~ displ + cyl - 1)) # ~ list(lm(hwy ~ displ + cyl - 1)) でlm()関数を使って回帰分析を行い、その結果をリストで取得. # この場合、class列の値ごとに回帰分析を行い、その結果をリストで取得している。 # このように、複雑なオブジェクトを取得する場合は、list()を使う。 # hwy ~ displ + cyl - 1 は、hwyをdisplとcylで回帰分析することを指定している。 )
# 3.0 Pivot Longer ----
# - Long format best for visualizations
mpg_long_summary_table <- mpg_pivot_table_1 %>% pivot_longer( # long formatに変換。縦持ちデータ。 cols = compact:subcompact, # compact列からsubcompact列までを変換(class列の中身) names_to = "class", # class列に変換 values_to = "value" # value列に変換.クロス集計表の中身であったvalueはvalue列を新たにさ作成、その値を入れる。 )
mpg_long_summary_table %>% ggplot(aes(class, manufacturer, fill = value)) + # class列をx軸、manufacturer列をy軸、value列をfillで色分け geom_tile() + # タイルを描画 geom_label(aes(label = value), fill = "white") + # fill = "white" でラベルの背景色を白に指定 # aes(label = value) でラベルにvalue列の値を表示 # geom_label() でラベルを描画 scale_fill_viridis_c() + # scale_fill_viridis_c() で色をviridisに指定 # viridisはカラーパレットの一つ theme_minimal() + # theme_minimal() でテーマをminimalに指定 labs(title = "Class by Auto Manufacturer") # labs(title = "Class by Auto Manufacturer") でタイトルを指定

# 1.0 BASIC USAGE ----
# * AVERAGE CITY FUEL CONSUMPTION BY VEHICLE CLASS ----
mpg %>% group_by(class) %>% summarise( across(cty, .fns = mean), # .fns = mean で平均値を計算 # .fns = とはfunctionの略 # across() で指定したカラムに対してfunctionを適用 .groups = "drop" # .groups = "drop" でgroup_by()の効果を無効化、つまり通常のテーブルに戻す。 # グループ化されたままにする場合（group_by()の効果を残す場合）、".groups = "keep""を指定。 # または、group_by()の代わりにgroup_by()の代わりにungroup()を使う。 # .group_by()を残してしまうと、その後の処理でエラーが発生することがある。 # group_by()の効果が残っていると、group_by()で指定したカラム以外のカラムを使うとエラーが発生する。 )
# * AVERAGE & STDEV CITY FUEL CONSUMPTION BY VEHICLE CLASS
mpg %>% group_by(class) %>% summarise( across(cty, .fns = list(mean = mean, stdev = sd)), .groups = "drop" # acrossはlist()で複数のfunctionを指定できる。（複数列の設定） # 列名はmeanとstdevになる。接頭辞のctyは自動で各列に付与される。 )
# * AVERAGE & STDEV CITY + HWY FUEL CONSUMPTION BY VEHICLE CLASS
mpg %>% group_by(class) %>% summarise( across(c(cty, hwy), .fns = list(mean = mean, stdev = sd)), .groups = "drop" # 複数変数も指定可能 )
# 2.0 ADVANCED ----
# * CUSTOMIZE NAMING SCHEME ----
mpg %>% group_by(class) %>% summarise( across( c(cty, hwy), .fns = list(mean = mean, stdev = sd), .names = "{.fn} {.col} Consumption" # .names = "{.fn} {.col} Consumption" で列名をカスタマイズ # Consumptionは固定 # .fn はfunction名、.col は列名 # .fnsはlist()で指定する。複数のfunctionを指定できる。 # この場合、列名は "mean cty Consumption" と "stdev cty Consumption" になる。 ), .groups = "drop" ) %>% rename_with(.fn = str_to_upper) # rename_with() で列名を大文字に変換 # str_to_upper() で大文字に変換 # rename_with(.fn = str_to_upper) で全ての列名を大文字に変換 # .fn はfunction名。functionとは、列名を変更するfunctionを指定する。
# * COMPLEX FUNCTIONS ----
mpg %>% group_by(class) %>% summarise( across( c(cty, hwy), .fns = list( "mean" = ~ mean(.x),　# ~ はfunction(無名関数)の略. .x は列名。ここではc()で指定した列名。 "range lo" = ~ (mean(.x) - 2*sd(.x)), # 平均値から2標準偏差を引いた値（下限）。全データの95%がこの範囲に収まる。 "range hi" = ~ (mean(.x) + 2*sd(.x)) # 平均値から2標準偏差を足した値（上限）。全データの95%がこの範囲に収まる。 ), .names = "{.fn} {.col}" # 列名をカスタマイズ ), .groups = "drop" ) %>% rename_with(.fn = str_to_upper)