SQLを学ぼう(Rで)

※同じ処理のdplyrでの書き方を追記しました。(2022.01.15.)

はじめに

この記事は「Rは使っている、もしくは学習中であるが、SQLにはなじみがないデータサイエンティスト志望」の方を主な読者と想定しています。

データサイエンティストに求められるスキルとして、RやPythonによる分析技能と並んで、SQLによるデータ処理技能がよく取り上げられます。

データベースに蓄積された大規模データから、分析に必要なデータをSQLを使って集計、抽出するところからデータサイエンティストの仕事は始まります。 そのためSQLが使えないとそもそも仕事が始まらないのです。

しかし、SQLはRのように簡単に独習できるものではありません。(個人の感想です。) というのは、SQLを学ぶ前にデータベースの構築という壁が立ちはだかるからです。

多くのSQL入門と題した書籍やサイトでは、まずデータベースの構築から始まります。

MySQLなりPostgreSQLなりをインストールして、環境を設定して、テーブルを作って…… といった具合で、なかなかデータの抽出までたどり着きません。

そこでRの出番です。 RとRStudioを使えば簡単にSQLの学習環境を構築でき、すぐにSQLを学べます。

今回扱うこと、扱わないこと

今回扱うのはRStudioでSQLを走らせる方法とSQLによる分析のためのデータ抽出の基礎です。 Rとデータベースの連携では、dbplyrなどによってSQLを書かずにRからデータベースを操作し、結果をそのままRで処理できるのが真骨頂なのですが、今回は扱いません。またの機会に。

RとRStudioを使ったSQL学習環境の構築

RとRStudioはインストール済みであるものとします。

RSQLiteパッケージのインストール

まず、RにRSQLiteパッケージをインストールします。

install.packages("RSQLite")

RSQLiteパッケージはパブリックドメインのデータベースであるSQLiteをRから操作するためのパッケージです。 このパッケージをRに入れるだけであっという間に学習環境の完成です。

練習用サンプルデータの準備

データベースができても中身が無ければ練習できません。 ここでは公開されているデータベースのサンプルデータchinook(ちぬーく)を使います。 これもRから簡単にダウンロードして使える状態になります。

これはSQLite Tutorialというサイトで配布されているものです。

download.file("https://www.sqlitetutorial.net/wp-content/uploads/2018/03/chinook.zip",
              destfile = "chinook.zip")
unzip("chinook.zip")

これでワーキング・ディレクトリにサンプルデータが展開されます。 このデータセットは音楽のダウンロード販売サイトを模した人工データセットです。

RStudioでSQLを書く

あと一歩で完了です。 RStudioの左上の新規作成ボタンから SQL Scriptを選びます。

f:id:bob3:20220109173714p:plain
SQLスクリプトの新規作成

そうするとこんなファイルが開きます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite())

SELECT 1

この1行目のお尻に , "chinook.db"を書き加えます。 今回のサンプルデータベースのファイル名です。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")

SELECT 1

これで準備完了です。

試しにSQLを実行してみましょう。 以下のように書いたら適当な名前を付けて保存します。 次に右上のPreviewボタンを押します。

f:id:bob3:20220109174031p:plain
プレビューボタン

そうすると、下のSQL Resultsにデータの抽出結果が現れます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
FROM
  tracks
WHERE
  Composer = "Queen"

f:id:bob3:20220109152131p:plain
SQL実行結果
このように表示されれば成功です。

SELECT文を学ぼう

さて、ここからがSQLの勉強です。 今回はデータベースから必要なデータを抽出する命令であるSELECT文の基礎を学びましょう。

サンプルデータについて

今回扱うサンプルデータchinookについて簡単に説明します。 このデータは音楽のダウンロード販売サイトを模した人工データセットで、13個のテーブルが含まれます。 SQLにおけるテーブルとはRのデータフレームのようなものと理解してください。

以下が各テーブルの簡単な説明です。フィールドとはデータフレームにおける変数、カラムのことです。

  1. "albums":
    • 音楽のアルバムのリスト。
    • フィールド:AlbumId, Title, ArtistId
  2. "artists"
    • アーティスト名のリスト
    • フィールド:ArtistId, Name
  3. "customers"
    • 顧客のデータ
    • フィールド:CustomerId, FirstName, LastName, Company, Address, City, State, Country, PostalCode, Phone, Fax, Email, SupportRepId
  4. "employees"
    • 従業員のデータ
    • フィールド:EmployeeId, LastName, FirstName, Title, ReportsTo, BirthDate, HireDate, Address, City, State, Country, PostalCode, Phone, Fax, Email
  5. "genres"
    • 音楽ジャンル
    • フィールド:GenreId, Name
  6. "invoice_items"
    • 請求書の項目
    • フィールド:InvoiceLineId, InvoiceId, TrackId, UnitPrice, Quantity
  7. "invoices"
    • 請求書の詳細
    • フィールド:InvoiceId, CustomerId, InvoiceDate, BillingAddress, BillingCity, BillingState, BillingCountry, BillingPostalCode, Total
  8. "media_types"
    • メディアのタイプ
    • フィールド:MediaTypeId, Name
  9. "playlist_track"
    • プレイリストに含まれる楽曲
    • PlaylistId, TrackId
  10. "playlists"
    • プレイリスト
    • PlaylistId, Name
  11. "tracks"
    • 楽曲のリスト
    • TrackId, Name, AlbumId, MediaTypeId, GenreId, Composer, Milliseconds, Bytes, UnitPrice,

テーブル間の関係についてはこちらのpdfを参照してください。

f:id:bob3:20220109174500p:plain
chinook_er

SELECTとFROM

SELECT文のもっとも基本的な形は SELECT フィールド名 FROM テーブル名 です。 FROMでデータが収められているテーブルを指定し、SELECTで抽出するフィールドを指定します。 dplyrならテーブル名 %>% select(フィールド名) と書くところです。 楽曲のリストであるテーブルtracksから、フィールドName(曲名)とComposer(作曲者)を抜き出すにはこう書きます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
FROM
  tracks

tracksをデータフレームだとするとdplyrだとこう書く処理です。

tracks %>%
  select(Name, Composer)

これを実行すると、SQL Resultsに曲名と作曲者のリストが出力されます。 フィールド名の部分には特定のフィールド名を指定しない*(ワイルドカード)も使えます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  *
FROM
  tracks

これを実行するとテーブルtracksに含まれるすべてのフィールドが出力されます。

WHEREによる条件付け

通常のデータ抽出では何らかの条件にそって、それに合ったデータのみを抜き出すことがほとんどでしょう。 そのような条件を指定する場合はWHEREを使います。 dplyrでいうところのfilterと同じ役割です。 ここでは作曲者がQueenである楽曲のみを抽出します。 Rと異なり、「等しい」を表す比較演算子=です。==ではありません。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
FROM
  tracks
WHERE
  Composer = "Queen"

dplyrだとこう。

tracks %>%
  select(Name, Composer) %>%
  filter(Composer == "Queen")

数値の条件も指定できます。 テーブルtracksには演奏時間がMillisecondsとしてミリ秒(1/1000秒)単位で格納されています。 これを使って、作曲者がQueenで5分以上の曲を抜き出してみましょう。 複数の条件はANDでつなぐことができます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer = "Queen"
  AND Milliseconds >= 5 * 60 * 1000

dplyrだとこう。

tracks %>%
  select(Name, Composer, Milliseconds) %>%
  filter(Composer == "Queen", Milliseconds >= 5 * 60 * 1000)

4分以上、5分以下ならこう……

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer = "Queen"
  AND Milliseconds <= 5 * 60 * 1000
  AND Milliseconds >= 4 * 60 * 1000

ですが、この場合区間で指定するBETWEENも使えます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer = "Queen"
  AND Milliseconds BETWEEN 4 * 60 * 1000 AND 5 * 60 * 1000

文字列を条件に使う場合は完全一致だけでなく、LIKEを使うことで任意の文字を含むもの(部分一致)という指定もできます。 %は「0文字以上の任意の文字列」を表し、_は「任意の1文字」を表します。 WHERE Composer LIKE "%Queen%" とすると、今度はQueenDavid Bowieとの共作曲も出てきました。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer LIKE "%Queen%"

dplyrだとこう。

tracks %>%
  select(Name, Composer, Milliseconds) %>%
  filter(grepl("Queen", Composer))
# greple()の代わりにstringr::str_detect()を使う手もある。

また、複数条件をORでつなげることもできます。 Queenの各メンバーが作曲した曲も抽出できるようにしましょう。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer == "Queen"
  OR Composer == "Brian May"
  OR Composer == "Roger Taylor"
  OR Composer == "Freddie Mercury"
  OR Composer == "John Deacon"

ちょっと長ったらしいですね。 この場合、INを使うと簡潔に書けます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds
FROM
  tracks
WHERE
  Composer IN ("Queen", "Brian May", "Roger Taylor", "Freddie Mercury", "John Deacon")

dplyrだとこう。

tracks %>%
  select(Name, Composer, Milliseconds) %>%
  filter(Composer %in% c("Queen", "Brian May", "Roger Taylor", "Freddie Mercury", "John Deacon"))

フィールドの加工

ところで、ミリ秒単位だとちょっと分かりにくいので千で割って秒単位にしたいです。 そんな時はSELECTの中でMilliseconds / 1000 と処理内容を書いて、さらにAS Secondsと新しいフィールド名を付ければOKです。 dplyrで言えばmutateやtransmuteに相当します。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds / 1000 AS Seconds
FROM
  tracks
WHERE
  Composer = "Queen"
  AND Milliseconds BETWEEN 4 * 60 * 1000 AND 5 * 60 * 1000

dplyrだとこう。

tracks %>%
  select(Name, Composer, Milliseconds) %>%
  filter(Composer == "Queen", Milliseconds >= 4 * 60 * 1000, Milliseconds <= 5 * 60 * 1000) %>%
  mutate(Seconds = Milliseconds / 1000) %>%
  select(!Milliseconds)

並び替え

また、演奏時間が長い順に並べ替えたいです。 並べ替えはORDER BYに並べ替えに使うフィールドを指定して行います。 デフォルトは昇順で、降順にしたいときはフィールド名の後ろにDESCを付けます。 dplyrで言えばarrangeですね。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  Name
  , Composer
  , Milliseconds / 1000 AS Seconds
FROM
  tracks
WHERE
  Composer = "Queen"
  AND Milliseconds BETWEEN 4 * 60 * 1000 AND 5 * 60 * 1000
ORDER BY
  Seconds DESC

dplyrだとこう。

tracks %>%
  select(Name, Composer, Milliseconds) %>%
  filter(Composer == "Queen", Milliseconds >= 4 * 60 * 1000, Milliseconds <= 5 * 60 * 1000) %>%
  mutate(Seconds = Milliseconds / 1000) %>%
  select(!Milliseconds) %>%
  arrange(desc(Seconds))

テーブルの紐づけ

さて、テーブルtracksにはアーティスト名が入っていません。 どの曲がどのアーティストの曲なのか分かるようにしてみましょう。 テーブルartistsにはアーティスト名が入っていますが、そのままではテーブルtracksと紐づけられる情報がありません。 テーブルalbumsにはテーブルtracksと共通するフィールドAlbumIdがあり、またテーブルartistsと共通するフィールドArtistIdもあります。 この三つのテーブルを上手く紐づければ楽曲ごとのアーティスト名が分かるようになりそうです。

テーブル同士を紐づけるにはJOINを使います。 JOIN には INNER JOINLEFT JOINFULL OUTER JOINなどの種類がありますが、今回は紙幅の関係で説明を割愛します。 今回使う LEFT JOINExcelにおけるVLOOKUPと同じようなイメージです、

どのフィールドで紐づけるかはONで、テーブル名.フィールド名という形式で指定します。

dplyrでもそのままjoin系の関数がありますね。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  tracks.Name AS track_Name
  , albums.Title AS albums_Title
  , artists.Name AS artist_Name
FROM
  tracks
LEFT JOIN
  albums
  ON tracks.AlbumId = albums.AlbumId
LEFT JOIN
  artists
  ON albums.ArtistId = artists.ArtistId

これで楽曲名、アルバム名、アーティスト名が紐づきました。

dplyrだとこう。

tracks %>%
  rename(track_Name = Name) %>%
  left_join(albums, by = "AlbumId") %>%
  rename(albums_Title = Title) %>%
  left_join(artists, by = "ArtistId") %>%
  rename(artist_Name = Name) %>%
  select(track_Name, albums_Title, artist_Name)

また、WITHを使って以下のような書き方もできます。 WITHを使うと、Rで処理結果をいったんデータフレームに収めて利用するような書き方ができます。 対象となるテーブルが多かったり、処理が複雑になる場合はWITHを使った方が可読性が高くなります。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
WITH

-- WITHで一時的なテーブルtracks_albumsを作る。
tracks_albums AS (
  SELECT
    tracks.Name AS track_Name
    , albums.Title AS albums_Title
    , albums.ArtistId
  FROM
    tracks
  LEFT JOIN
    albums
    ON tracks.AlbumId = albums.AlbumId
)

SELECT
  tracks_albums.*
  , artists.Name AS artist_Name
FROM
  tracks_albums
LEFT JOIN
  artists
  ON tracks_albums.ArtistId = artists.ArtistId

集計する

基本的な集計もSQLでできます。

dplyrでいうところのgroup_by、summariseですね。

ここではテーブルinvoicesから、取引の数と顧客の数を集計してみましょう。 数を数えるにはCOUNT関数を使います。 テーブル全体の数を数えるにはワールドカードを使ってCOUNT(*)と書きます。 顧客の数を数えるにはCOUNT(DISTINCT CustomerId)と書きます。 DISTINCT は重複した行を取り除く命令です。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  COUNT(*) AS deals
  , COUNT(DISTINCT CustomerId) AS num
FROM
  invoices

単に全体で集計するだけではつまらないので、年ごとの取引数、客数、売上を集計してみましょう。 取引の日付がフィールドInvoiceDate2009-09-11 00:00:00という形式で入っています。 ここから文字列の一部を切り出す命令substrを使って年の部分を抽出します。 (STRFTIME関数を使う手もあるが、SQLite独自の関数なので今回はより一般的なsubstrを紹介。) さらにGROUP BYで年ごとにグループ化して集計します。 売上はSUMで合計を出します。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  substr(InvoiceDate, 1, 4) AS year
  , COUNT(*) AS deals
  , COUNT(DISTINCT CustomerId) AS num
  , SUM(Total) AS Total
FROM
  invoices
GROUP BY
  year
ORDER BY 
  year

dplyrだとこう。

invoices %>%
  mutate(year = substr(InvoiceDate, 1, 4)) %>%
  select(year, CustomerId, Total) %>%
  group_by(year) %>%
  summarise(
    deals = n(),
    num = n_distinct(CustomerId),
    Total = sum(Total)
   ) %>%
  arrange(year)

こんどは月ごとの売上を集計してみましょう。 GROUP BYORDER BYには二つ以上のフィールドを指定できます。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
SELECT
  substr(InvoiceDate, 1, 4) AS year
  , substr(InvoiceDate, 6, 2) AS month
  , COUNT(*) AS deals
  , COUNT(DISTINCT CustomerId) AS num
  , SUM(Total) AS total
FROM
  invoices
GROUP BY
  year, month
ORDER BY 
  year, month

dplyrだとこう。

invoices %>%
  mutate(year = substr(InvoiceDate, 1, 4),
        month = substr(InvoiceDate, 6, 7)) %>%
  select(year, month, CustomerId, Total) %>%
  group_by(year, month) %>%
  summarise(
    deals = n(),
    num = n_distinct(CustomerId),
    Total = sum(Total)
   ) %>%
  arrange(year, month)

集計関数には他に平均を出すAVGや最大値を出すMAX、最小値を出すMINなどがあります。 月ごとの客数、客単価を出してみましょう。

-- !preview conn=DBI::dbConnect(RSQLite::SQLite(), "chinook.db")
WITH

t1 AS (
  SELECT
    substr(InvoiceDate, 1, 4) AS year
    , substr(InvoiceDate, 6, 2) AS month
    , CustomerId
    , SUM(Total) AS total
  FROM
    invoices
  GROUP BY
    year, month, CustomerId
)

SELECT
  year
  , month
  , COUNT(*) AS n
  , AVG(total) AS avg_total
FROM
  t1
GROUP BY
  year, month
ORDER BY 
  year, month

dplyrだとこう。

invoices %>%
  mutate(year = substr(InvoiceDate, 1, 4),
        month = substr(InvoiceDate, 6, 7)) %>%
  select(year, month, CustomerId, Total) %>%
  group_by(year, month, CustomerId) %>%
  summarise(Total = sum(Total), .groups = "drop") %>%
  group_by(year, month) %>%  
  summarise(n = n(), avg_total = mean(Total), .groups = "drop") %>%
  arrange(year, month)

Enjoy!

これでRを用いたSQLの学習環境構築とSQLの基礎の基礎は終わりです。 あとは各自でSQLの入門サイトや書籍を使って練習してみてください。

リンク集

以下、参考にしたサイトのリンク集です。

SQLiteLチュートリアル

Chinook Databaseを用いたSQLチュートリアル

RSQLite公式

Using SQL in RStudio

キング・クリムゾンのセットリストを分析する

動機

2021年最大の出来事といえばキング・クリムゾン(以下KC)の来日公演です。
2014年に現体制(公式の区分でいうところのKCVII)が結成されてから3回目の来日となりました。そして、これが最後の来日公演ともいわれています。
コロナ禍のために来日が危ぶまれていましたが、緊急事態宣言解除とオミクロン株による渡航制限発動の狭間で、奇跡の来日が実現しました。
本当に感謝しかありません。

私も東京の5公演に参加しましたが、本当に素晴らしいステージでした。

さて、現体制のKCの特徴として、公演ごとにころころと変わるセットリストがあります。
普通のミュージシャンであればツアー中に曲目や曲順を変えることはほとんどないと思いますが、KCは曲目も曲順も毎公演で変わります。
しかし、完全にランダムというわけではなく、ほぼ必ず演奏される曲があったり、この曲の後にはこの曲が演奏されやすい、といった
法則が見られます。

この点に注目されて2015年の来日公演時に id:nisshan_X さんがセットリストの分析をされていました。
nisshan-x.hatenablog.com

今回は現体制KCによる来日公演を含む以下の3回のツアーについて、同じようにR言語を用いて分析をしてみたいと思います。

  • The Elements of King Crimson Tour (以下2015)
  • Uncertain Times Tour (以下2018)
  • Music Is Our Friend Tour (以下2021)

分析結果

楽曲の登場頻度

まずはツアー毎にどんな曲が多く演奏されているかを見てみます。
ただし、ツアー毎に公演回数が異なるので、公演回数に対する演奏割合で見てみます。

Starlessが不動の一位。まあ、そうですよね。Level Fiveもずっと上位にいます。
Indiscipleneが2018,2021と上位に入っているのも注目です。80年代の曲ですが、現行体制を代表する1曲です。最もいまのクリムゾンらしい曲といっていいでしょう。

f:id:bob3:20211226171523p:plain
楽曲の登場頻度

どの曲とどの曲が同じ日に演奏されやすいか

曲と曲の組み合わせで、色が濃く円が大きい組み合わせがよく一緒に演奏される曲です。
これを見ると、2014はばらつきが大きく本当にどの曲が演奏されるか分からなかったのが、2018、2021ではある程度ほぼ決まって演奏される楽曲群とそれ以外のレア曲に明確に分かれるようになったのが分かりますj。

f:id:bob3:20211226173902p:plain
共起2015
f:id:bob3:20211226173929p:plain
共起2018
f:id:bob3:20211226173950p:plain
共起2021

曲順分析

最後に曲順の分析です。
ある曲の次にある曲が演奏される割合を矢印の上にパーセントで書いています。
都合上、20%以下のつながりは割愛しています。
曲名の背景がピンクは定番曲(演奏割合66%以上)、青はレア曲(同33%以下)、黄色はその中間(33%~66%)です。

2021の Picture of a city (冷たい街の情景)がハブになっている感じが面白いですね。

2015

f:id:bob3:20211226191830p:plain
曲順2015

2018

f:id:bob3:20211226191909p:plain
曲順2018

2021

f:id:bob3:20211226191945p:plain
曲順2021

まとめ

最後の来日公演なんて言わないでまた来てよー。

80年代~00年代の曲ももっと聴きたいよー!

分析過程

以下、R言語のコードを含む分析の過程です。

データの取得

まずはセットリストのデータの取得です。
ありがたいことに setlist.fm に有志が投稿したセットリストが載っていますので、ここから分析のためのデータを取得したいと思います。
APIも用意されているようですが、うまく情報の取得ができなかったため、ここではウェブスクレイピングを行います。

# パッケージの読み込み
library(tidyverse) # データ操作用
library(rvest) # ウェブスクレイピング
library(polite) # お行儀よくウェブスクレイピングするため

### setlist.fmからセットリストを抽出する関数を定義。

setlist_fm_scraping <- function(search_list) {
  scrape_fun <- function(x) {
    scrape(bow(x, user_agent = "King Crimson Tour Setlist Analysis"))
  }

  html_list <- map(search_list, scrape_fun)

  link_vec <- unlist(map(html_list, ~ {
    html_attr(html_nodes(., css = "a[href *= 'setlist/king-crimson/']"), "href")
  }))

  extract_setlist <- function(x) {
    html_text(html_nodes(scrape(bow(
      paste0("https://www.setlist.fm/", x), 
      user_agent = "King Crimson Tour Setlist Analysis"
    )), xpath = "//a[@class = 'songLabel']"))
  }

  setlists <- map(link_vec, extract_setlist)

  return(setlists)
}

### 各ツアー毎の検索結果ページを設定
pages <- 1:4
search_list_2021 <- map_chr(pages, ~ {
  paste0(
    "https://www.setlist.fm/search?page=",
    .,
    "&query=tour:%28Music+Is+Our+Friend+2021")
})

pages <- 1:6
search_list_2018 <- map_chr(pages, ~ {
  paste0(
    "https://www.setlist.fm/search?page=", 
    ., 
    "&query=king+crimson+Uncertain+Times+Tour")
})

pages <- 1:11
search_list_2014 <- map_chr(pages, ~ {
  paste0(
    "https://www.setlist.fm/search?page=", 
    ., 
    "&query=tour:%28the+elements+of+king+crimson%29")
})

### 各ツアーのセットリストを抽出
# 1ページ当たり5秒間隔なのでちょっと時間がかかります
setlist_2021 <- setlist_fm_scraping(search_list_2021)
setlist_2018 <- setlist_fm_scraping(search_list_2018)
setlist_2014 <- setlist_fm_scraping(search_list_2014)

### スクレイピングを繰り返さないでいいようにオブジェクトを保存しておく。
save(setlist_2021, setlist_2018, setlist_2014, file = "kc_setlist.RData")

前処理

分析を進める前に、見やすさのために長い曲名を短縮形にします。

library(tidyverse)

load("kc_setlist.RData")

# 長い曲名を短縮形に置換する関数。
song_name_shorten <- function(setlists) {
  res <- setlists %>%
    map(~ {str_replace_all(., pattern = "Larks' Tongues in Aspic, Part One", replacement = "LTIA1")}) %>%
    map(~ {str_replace_all(., pattern = "Larks' Tongues in Aspic, Part Two", replacement = "LTIA2")}) %>%
    map(~ {str_replace_all(., pattern = "21st Century Schizoid Man", replacement = "21CSM")}) %>%
    map(~ {str_replace_all(., pattern = "Devil Dogs of Tessellation Row", replacement = "Devil Dogs")}) %>%
    map(~ {str_replace_all(., pattern = "Hell Hounds of Krim", replacement = "Hell Hounds")}) %>%
    map(~ {str_replace_all(., pattern = "Fairy Dust of the Drumsons", replacement = "Fairy Dust")}) %>%
    map(~ {str_replace_all(., pattern = "One More Red Nightmare", replacement = "OMRN")}) %>%
    map(~ {str_replace_all(., pattern = "Suitable Grounds for the Blues", replacement = "Suitable")}) %>%
    map(~ {str_replace_all(., pattern = "The ConstruKction of Light", replacement = "TCOL")}) %>%
    map(~ {str_replace_all(., pattern = "The Court of the Crimson King", replacement = "ITCOTCK")}) %>%
    map(~ {str_replace_all(., pattern = "Radical Action III", replacement = "RA3")}) %>%
    map(~ {str_replace_all(., pattern = "Radical Action II", replacement = "RA2")}) %>%
    map(~ {str_replace_all(., pattern = "Radical Action \\(To Unseat the Hold of Monkey Mind\\)", replacement = "RA1")}) %>%
    map(~ {str_replace_all(., pattern = "Tony's Cadenza", replacement = "Tonys Cadenza")}) %>%
    map(~ {str_replace_all(., pattern = "Larks' Tongues in Aspic \\(Part IV\\)", replacement = "LTIA4")}) %>%
    map(~ {str_replace_all(., pattern = "Banshee Legs Bell Hassle", replacement = "Banshee Legs")}) %>%
    map(~ {str_replace_all(., pattern = "A Scarcity of Miracles", replacement = "Miracles")}) %>%
    map(~ {str_replace_all(., pattern = "Sailor's Tale", replacement = "Sailors Tale")}) %>%
    map(~ {str_remove_all(., '"')})
  return(res)
}

setlist_2021 <- song_name_shorten(setlist_2021)
setlist_2018 <- song_name_shorten(setlist_2018)
setlist_2014 <- song_name_shorten(setlist_2014)

これで準備万端です。

ツアー毎に多く演奏された曲Top20

集計して割り算して棒グラフに。

song_table <- function(setlist) {
  t1 <- bind_rows(
    as_tibble(table(unlist(setlist)), .name_repair = ~ c("song_name", "freq")),
    tibble(song_name = c("START", "END"), freq = length(setlist))
    )
  t1$per <- t1$freq / length(setlist)
  return(t1)
}

table_2021 <- song_table(setlist_2021)
table_2018 <- song_table(setlist_2018)
table_2014 <- song_table(setlist_2014)

all_table <- bind_rows(
  list("2021" = table_2021,
       "2018" = table_2018,
       "2014" = table_2014),
  .id = "year") %>%
  pivot_wider(names_from = year, values_from = freq, values_fill = 0) %>%
  pivot_longer(names_to = "year", cols=matches("\\d{4}"), values_to = "freq")

top20 <- all_table %>%
  filter(!song_name %in% c("START", "END")) %>%
  group_by(year) %>%
  arrange(desc(per)) %>%
  top_n(20)

g2014 <- top20 %>%
  filter(year == 2014) %>%
  ggplot(aes(x = reorder(song_name, per), y = per)) + 
  geom_bar(stat = "identity", position = "dodge", color="black", fill="red") +
  coord_flip() +
  labs(title="2014", x="曲目", y="演奏割合")

g2018 <- top20 %>%
  filter(year == 2018) %>%
  ggplot(aes(x = reorder(song_name, per), y = per)) + 
  geom_bar(stat = "identity", position = "dodge", color="black", fill="green") +
  coord_flip() +
  labs(title="2018", x="曲目", y="演奏割合")

g2021 <- top20 %>%
  filter(year == 2021) %>%
  ggplot(aes(x = reorder(song_name, per), y = per)) + 
  geom_bar(stat = "identity", position = "dodge", color="black", fill="blue") +
  coord_flip() +
  labs(title="2021", x="曲目", y="演奏割合")

library(gridExtra)
grid.arrange(g2014, g2018, g2021, nrow = 1)

楽曲の共起分析

どの曲とどの曲が同じ日に演奏されやすいか。
ここではコサイン類似度で一緒に演奏されやすさを見ている。

exaxt_cor <- function(setlist) {
  ref <- unique(reduce(setlist, c))
  res <- as.matrix(map_dfr(setlist, ~{setNames(as.integer(ref %in% .), ref)}))
  return(res)
  }
  
cor_2014 <- exaxt_cor(setlist_2014)
cor_2018 <- exaxt_cor(setlist_2018)
cor_2021 <- exaxt_cor(setlist_2021)

# コサイン類似度マトリクスで
library(lsa)
cm2014 <- cosine(cor_2014)
cm2018 <- cosine(cor_2018)
cm2021 <- cosine(cor_2021)

library(corrplot)
corrplot(cm2014, order="hclust", hclust.method="ward.D", addrect = 6)
corrplot(cm2018, order="hclust", hclust.method="ward.D", addrect = 7)
corrplot(cm2021, order="hclust", hclust.method="ward.D", addrect = 6)

曲順分析

ここはコードがだいぶ汚い……
セットリストからグラフのノードとエッジを設定しDOT言語のコードを吐き出す。

# セットリストのグラフ化
vec2graph <- function(x) {
  LEN <- length(x)
  data.frame(
    from = c("START", x),
    to = c(x, "END")
  )
}

# どのツアーか設定する
setlists <- setlist_2014
tb <- table_2014

# setlists <- setlist_2018
# tb <- table_2018

# setlists <- setlist_2021
# tb <- table_2021

setlist_df <- setlists %>%
  map_dfr(vec2graph) %>%
  group_by(from, to) %>%
  summarise(n = n()) %>%
  mutate(m = sum(n)) %>%
  ungroup() %>%
  mutate(per = round(n / m * 100, 0)) %>%
  select(from, to, per)

library(DiagrammeR)

nodes_df <- create_node_df(
  n = nrow(tb),
  type = "song",
  label = tb$song_name,
  shape = "ellipse",
  value = tb$per
)

for_edges_df <- setlist_df %>%
  left_join(nodes_df, by = c("from" = "label")) %>%
  left_join(nodes_df, by = c("to" = "label")) %>%
  select(id.x, id.y, per)

edges_df <- create_edge_df(
  from = for_edges_df$id.x,
  to = for_edges_df$id.y,
  rel = "a",
  width = for_edges_df$per
) %>%
  filter(width > 20) #ここでエッジの足切り

graph <- create_graph(
  nodes_df = nodes_df,
  edges_df = edges_df
) %>%
  set_edge_attrs(
    edge_attr = color,
    values = "blue"
  ) %>%
  set_edge_attrs(
    edge_attr = label,
    values = edges_df$width
  ) %>%
  set_edge_attrs(
    edge_attr = penwidth,
    values = edges_df$width / 10
  ) %>%
  set_edge_attrs(
    edge_attr = fontsize,
    values = 14) %>%
  set_node_attrs(
    node_attr = color,
    values = "blue"
  ) %>% 
  set_node_attrs(
    node_attr = fillcolor,
    values = case_when(
      nodes_df$value > 66 ~ "lightpink",
      nodes_df$value > 33 ~ "yellow",
      nodes_df$value > 0 ~ "lightblue",
      TRUE ~ "black"
    ) 
    ) %>%
  set_node_attrs(
    node_attr = fontcolor,
    values = "black") %>%
  set_node_attrs(
    node_attr = fontsize,
    values = 14) %>%
  set_node_attrs(
    node_attr = fixedsize,
    values = "false")

graph %>%
  render_graph()

graph %>%
  generate_dot() %>%
  cat()

ツアー毎にDOT言語で微調整し描画する。

2015
#2014
grViz(
  diagram = "
digraph {

graph [rankdir = TB,
       outputorder = 'edgesfirst',
       bgcolor = 'white']

node [fontname = 'Helvetica',
      fontsize = '10',
      shape = 'circle',
      fixedsize = 'true',
      width = '0.5',
      style = 'filled',
      fillcolor = 'aliceblue',
      color = 'gray70',
      fontcolor = 'gray50']

edge [fontname = 'Helvetica',
     fontsize = '8',
     len = '1.5',
     color = 'gray80',
     arrowsize = '0.5']

  '1' [label = '21CSM', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '2' [label = 'Banshee Legs', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '3' [label = 'Cirkus', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '4' [label = 'Coda: Marine 475', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '5' [label = 'Devil Dogs', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '6' [label = 'Easy Money', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '7' [label = 'Epitaph', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '8' [label = 'Fairy Dust', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '9' [label = 'Fracture', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '10' [label = 'Hell Hounds', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '11' [label = 'Heroes', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '12' [label = 'Hoodoo', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '13' [label = 'Indiscipline', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '14' [label = 'Interlude', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '15' [label = 'ITCOTCK', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '16' [label = 'Level Five', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '17' [label = 'Lizard', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '18' [label = 'LTIA1', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '19' [label = 'LTIA2', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '20' [label = 'Magic Sprinkles', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '21' [label = 'Meltdown', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '22' [label = 'Miracles', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '23' [label = 'OMRN', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '24' [label = 'Peace: An End', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '25' [label = 'Pictures of a City', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '26' [label = 'RA1', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '27' [label = 'RA2', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '28' [label = 'Red', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '29' [label = 'Sailors Tale', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '30' [label = 'Starless', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '31' [label = 'Suitable', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '32' [label = 'TCOL', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '33' [label = 'The Letters', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '34' [label = 'The Light of Day', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '35' [label = 'The Talking Drum', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '36' [label = 'VROOOM', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '37' [label = 'START', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false', style = 'bold,filled'] 
  '38' [label = 'END', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false', style = 'bold,filled'] 
'1'->'38' [color = 'blue', label = '95', penwidth = '9.5', fontsize = '14'] 
'2'->'6' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'3'->'9' [color = 'blue', label = '52', penwidth = '5.2', fontsize = '14'] 
'4'->'2' [color = 'blue', label = '21', penwidth = '2.1', fontsize = '14'] 
'4'->'22' [color = 'blue', label = '36', penwidth = '3.6', fontsize = '14'] 
'4'->'34' [color = 'blue', label = '21', penwidth = '2.1', fontsize = '14'] 
'5'->'15' [color = 'blue', label = '40', penwidth = '4', fontsize = '14'] 
'6'->'33' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'7'->'2' [color = 'blue', label = '28', penwidth = '2.8', fontsize = '14'] 
'8'->'17' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'8'->'24' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'9'->'33' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'10'->'32' [color = 'blue', label = '24', penwidth = '2.4', fontsize = '14'] 
'11'->'1' [color = 'blue', label = '94', penwidth = '9.4', fontsize = '14'] 
'12'->'1' [color = 'blue', label = '75', penwidth = '7.5', fontsize = '14'] 
'13'->'15' [color = 'blue', label = '43', penwidth = '4.3', fontsize = '14'] 
'14'->'33' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 
'15'->'1' [color = 'blue', label = '45', penwidth = '4.5', fontsize = '14'] 
'16'->'7' [color = 'blue', label = '26', penwidth = '2.6', fontsize = '14'] 
'17'->'27' [color = 'blue', label = '46', penwidth = '4.6', fontsize = '14'] 
'18'->'25' [color = 'blue', label = '71', penwidth = '7.1', fontsize = '14'] 
'19'->'30' [color = 'blue', label = '58', penwidth = '5.8', fontsize = '14'] 
'20'->'17' [color = 'blue', label = '29', penwidth = '2.9', fontsize = '14'] 
'21'->'10' [color = 'blue', label = '27', penwidth = '2.7', fontsize = '14'] 
'21'->'27' [color = 'blue', label = '23', penwidth = '2.3', fontsize = '14'] 
'23'->'30' [color = 'blue', label = '39', penwidth = '3.9', fontsize = '14'] 
'24'->'26' [color = 'blue', label = '26', penwidth = '2.6', fontsize = '14'] 
'25'->'3' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
'26'->'21' [color = 'blue', label = '100', penwidth = '10', fontsize = '14'] 
'27'->'16' [color = 'blue', label = '85', penwidth = '8.5', fontsize = '14'] 
'30'->'2' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 
'30'->'5' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'37'->'10' [color = 'blue', label = '24', penwidth = '2.4', fontsize = '14'] 
'37'->'18' [color = 'blue', label = '60', penwidth = '6', fontsize = '14'] 
'32'->'16' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
'33'->'29' [color = 'blue', label = '61', penwidth = '6.1', fontsize = '14'] 
'34'->'35' [color = 'blue', label = '48', penwidth = '4.8', fontsize = '14'] 
'35'->'19' [color = 'blue', label = '100', penwidth = '10', fontsize = '14'] 
'36'->'4' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 

  {rank = min; 37;}
  {rank = same; 17; 24; 18; 28; 31;}
  {rank = same; 25; 26; 36;}
  {rank = same; 4; 21; 3;}
  {rank = same; 22; 34; 27; 10; 9;}
  {rank = same; 35; 32;}
  {rank = max; 38;}
}
  "
)
2018
grViz(
  diagram = "
digraph {

graph [rankdir = TB,
       outputorder = 'edgesfirst',
       bgcolor = 'white']

node [fontname = 'Helvetica',
      fontsize = '10',
      shape = 'circle',
      fixedsize = 'true',
      width = '0.5',
      style = 'filled',
      fillcolor = 'aliceblue',
      color = 'gray70',
      fontcolor = 'gray50']

edge [fontname = 'Helvetica',
     fontsize = '8',
     len = '1.5',
     color = 'gray80',
     arrowsize = '0.5']

  '1' [label = '21CSM', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '2' [label = 'Banshee Legs', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '3' [label = 'Breathless', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '4' [label = 'Cadence and Cascade', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '5' [label = 'CatalytiKc No. 9', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '6' [label = 'Cirkus', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '7' [label = 'Devil Dogs', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '8' [label = 'Discipline', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '9' [label = 'Drumsons', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '10' [label = 'Easy Money', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '11' [label = 'Epitaph', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '12' [label = 'Fairy Dust', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '13' [label = 'Fallen Angel', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '14' [label = 'Fracture', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '15' [label = 'Hell Hounds', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '16' [label = 'Indiscipline', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '17' [label = 'Interlude', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '18' [label = 'Islands', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '19' [label = 'ITCOTCK', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '20' [label = 'Level Five', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '21' [label = 'Lizard', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '22' [label = 'LTIA1', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '23' [label = 'LTIA2', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '24' [label = 'LTIA4', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '25' [label = 'Meltdown', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '26' [label = 'Moonchild', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '27' [label = 'Neurotica', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '28' [label = 'OMRN', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '29' [label = 'Peace: An End', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '30' [label = 'Pictures of a City', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '31' [label = 'RA1', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '32' [label = 'RA2', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '33' [label = 'RA3', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '34' [label = 'Red', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '35' [label = 'Sailors Tale', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '36' [label = 'Starless', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '37' [label = 'Suitable', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '38' [label = 'TCOL', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '39' [label = 'The Errors', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '40' [label = 'The Letters', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '41' [label = 'START', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false'] 
  '42' [label = 'END', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false'] 
'1'->'42' [color = 'blue', label = '95', penwidth = '9.5', fontsize = '14'] 
'2'->'6' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'2'->'16' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'3'->'1' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'3'->'11' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'3'->'13' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'5'->'29' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'5'->'38' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'6'->'21' [color = 'blue', label = '92', penwidth = '9.2', fontsize = '14'] 
'7'->'8' [color = 'blue', label = '23', penwidth = '2.3', fontsize = '14'] 
'8'->'16' [color = 'blue', label = '37', penwidth = '3.7', fontsize = '14'] 
'9'->'8' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
'9'->'29' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
'9'->'37' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'10'->'23' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'11'->'10' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'12'->'16' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'12'->'28' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'12'->'33' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'12'->'36' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'13'->'34' [color = 'blue', label = '38', penwidth = '3.8', fontsize = '14'] 
'14'->'16' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'14'->'18' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'15'->'8' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'15'->'27' [color = 'blue', label = '41', penwidth = '4.1', fontsize = '14'] 
'17'->'4' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'17'->'11' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'20'->'18' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
'20'->'36' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'21'->'11' [color = 'blue', label = '21', penwidth = '2.1', fontsize = '14'] 
'22'->'27' [color = 'blue', label = '37', penwidth = '3.7', fontsize = '14'] 
'22'->'29' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
'23'->'36' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
'24'->'18' [color = 'blue', label = '21', penwidth = '2.1', fontsize = '14'] 
'25'->'32' [color = 'blue', label = '92', penwidth = '9.2', fontsize = '14'] 
'26'->'19' [color = 'blue', label = '96', penwidth = '9.6', fontsize = '14'] 
'28'->'34' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'29'->'30' [color = 'blue', label = '48', penwidth = '4.8', fontsize = '14'] 
'30'->'4' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 
'31'->'25' [color = 'blue', label = '42', penwidth = '4.2', fontsize = '14'] 
'31'->'33' [color = 'blue', label = '53', penwidth = '5.3', fontsize = '14'] 
'32'->'20' [color = 'blue', label = '98', penwidth = '9.8', fontsize = '14'] 
'33'->'25' [color = 'blue', label = '80', penwidth = '8', fontsize = '14'] 
'34'->'28' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'35'->'26' [color = 'blue', label = '100', penwidth = '10', fontsize = '14'] 
'36'->'1' [color = 'blue', label = '63', penwidth = '6.3', fontsize = '14'] 
'36'->'42' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
'41'->'15' [color = 'blue', label = '53', penwidth = '5.3', fontsize = '14'] 
'41'->'22' [color = 'blue', label = '45', penwidth = '4.5', fontsize = '14'] 
'39'->'33' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
'39'->'34' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 

  {rank = min; 41;}
  {rank = same; 37; 38;}
  {rank = same; 2; 8; 14; 27; 29;}
  {rank = same; 35; 32;}
  {rank = max; 42;}
}

  "
)
2021
grViz(
  diagram = "
digraph {
  
  graph [rankdir=TB,
         outputorder = 'edgesfirst',
         bgcolor = 'white']
  
  node [fontname = 'Helvetica',
        fontsize = '10',
        shape = 'circle',
        fixedsize = 'true',
        width = '0.5',
        style = 'filled',
        fillcolor = 'aliceblue',
        color = 'gray70',
        fontcolor = 'gray50']
  
  edge [fontname = 'Helvetica',
        fontsize = '8',
        len = '1.5',
        color = 'gray80',
        arrowsize = '0.5']
  
  '1' [label = '21CSM', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '2' [label = 'Cirkus', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '3' [label = 'Devil Dogs', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '4' [label = 'Discipline', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '5' [label = 'Drumsons', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '6' [label = 'Drumzilla', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '7' [label = 'Epitaph', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '8' [label = 'Fairy Dust', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '9' [label = 'Hell Hounds', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '10' [label = 'Indiscipline', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '11' [label = 'Islands', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '12' [label = 'ITCOTCK', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '13' [label = 'Level Five', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '14' [label = 'Lizard', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '15' [label = 'LTIA1', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '16' [label = 'LTIA2', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '17' [label = 'Moonchild', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '18' [label = 'Neurotica', shape = 'ellipse', color = 'blue', fillcolor = 'yellow', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '19' [label = 'OMRN', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '20' [label = 'Peace: A Beginning', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '21' [label = 'Peace: An End', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '22' [label = 'Pictures of a City', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '23' [label = 'RA2', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '24' [label = 'Red', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '25' [label = 'Starless', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '26' [label = 'Suitable', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '27' [label = 'TCOL', shape = 'ellipse', color = 'blue', fillcolor = 'lightblue', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '28' [label = 'Tonys Cadenza', shape = 'ellipse', color = 'blue', fillcolor = 'lightpink', fontcolor = 'black', fontsize = '14', fixedsize = 'false'] 
  '29' [label = 'START', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false'] 
  '30' [label = 'END', shape = 'box', color = 'blue', fillcolor = 'blue', fontcolor = 'white', fontsize = '14', fixedsize = 'false'] 
  '1'->'30' [color = 'blue', label = '88', penwidth = '8.8', fontsize = '14'] 
  '2'->'7' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '2'->'14' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '2'->'23' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '2'->'24' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '3'->'15' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '3'->'22' [color = 'blue', label = '56', penwidth = '5.6', fontsize = '14'] 
  '4'->'10' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '4'->'16' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '5'->'22' [color = 'blue', label = '80', penwidth = '8', fontsize = '14'] 
  '6'->'22' [color = 'blue', label = '47', penwidth = '4.7', fontsize = '14'] 
  '7'->'19' [color = 'blue', label = '27', penwidth = '2.7', fontsize = '14'] 
  '8'->'22' [color = 'blue', label = '100', penwidth = '10', fontsize = '14'] 
  '9'->'15' [color = 'blue', label = '25', penwidth = '2.5', fontsize = '14'] 
  '9'->'22' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
  '10'->'11' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
  '10'->'25' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
  '11'->'10' [color = 'blue', label = '21', penwidth = '2.1', fontsize = '14'] 
  '11'->'23' [color = 'blue', label = '28', penwidth = '2.8', fontsize = '14'] 
  '12'->'23' [color = 'blue', label = '23', penwidth = '2.3', fontsize = '14'] 
  '13'->'25' [color = 'blue', label = '49', penwidth = '4.9', fontsize = '14'] 
  '14'->'11' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '14'->'23' [color = 'blue', label = '67', penwidth = '6.7', fontsize = '14'] 
  '15'->'22' [color = 'blue', label = '31', penwidth = '3.1', fontsize = '14'] 
  '16'->'11' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
  '17'->'1' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '17'->'23' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '17'->'28' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '18'->'10' [color = 'blue', label = '28', penwidth = '2.8', fontsize = '14'] 
  '18'->'24' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
  '19'->'10' [color = 'blue', label = '22', penwidth = '2.2', fontsize = '14'] 
  '19'->'28' [color = 'blue', label = '59', penwidth = '5.9', fontsize = '14'] 
  '20'->'19' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
  '20'->'22' [color = 'blue', label = '50', penwidth = '5', fontsize = '14'] 
  '21'->'16' [color = 'blue', label = '29', penwidth = '2.9', fontsize = '14'] 
  '21'->'22' [color = 'blue', label = '43', penwidth = '4.3', fontsize = '14'] 
  '22'->'7' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 
  '22'->'12' [color = 'blue', label = '39', penwidth = '3.9', fontsize = '14'] 
  '23'->'13' [color = 'blue', label = '100', penwidth = '10', fontsize = '14'] 
  '24'->'7' [color = 'blue', label = '24', penwidth = '2.4', fontsize = '14'] 
  '24'->'19' [color = 'blue', label = '30', penwidth = '3', fontsize = '14'] 
  '25'->'1' [color = 'blue', label = '81', penwidth = '8.1', fontsize = '14'] 
  '29'->'3' [color = 'blue', label = '24', penwidth = '2.4', fontsize = '14'] 
  '29'->'6' [color = 'blue', label = '24', penwidth = '2.4', fontsize = '14'] 
  '29'->'9' [color = 'blue', label = '32', penwidth = '3.2', fontsize = '14'] 
  '26'->'12' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '26'->'19' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '26'->'24' [color = 'blue', label = '33', penwidth = '3.3', fontsize = '14'] 
  '27'->'23' [color = 'blue', label = '27', penwidth = '2.7', fontsize = '14'] 
  {rank = min; 29;}

  {rank = max; 30;}
}

")

R に Intel MKL を導入する

Rを高速化する方法として、Rblas.dllを入れ替えるという手法は以前からあった。
ATLASとかGotoBLASとか。
BLASの高速化 - RjpWiki

今回、Microsoft R Openで使われている Intel MKL をRblas.dllとして利用する方法が紹介されていたので ここにメモをしておく。

教えてもらったツイートはこちら。

ネタ元はこちらのTom Wenseleersさんのコメント。
MRO 3.6 coming?

さらにその元ネタはこちら。
Linking Intel's Math Kernel Library (MKL) to R on Windows - Stack Overflow


1. Intel MKL (Math Kernel Library) をインストールする。配布元はこちら。Customizable Package でOK。
https://software.intel.com/en-us/mkl/choose-download

2.MKLのインストール先の以下の中身を

C:\Program Files (x86)\IntelSWTools\compilers_and_libraries\windows\redist\intel64\mkl
C:\Program Files (x86)\IntelSWTools\compilers_and_libraries\windows\redist\intel64\compiler

Rのインストール先の以下のフォルダにコピーする。

C:\Program Files\R\R-3.x.x\bin\x64

3. 元々入っている R の Rblas.dll と Rlapack.dll を適当にリネームする。
4. C:\Program Files\R\R-3.x.x\bin\x64 内に mkl_rt.dll のコピーを二つ作り、それぞれ Rblas.dll と Rlapack.dll にリネームする。

broomパッケージを使ってみる

broomパッケージの上手な使い方を考えてる。

library(stargazer)
library(broom)
library(dplyr)
library(ggplot2)

res1 <- lm(yield ~ block + N + P + K, npk)
res2 <- lm(yield ~ block + N + P * K, npk)

# res <- res1
res <- res2

anova(res)
res %>% 
  aov() %>% 
  tidy()
summary(res)
tidy(res)

# 多重比較
res %>% 
  aov() %>% 
  TukeyHSD() %>% 
  tidy() %>%
  mutate(pair = paste(term, comparison, sep="_")) %>%
  ggplot(aes(colour=cut(adj.p.value, c(0, 0.01, 0.05, 1),
                        label=c("p<0.01","p<0.05","Non-Sig")))) +
  geom_hline(yintercept=0, lty="11", colour="grey30") +
  geom_errorbar(aes(pair, ymin=conf.low, ymax=conf.high), width=0.2) +
  geom_point(aes(pair, estimate)) +
  labs(colour="significance", title = "Tukey Honest Significant Differences") +
  coord_flip()

glance(res)
augment(res)

res %>% 
  tidy(conf.int = TRUE) %>% 
  filter(term != "(Intercept)") %>% 
  ggplot(aes(estimate, term, color = term)) +
  geom_point() +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high)) +
  geom_vline(xintercept = 0)

stargazer(res1, res2, type="text", column.labels = c("res1","res2"),) 

続々・複数のファイルを一度に読みこむ方法

過去2回の続きでこれが最後(多分)。
複数のファイルを一度に読みこむ方法 - bob3’s blog
続・複数のファイルを一度に読みこむ方法 - bob3’s blog

前回、data.table::fread() を foreach で並列化したパターンを追加したのだけど、data.table::fread() はそもそも並列化されているということを思い出しました。
大変な無駄をしていたわけです。

このままだと並列化によって速くなるか否かが不明なままですので、readr::read_csv() を並列化して速さを確認してみます。
結論から言うとやっぱり fread & rbindlist が最速。
でも read_csv() も並列化した分は速くなってます。

f:id:bob3:20190709231809p:plain
read_csvの並列化追加

まあ、通常は fread & rbindlist でいいと思います。

# demo data ---------------------------------------------------------------
library(tidyverse)
library(data.table)
library(doParallel)
library(microbenchmark)

DIR <- "data/"

row_n <- 10000
col_n <- 10
files <- 365
file_names <- paste0(DIR, formatC(1:files, width = 3, flag = "0"), ".csv")

for (i in file_names) {
  rnorm(col_n * row_n) %>%
    round(4) %>%
    matrix(row_n, col_n) %>%
    data.frame() %>%
    fwrite(i)
}

# read_csv + map_dfr -----------------------------------------------------------------
read_csv_and_map_dfr <- function() {
  DIR %>%
    list.files(pattern = "*.csv", full.names = TRUE) %>%
    set_names() %>%
    map_dfr(
      read_csv,
      progress = FALSE,
      .id = "file_name"
    )
}

# fread + rbindlist ---------------------------------------------------------
fread_and_rbindlist <- function() {
  file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
  tmp <- map(file_names, fread, showProgress = FALSE)
  setattr(tmp, "names", file_names)
  rbindlist(tmp, idcol = "file_name")
}

# 並列化 ---------------------------------------------------------------------
cores <- detectCores(logical = FALSE) # コア数確認
cl <- makeCluster(cores)
registerDoParallel(cl)
clusterEvalQ(cl, c(library(readr), library(foreach)))

my_foreach <- function() {
  file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
  tmp1 <- foreach(i = file_names) %dopar% {
    read_csv(i)
  }
  bind_rows(tmp1, .id = "files") %>%
    left_join(tibble(file_names = file_names, files = as.character(1:length(file_names))), by = "files") %>%
    select(-files)
}

# microbenchimark ---------------------------------------------------------

gc()
gc()

compare <- microbenchmark(
  "read_csv & map_dfr" = read_csv_and_map_dfr(),
  "fread & rbindlist" = fread_and_rbindlist(),
  "doParallel & read_csv & bind_rows" = my_foreach(),
  times = 30L
)

compare

autoplot(compare) + labs(title = "R 3.6.1")

続・複数のファイルを一度に読みこむ方法

前々回の続編。

前々回の記事を書いた後の反応にこんなのがありました。

なるほど、並列化という手があったか。

ということで、まだ動作が不安定な vroom を外して、

  • Tidyverse流(read_csv & map_dfr)
  • data.table流(fread & rbindlist)
  • data.table流並列化(fread & rbindlist & foreach)

の3パターンで試します。

デモデータの用意

必要なパッケージを読み込みつつ、実験用のデモデータの用意。

library(tidyverse)
library(data.table)
library(doParallel)
library(microbenchmark)

DIR <- "data/"

row_n <- 10000
col_n <- 10
files <- 365 # 前回は不安定なvroomに合わせて10ファイルだったのを増やした。
file_names <- paste0(DIR, formatC(1:files, width = 3, flag = "0"), ".csv")

for (i in file_names) {
  rnorm(col_n * row_n) %>%
    round(4) %>%
    matrix(row_n, col_n) %>%
    data.frame() %>%
    fwrite(i)
}

Tidyverse流

  DIR %>%
    list.files(pattern = "*.csv", full.names = TRUE) %>%
    set_names() %>%
    map_dfr(
      read_csv,
      progress = FALSE,
      .id = "file_name"
    ) -> dat

data.table流

  file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
  tmp <- map(file_names, fread, showProgress = FALSE)
  setattr(tmp, "names", file_names)
  dat <- rbindlist(tmp, idcol = "file_name")

data.table流並列化

cores <- detectCores(logical = FALSE) # コア数確認
cl <- makeCluster(cores)
registerDoParallel(cl)
clusterEvalQ(cl, c(library(data.table), library(foreach)))
file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
tmp <- foreach(i = file_names) %dopar% {
    fread(i, showProgress = FALSE)
  }
setattr(tmp, "names", file_names)
rbindlist(tmp, idcol = "files")

比較

ファイル数が増えると Tidyverse 流では遅く感じてしまう。
やはり、data.table流は速い。
期待した並列化だが、バラツキが大きくて一概に速いとは言えない状況。コア数多めのCPU積んでる場合はいいのかもしれない。
書きやすさのTidyverse、速さのdata.tableというところは変わらない模様。

f:id:bob3:20190709010624p:plain
複数ファイルの読み込み速度比較(並列化入り)

# demo data ---------------------------------------------------------------
library(tidyverse)
library(data.table)
library(doParallel)
library(microbenchmark)

DIR <- "data/"

row_n <- 10000
col_n <- 10
files <- 365
file_names <- paste0(DIR, formatC(1:files, width = 3, flag = "0"), ".csv")

for (i in file_names) {
  rnorm(col_n * row_n) %>%
    round(4) %>%
    matrix(row_n, col_n) %>%
    data.frame() %>%
    fwrite(i)
}


# read_csv + map_dfr -----------------------------------------------------------------
read_csv_and_map_dfr <- function() {
  DIR %>%
    list.files(pattern = "*.csv", full.names = TRUE) %>%
    set_names() %>%
    map_dfr(
      read_csv,
      progress = FALSE,
      .id = "file_name"
    )
}

# fread + rbindlist ---------------------------------------------------------
fread_and_rbindlist <- function() {
  file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
  tmp <- map(file_names, fread, showProgress = FALSE)
  setattr(tmp, "names", file_names)
  rbindlist(tmp, idcol = "file_name")
}

# 並列化 ---------------------------------------------------------------------
cores <- detectCores(logical = FALSE) # コア数確認
cl <- makeCluster(cores)
registerDoParallel(cl)
clusterEvalQ(cl, c(library(data.table), library(foreach)))

my_foreach <- function() {
  file_names <- list.files(DIR, pattern = "*.csv", full.names = TRUE)
  tmp <- foreach(i = file_names) %dopar% {
    fread(i, showProgress = FALSE)
  }
  setattr(tmp, "names", file_names)
  rbindlist(tmp, idcol = "files")
}
# stopCluster(cl)

# microbenchimark ---------------------------------------------------------

gc()
gc()

compare <- microbenchmark(
  "read_csv & map_dfr" = read_csv_and_map_dfr(),
  "fread & rbindlist" = fread_and_rbindlist(),
  "doParallel & fread & rbindlist" = my_foreach(),
  times = 10L
)

compare

autoplot(compare) + labs(title = "R 3.6.1")

base と Tidyverse と data.table と

恋しさと せつなさと 心強さと」といえば『ストリートファイターII MOVIE』の挿入歌ですね。

さて、初心者にRを教えるとき、base準拠にすべきか、Tidyverse準拠にすべきか、という議論があります。
これは私も悩むところでありまして、さらに言えば data.table ってのもあります。

んで、まずはこの三つの流派(?)が存在してそれぞれこんな書き方をするんだよ、というのを示せるといいのかなーと思うわけです。

そこで試しにこんな処理を base, Tidyverse, data.tableのそれぞれで書いてみました。

  1. データセット flights の変数をdep_delay、arr_delay、carrier、air_time、distanceに絞る。
  2. いずれかの変数にNAを含む行を削除。
  3. 時速をkm/hで算出。air_timeは分単位なので60で除して時間単位に、distanceはマイル単位なので1.60934を乗じてkm単位に。
  4. carrier毎にdep_delay、arr_delay、Hourly speedの平均と件数を算出。
  5. 件数の降順に並べる。

こんな風に書いてみましたが、それぞれの書き方の違いの雰囲気ぐらいは伝わるかな?

base

library(nycflights13)
flights.df <- na.omit(as.data.frame(flights)[, c("dep_delay", "arr_delay", "carrier", "air_time", "distance")])
flights.df$HourlySpeed <- (flights.df$distance * 1.60934) / (flights.df$air_time / 60)
flights.df2 <- aggregate(
  flights.df[, c("dep_delay", "arr_delay", "HourlySpeed") ],
  list(carrier = flights.df$carrier),
  mean
)
flights.df2$n <- table(flights.df$carrier)
flights.df2[order(flights.df2$n, decreasing = TRUE), ]

Tidyverse

library(nycflights13)
library(tidyverse)
flights %>%
  select(dep_delay, arr_delay, carrier, air_time, distance) %>%
  drop_na() %>%
  mutate(HourlySpeed = (distance * 1.60934) / (air_time / 60)) %>%
  group_by(carrier) %>%
  summarise(
    mean_dep_delay = mean(dep_delay),
    mean_arr_delay = mean(arr_delay),
    mean_HourlySpeed = mean(HourlySpeed),
    n = n()
  ) %>% 
  arrange(desc(n))

data.table

library(nycflights13)
library(data.table)
flights.dt <- na.omit(as.data.table(flights)[, c("dep_delay", "arr_delay", "carrier", "air_time", "distance")])
setorder(flights.dt[
  , HourlySpeed := (distance * 1.60934) / (air_time / 60)
  ][
    j = list(
      mean_dep_delay = mean(dep_delay),
      mean_arr_delay = mean(arr_delay),
      mean_HourlySpeed = mean(HourlySpeed),
      n = .N
      ),
    by = carrier
    ],
  -n) -> flights.dt2
flights.dt2

実行速度は?

data.table圧勝!……かと思いきや、これくらいのデータ量だとTidyverseと大差ないですね。

f:id:bob3:20190707223349p:plain
実行速度比較