勉強などのメモ

勉強用のメモ

おすすめ漫画

SLAM DUNK 新装再編版 1 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 2 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 3 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 4 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 8 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 9 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 10 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 11 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 12 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 13 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 15 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 16 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 17 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 18 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 19 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 20 (愛蔵版コミックス) [ 井上 雄彦 ]

SLAM DUNK 新装再編版 全巻セット(1-20巻) [ 井上 雄彦 ]


ぷりっつさんち(7)

機械学習:Rでやってみる決定木

機械学習をJuliaでやろうと思ったものの、新しい言語を覚えるのもそれなりに労力がいる。
最近ようやくRに慣れてきたところなので、これを定着させることを目指してRでやることにした。

機械学習の勉強に役立つサイトとして有名な「kaggle」を活用させてもらうことにして、以下のデータセットを使用して決定木を試してみる。

Titanic: Machine Learning from Disaster | Kaggle

まず、データの読み込み。

#csvデータ読み込み
train <- read.csv('../all/train.csv')
test <- read.csv('../all/test.csv')

データの中身を軽く確認してみる。

summary(train)

>  PassengerId       Survived          Pclass     
> Min.   :  1.0   Min.   :0.0000   Min.   :1.000  
> 1st Qu.:223.5   1st Qu.:0.0000   1st Qu.:2.000  
> Median :446.0   Median :0.0000   Median :3.000  
> Mean   :446.0   Mean   :0.3838   Mean   :2.309  
> 3rd Qu.:668.5   3rd Qu.:1.0000   3rd Qu.:3.000  
> Max.   :891.0   Max.   :1.0000   Max.   :3.000  
>                                                 
>                                    Name         Sex           Age       
> Abbing, Mr. Anthony                  :  1   female:314   Min.   : 0.42  
> Abbott, Mr. Rossmore Edward          :  1   male  :577   1st Qu.:20.12  
> Abbott, Mrs. Stanton (Rosa Hunt)     :  1                Median :28.00  
> Abelson, Mr. Samuel                  :  1                Mean   :29.70  
> Abelson, Mrs. Samuel (Hannah Wizosky):  1                3rd Qu.:38.00  
> Adahl, Mr. Mauritz Nils Martin       :  1                Max.   :80.00  
> (Other)                              :885                NA's   :177    
>     SibSp           Parch             Ticket         Fare       
> Min.   :0.000   Min.   :0.0000   1601    :  7   Min.   :  0.00  
> 1st Qu.:0.000   1st Qu.:0.0000   347082  :  7   1st Qu.:  7.91  
> Median :0.000   Median :0.0000   CA. 2343:  7   Median : 14.45  
> Mean   :0.523   Mean   :0.3816   3101295 :  6   Mean   : 32.20  
> 3rd Qu.:1.000   3rd Qu.:0.0000   347088  :  6   3rd Qu.: 31.00  
> Max.   :8.000   Max.   :6.0000   CA 2144 :  6   Max.   :512.33  
>                                  (Other) :852                   
>         Cabin     Embarked
>            :687    :  2   
> B96 B98    :  4   C:168   
> C23 C25 C27:  4   Q: 77   
> G6         :  4   S:644   
> C22 C26    :  3           
> D          :  3           
> (Other)    :186           

年齢にNAがある模様。見にくいので欠損値の数のみ確認する。

#欠損値の数確認
is_na_train <- sapply(train, function(y) sum(is.na(y)))
is_na_train

>PassengerId    Survived      Pclass        Name         Sex         Age 
>          0           0           0           0           0         177 
>      SibSp       Parch      Ticket        Fare       Cabin    Embarked 
>          0           0           0           0           0           0 

欠損値があるのはAgeだけなのかな?と思って、データを目視確認したところ、ところどころブランク(空白)がある。これはNA判定されていない模様。そこで、空白はNAにするようにデータ読み込みし直すことに。

#ブランクもNAにして読み込む
train <- read.csv('../all/train.csv', stringsAsFactors=F, na.strings = c('NA', ''))
test <- read.csv('../all/test.csv', stringsAsFactors=F, na.strings = c('NA', ''))

「stringsAsFactors=F」というのは「文字列型をFactor型にしないように」というオプション。

再び欠損値数の確認。

#欠損値の数確認(再)
is_na_train <- sapply(train, function(y) sum(is.na(y)))
is_na_train

>PassengerId    Survived      Pclass        Name         Sex         Age 
>          0           0           0           0           0         177 
>      SibSp       Parch      Ticket        Fare       Cabin    Embarked 
>          0           0           0           0         687           2 

Age以外にも欠損値がありました。Cabinにかなりの数の欠損が。でも、モデルに使わないので無視。Embarkedの欠損が2件。
テストデータの方も確認しておく。

is_na_test <-  sapply(test, function(y) sum(is.na(y)))
is_na_test

>PassengerId      Pclass        Name         Sex         Age       SibSp 
>          0           0           0           0          86           0 
>      Parch      Ticket        Fare       Cabin    Embarked 
>          0           0           1         327           0 

モデルを作る前にデータのクリーニングをしなくてはならない。まず欠損値を埋める処理を行う。

#Ageの欠損値を埋める。とりあえずmedianを入れる
train$Age[is.na(train$Age)] <- median(train$Age, na.rm=T)
test$Age[is.na(test$Age)] <- median(test$Age, na.rm=T)

#Embarkedの欠損値を埋める。とりあえず数が最も多いSを入れる
#testには欠損値なし
train$Embarked[is.na(train$Embarked)] <- 'S'

#Fareの欠損値を埋める。medianを入れる
#trainには欠損値なし
test$Fare[is.na(test$Fare)] <- median(test$Fare, na.rm=T)

欠損値がなくなったかどうか確認。

#欠損値の数確認(再々)
is_na_train <- sapply(train, function(y) sum(is.na(y)))
is_na_train

>PassengerId    Survived      Pclass        Name         Sex         Age 
>          0           0           0           0           0           0 
>      SibSp       Parch      Ticket        Fare       Cabin    Embarked 
>          0           0           0           0         687           0 

Age、Embarkedの欠損値は0になった。テストデータの確認は省略。

次に、文字列型のデータをカテゴリ値に修正する。

#文字列をカテゴリ値に
train$Sex[train$Sex=='male'] <- 0
train$Sex[train$Sex=='female'] <- 1
train$Embarked[train$Embarked=='S'] <- 0
train$Embarked[train$Embarked=='C'] <- 1
train$Embarked[train$Embarked=='Q'] <- 2

test$Sex[test$Sex=='male'] <- 0
test$Sex[test$Sex=='female'] <- 1
test$Embarked[test$Embarked=='S'] <- 0
test$Embarked[test$Embarked=='C'] <- 1
test$Embarked[test$Embarked=='Q'] <- 2

これでデータクリーニングが終わったので、いよいよモデルを作る。

#決定木でモデルを作る
library(rpart)

model1 <- rpart(Survived ~ Pclass + Age + Sex + Fare, data=train)
model1

>n= 891 
>
>node), split, n, deviance, yval
>      * denotes terminal node
>
> 1) root 891 210.727300 0.3838384  
>   2) Sex=0 577  88.409010 0.1889081  
>     4) Age>=6.5 553  77.359860 0.1681736  
>       8) Pclass>=1.5 433  44.226330 0.1154734 *
>       9) Pclass< 1.5 120  27.591670 0.3583333 *
>     5) Age< 6.5 24   5.333333 0.6666667 *
>   3) Sex=1 314  60.105100 0.7420382  
>     6) Pclass>=2.5 144  36.000000 0.5000000  
>      12) Fare>=23.35 27   2.666667 0.1111111 *
>      13) Fare< 23.35 117  28.307690 0.5897436 *
>     7) Pclass< 2.5 170   8.523529 0.9470588 *

うーん、よくわからない。なので、図示してみる。

library(rpart.plot)

#図示してみる
rpart.plot(model1, extra = 1)

出力結果は以下の図。

f:id:prism0081:20180919125511j:plain

これの評価はさておき、作ったモデルをテストデータにあてはめて予測してみる。

#モデルで予測する
pred1 <- predict(model1, test)
pred1

>        1         2         3         4         5         6         7 
>0.1154734 0.5897436 0.1154734 0.1154734 0.5897436 0.1154734 0.5897436 
>        8         9        10        11        12        13        14 
>0.1154734 0.5897436 0.1154734 0.1154734 0.3583333 0.9470588 0.1154734 
(以下略)

0,1での出力じゃなくて、確率で出してくれるのね。kaggeleへの提出は0,1での予測が必要なので変換する。

#0,1で表現する
pred1 <- round(pred1)
pred1

>  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19 
>  0   1   0   0   1   0   1   0   1   0   0   0   1   0   1   1   0   0   1 
> 20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38 
>  1   0   0   1   0   1   0   1   0   0   0   0   0   1   0   0   0   1   1 
(以下略)

予測結果をkaggleで評価してもらうために、csvファイルに書き出す。

# 予測結果とPassengerIdをデータフレームへ
my_solution1 = data.frame(
  PassengerId = test$PassengerId,
  Survived = pred1
)

#結果のCSV書き出し
write.csv(my_solution1, file='./model1_solution.csv', row.names = F)

出力したcsvファイルをkaggleでアップロードして判定してもらったところ・・・

f:id:prism0081:20180919130530j:plain

まあまあの数字。
まったく同じ事をPythonでやってみたけど、Rの方がスコアは高かった。ライブラリの違いでしょうかね。

少しモデルの説明変数を増やしてみる。

#モデルの説明変数を増やしてみる
model2 <- rpart(Survived ~ Pclass + Age + Sex + Fare + SibSp + Parch + Embarked, data=train)

#図示してみる
rpart.plot(model2, extra = 1)

f:id:prism0081:20180919132255j:plain

大きくは変わってない印象・・・モデル1と同様に予測してみる。

#モデルで予測する
pred2 <- predict(model2, test)

#0,1で表現する
pred2 <- round(pred2)

# 予測結果とPassengerIdをデータフレームへ
my_solution2 = data.frame(
  PassengerId = test$PassengerId,
  Survived = pred2
)

#結果のCSV書き出し
write.csv(my_solution2, file='./model2_solution.csv', row.names = F)

kaggleにアップロードして評価してもらうと

f:id:prism0081:20180919132239j:plain

少しだけ改善しましたが、もっとチューニングが必要です。

Julia入門:環境構築

ベイズ学習を勉強するにあたって、何の言語でやろうかなと考えていたところ、Juliaが良いという話を聞いたので勉強してみることにした。

ひとまず環境構築しないといけないのだけれど、あまり流行ってない言語なのか参考情報が少ない&やや古め・・・
なので、自分用のメモとしてまとめておく。

①Juliaのインストール
公式サイトで自分の環境にあったインストーラーを選んでダウンロード&実行。
The Julia Language

②実行
インストールが終わると「Julia」というショートカットができるはずなので、それを実行。
すると、以下のようなコンソールが起動する。

f:id:prism0081:20180907171044j:plain

これにごりごりとコードを書いてもいいのでしょうが勉強にはあまりにも不便なので、IDEを導入する。

③Junoのインストール
「Juno」というIDEがあるそうです。以下を参考にさせてもらった。

st-hakky.hatenablog.com

手順としては、まず「Atom」というオープンソーステキストエディターをインストール。
公式サイトは以下。

atom.io

インストールが完了したら起動。Juliaを扱えるようにするため「uber-juno」というパッケージをインストールする。
Atomのメニューの「File」から「Settings」を選択。
その中に「Install」があるはずなのでそれを選択して、表示される検索ボックスに上記のパッケージ名「uber-juno」を入力する。
すると、当該パッケージがヒットするはずなのでインストールを選択する。

④自分好みに設定する
あとは適宜、自分好みにテーマを変えるとかしてカスタマイズしていけばよい。


こうして箇条書きすると難しくなく見えるが、ちょこちょこ躓いた。
そんなときは、アプリケーションをいったん終了して再起動すると先に進めた。
調べ物の時間含めて、なんだかんだで3時間くらい使ってしまった。

クラウドソーシング

最近、研究者の間でクラウドソーシングを使った調査が流行っているという話を聞いた。
気になって調べて見ると、海外で問題があるケースがあったそうで。


元記事はこちら。
www.maxhuibai.com


日本でも同様のケースは十分起こりえるので、使用する際には十分注意しないと。

MRPをめぐるツイート群

*1:David Shor

*2:David Shor

*3:David Shor

*4:David Shor

*5:David Shor

勉強用の本

ベイズ統計モデリング: R,JAGS, Stanによるチュートリアル 原著第2版

ベイズ統計で実践モデリング: 認知モデルのトレーニング

プラレール トミカと遊ぼう!くるぞわたるぞ!カンカン踏切セット

2019年1月始まりカレンダー

電動バイク

たたみ


時計

Apple MD826AM/A Lightning - Digital AVアダプタ

ライフジャケット

プレゼント?

プレゼント2

プレゼント3

プレゼント4

プレゼント5


ふでばこ


おすすめモニター台


おすすめランタン


おすすめランタンスタンド

おすすめケーブルトレー

おすすめコップ袋


おすすめオフィスチェア


おすすめチェアマット


おすすめインナーシュラフ


おすすめレザークラフト


おすすめはんこ

おすすめシャワーヘッド


おすすめポール


おすすめハンモック


おすすめ母の日ギフト

おすすめ充電ケーブル


【ふるさと納税】特別寄附額実施中 総合ランキング1位 いくら醤油漬け 鮭卵 400g (200g×2パック) 白糠町 いくら イクラ 醤油漬け 小分け ふるさと 人気


【ふるさと納税】高評価★4.59 発送時期が選べる エンペラーサーモン【1kg】 サーモン 鮭 刺身 さけ サケ スモークサーモン 魚 人気 ふるさと 北海道 海鮮 送料無料 ランキング 多数入賞


【ふるさと納税】【累計2,000万個突破!!】鉄板焼 ハンバーグ デミソース 20個 温めるだけ 福岡 飯塚 牛 冷凍 小分け 大容量 ハンバーグ 飯塚市 はんばーぐ 肉 簡単調理 デミグラスソース 特製 湯煎 人気 子供 【A2-074】【1110レビューCP】(クラウドファンディング対象)


【ふるさと納税】北海道十勝スイーツ 「三方六の小割」10本入り4箱 本別町観光協会 送料無料《60日以内に順次出荷(土日祝除く)》


【ふるさと納税】ROYCE'人気スイーツ詰め合わせ(A)


【ふるさと納税】【発送時期が選べる】中山牧場 佐賀牛赤身スライス 1kg


【ふるさと納税】高レビュー4.7以上!!<選べるお届け月>国産うなぎ蒲焼4尾(計800g以上) 数量限定 鰻蒲焼 ウナギ蒲焼用たれ さんしょうのセット(うなぎ1尾190g以上の鰻4尾からなるウナギの詰め合わせ)


【ふるさと納税】【2023年出荷予約】北海道産赤肉メロン大玉 2玉

【ふるさと納税】 羽毛布団 掛け布団 ゴールドラベル シングル 日本製 合い掛け 洗える コロナ支援 訳あり 選べる 配送時期 ホワイトダックダウン90% 洗濯可 寝具 布団 国産 甲州羽毛ふとん ダンボールハウス つながるふじよしだ (クラウドファンディング対象)

【ふるさと納税】ついに復活!※数量限定※九州産黒毛和牛切り落とし 2000g(500g×4パック) 小分け 合計2kg 期間限定 切落し 牛肉 黒毛和牛 冷凍 国産 九州産 送料無料 応援 緊急支援 おすすめ ランキング


【ふるさと納税】【背ワタなし】大型むきえび(高級ブラックタイガー)約1kg/約50〜80尾 【甲羅組 蟹 カニ 海老 エビ】【発送時期をお選びください】


【ふるさと納税】シュークリーム【最大6か月待ち】かみのやまシュー 6個 お菓子 おやつ デザート スイーツ スウィーツ 洋菓子 小分け 一人暮らし 少人数 お取り寄せグルメ 3000円 冷凍配送 山形県 0048-2209


【ふるさと納税】人気No.1獲得謝礼品★限定品★博多あまおう約1,120g いちご 苺 福岡(先行受付/2023年1月以降発送) 高級 フルーツ

【ふるさと納税】大地の黄金干し芋 計200g(100g×2袋)鹿児島県産のさつまいも「紅はるか」を使用した、しっとり、こく甘、やわらかな黄金色のほしいも!無添加・無着色な健康的なおいものスイーツ! 【末永商店】p3-003


【ふるさと納税】【ルタオ】ドゥーブルフロマージュお菓子 チーズケーキ ルタオ ドゥーブルフロマージュ スイーツ TV メディア 北海道ふるさと納税 千歳市 ふるさと納税【北海道千歳市】お中元 北海道 セット ギフト プレゼント


【ふるさと納税】柳月「三方六」詰合せ 秋冬限定セット(珈琲&ミルク)本別町観光協会《60日以内に順次出荷(土日祝除く)》 三方六 菓子 バームクーヘン 洋菓子 コーヒー ミルク 送料無料


早稲田大学(社会科学部) (2023年版大学入試シリーズ) [ 教学社編集部 ]


上智大学(神学部・文学部・総合人間科学部) (2023年版大学入試シリーズ) [ 教学社編集部 ]

最新教育動向(2023) 必ず押さえておきたい時事ワード60&視点120 [ 教育の未来を研究する会 ]



ポイント最大26倍!! Panasonic ななめドラム式洗濯乾燥機 乾燥フィルター用 おそうじブラシ AXW22R-9DA0 掃除ブラシ パナソニック AXW22R9DA0 純正品 送料無料 【SK01559】

ふと浮かぶ記憶と思考の心理学: 無意図的な心的活動の基礎と臨床


学校教育ではぐくむ 資質・能力を評価する


シトルリン


おすすめサプリメント


iPhone充電ケーブル


NEW こどものスケール・アルペジオ


おすすめリュックサック


おすすめ掃除機ヘッド

おすすめモバイルバッテリー


推しが武道館いってくれたら死ぬ 4


推しが武道館いってくれたら死ぬ 5


iPhone11用おすすめケース


失敗の本質


アップルギフトカード


エンペラーサーモン


いくら


デミハンバーグ


ネギトロ


うなぎ


たらこ


三方六


赤肉メロン


牛肉


かつおのたたき


replica


strobo



NS67 バスティン コンピレーションアルバム レベル2



赤青鉛筆



ビット・バイ・ビット デジタル社会調査入門


スーパーマリオブラザーズ ワンダー


iPad Air5用ペーパーライクフィルム



傷モノの花嫁 ~虐げられた私が、皇國の鬼神に見初められた理由~(1)

DABADA(ダバダ) エスボード 光るタイヤ 組み立て済み プロテクター 3点セット付き ブレイブボード ブレイドボード キャスターボード ブレボー スケボー スケートボード ESSボード ESSBOARD 子供 キッズ


世界の果ては深愛(2) (KCデラックス)


ベイブレードX バトルエントリーセット


オペレーションズリサーチ


書道用下敷き

Z会中学受験シリーズ 入試に出る動物図鑑 改訂版


Z会中学受験シリーズ 入試に出る植物図鑑 改訂版


ウケるゴロ合わせ《日本史編》 イヤでも覚える基本重要事項98


WP70J ファーストピアノレパートリーアルバム


山善(YAMAZEN) 突っ張りポールハンガーラック ブラック 幅97.5-166cm 高さ140-280cm ダブル 伸縮 WJ-775(BK)

Chapter5 練習問題 Part2

(3)5.3.2項の続きで、アルバイトが好きかどうかごとにYを集計せよ

元データはこんなもの。

data-attendance-3.txt

PersonID,A,Score,Weather,Y
1,0,69,B,1
1,0,69,A,1
1,0,69,C,1
1,0,69,A,1
1,0,69,B,1
1,0,69,B,1
1,0,69,C,0
1,0,69,B,1
1,0,69,A,1

コードは以下のとおり。

#データ読み込み
d2 <- read.csv(file="data-attendance-3.txt")
#aggregate(x=list(<表示列名>=<変数名>$<集計列>),by=list(<表示列名>=<変数名>$<キー列>,<表示列名>=<変数名>$<キー列>,……),FUN=sum)

aggregate(x=list(Y=d2$Y),by=list(A=d2$A),FUN=table) #自分の回答

aggregate(Y~A,data=d2,FUN=table) #回答はこっち

結果はどちらも一致。

  A Y.0 Y.1
1 0 288 994
2 1 386 728

(4)5.3.3項では曇りと雨の影響を固定した。晴れを0とし、曇りと雨の影響をパラメーター化したモデルも考えられる。Stanで推定せよ。

まずモデル式を本から書き写すと

 q[i]=inv\_logit(b_{1}+b_{2}A[i]+b_{3}Score[i]+b_{4}Weather[i])~~~i=1,\cdots,I
 Y[i]=Bernoulli(q[i])~~~i=1,\cdots,I

これに基づくStanプログラムは

model5-5.stan

data{
  int I;
  int<lower=0, upper=1> A[I];
  real<lower=0, upper=1> Score[I];
  real<lower=0, upper=1> W[I];
  int<lower=0, upper=1> Y[I];
}

parameters{
  real b[4];

}

transformed parameters{
  real q[I];
  for(i in 1:I)
    q[i]=inv_logit(b[1]+b[2]*A[i]+b[3]*Score[i]+b[4]*W[i]);
}

model{
  for(i in 1:I)
    Y[i]~bernoulli(q[i]);
}

これを修正して天気をパラメーターに入れる。

model5-5-2.stan

data{
  int I;
  int<lower=0, upper=1> A[I];
  real<lower=0, upper=1> Score[I];
  int<lower=1, upper=3> WID[I];
  int<lower=0, upper=1> Y[I];
}

parameters{
  real b[3];
  real bw2;
  real bw3;
}

transformed parameters{
  real q[I];
  real bw[3];
  bw[1]=0; //晴れは0
  bw[2]=bw2;
  bw[3]=bw3;
  for(i in 1:I)
    q[i]=inv_logit(b[1]+b[2]*A[i]+b[3]*Score[i]+bw[WID[i]]);
}

model{
  for(i in 1:I)
    Y[i]~bernoulli(q[i]);
}

実行コードは以下のとおり

conv <- c(1,2,3)
names(conv)<- c('A','B','C')
data <- list(I=nrow(d2),A=d2$A, Score=d2$Score/200, WID=conv[d2$Weather], Y=d2$Y)
fit4 <- stan(file="model5-5-2.stan", data=data, seed=1234)

トレースプロットは・・・

f:id:prism0081:20170906183700j:plain

Stanコード間違って何度かやり直したけど、ようやくちゃんと収束しました。

続きはまた後日。