総務省テキスト 第3章 機械学習(教師あり学習) p45の解説です。
単回帰は
(x,y)の散布図に直線(xの一次式)を当てはめ、yをxから予測しようとするものです。
xを説明変数、yを目的変数といい、\(y=ax+b\) を回帰式といいます。
重回帰は説明変数が\((x_1,x_2,x_3)\)のように複数あるものをいい、
\(y=a_1x_1+a_2x_2+a_3x_3+b_0\) のように一次式で表されます。
目的変数を説明変数の一次式で表すことを線形回帰といいます。
ケーキの売上金額を、 Instagram
の投稿数・チラシの配布枚数・イベントの実施などから予測する
目的変数:ケーキの売上金額
説明変数:Instagram の投稿数、チラシの配布枚数、イベントの実施など
データを読み込みます。データ内容は以下の通りです。
ID:ID
sales:売上個数
insta_post:Instagram投稿数
insta_good:Instagramいいね!数
flyer:チラシ配布枚数
event:イベントあり=1、イベントなし=0
new_item:新作発売日=1
holiday:土日祝=1
# データの読み込み
df <- read.csv("data/senkei.csv")
head(df)
## ID sales insta_post insta_good flyer event new_item holiday
## 1 1 62 0 20 0 0 0 0
## 2 2 60 0 24 0 0 0 0
## 3 3 104 0 26 0 0 0 0
## 4 4 102 0 22 0 0 0 0
## 5 5 178 0 39 0 0 0 1
## 6 6 181 0 47 0 0 0 1
# データの概要
str(df)
## 'data.frame': 53 obs. of 8 variables:
## $ ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ sales : int 62 60 104 102 178 181 116 112 119 121 ...
## $ insta_post: int 0 0 0 0 0 0 0 0 0 0 ...
## $ insta_good: int 20 24 26 22 39 47 22 23 25 33 ...
## $ flyer : int 0 0 0 0 0 0 0 0 0 0 ...
## $ event : int 0 0 0 0 0 0 0 0 0 0 ...
## $ new_item : int 0 0 0 0 0 0 0 0 0 0 ...
## $ holiday : int 0 0 0 0 1 1 0 0 0 0 ...
salesをinsta_goodの数から予測します。
関数はlm(linear model)、結果をres(response)とおくと、
# 4つの説明変数による重回帰分析
res <- lm(sales ~ insta_good, data = df)
res
##
## Call:
## lm(formula = sales ~ insta_good, data = df)
##
## Coefficients:
## (Intercept) insta_good
## 101.715 2.059
回帰式 \(sales=101.7152+2.0585instagood\) が求まりました。
summary(概要)を表示します。
summary(res)
##
## Call:
## lm(formula = sales ~ insta_good, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -168.084 -42.104 -8.588 23.646 221.507
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 101.7152 16.5560 6.144 1.22e-07 ***
## insta_good 2.0585 0.2759 7.461 1.02e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 69.47 on 51 degrees of freedom
## Multiple R-squared: 0.5219, Adjusted R-squared: 0.5125
## F-statistic: 55.67 on 1 and 51 DF, p-value: 1.018e-09
項目の説明は以下の通りです。回帰式の当てはまりは、自由度修正済み決定係数で判断します。
Residuals:残差、salesの予測値と実際のsalesとの差をいいます。
(中央値が0に近く、左右均等であることが望ましい)
Estimate:係数の推定値
(Std. Error、 t value、 Pr(>|t|)
の説明については立ち入りません)
Residual standard error: (残差)標準誤差
(残差の平方和を自由度51で割って得た残差分散の平方根)
degrees of freedom (残差)自由度
(データ数ー1ー説明変数の個数=53-1-1=51)
Multiple R-squared: 決定係数 \(R^2\)
(0から1で、1に近いほど当てはまりがよい)
Adjusted R-squared: 自由度修正済み決定係数 \(R^{2*}\)
(説明変数が多くなりすぎないよう修正した決定係数)
自由度修正済み決定係数が1に近いとき、よいモデルといえます。
残差のデータの箱ヒゲ図は下図になります。
summaryのResidualsの数値と一致していることが分かります。
boxplot(resid(res),cex.lab = 2,horizontal= T)
散布図と回帰直線を図示すると下図になります。
残差は左右均等になっていないため、回帰直線の当てはまりもよくありません。
自由度修正済み決定係数は、0.5125 です。
plot(df$insta_good,df$sales)
abline(res, lwd=2)
5つの説明変数すべてを用いた回帰分析をします。
res <- lm(sales ~ insta_post+insta_good+flyer+event+new_item+holiday, data = df)
summary(res)
##
## Call:
## lm(formula = sales ~ insta_post + insta_good + flyer + event +
## new_item + holiday, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -114.863 -30.964 -2.594 21.296 114.863
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 131.89411 16.22895 8.127 1.92e-10 ***
## insta_post 48.87111 39.23549 1.246 0.21922
## insta_good 0.68499 0.41767 1.640 0.10782
## flyer 0.20610 0.05035 4.093 0.00017 ***
## event 245.43675 77.85281 3.153 0.00285 **
## new_item -38.90575 68.07177 -0.572 0.57042
## holiday 26.54967 18.87190 1.407 0.16620
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 53.71 on 46 degrees of freedom
## Multiple R-squared: 0.7423, Adjusted R-squared: 0.7086
## F-statistic: 22.08 on 6 and 46 DF, p-value: 4.873e-12
自由度修正済み決定係数は 0.7086 で改善しています。
決定係数は説明変数を増やせば大きくなりますが、必要のない変数まで増やすのはよいことではありません。自由度修正済み決定係数は変数の数が増えれば小さくなるように考えられており、モデルの当てはまりの判断に用いられます。
では、どの変数を減らせばよいのでしょうか?
モデルの当てはまりのよさを表す指標としてAIC(赤池情報量基準:小さいほどよい)があり、これを用いた「ステップワイズ法」があります。
変数の数ををしぼりながら当てはまりのよい最良のモデルに近づける方法です。
Rでは 関数stepで「ステップワイズ法」を実行してくれます。
# データの読み込み
df <- read.csv("data/senkei.csv")
# 全ての説明変数によるステップワイズ法(変数増減法)による重回帰分析
res <- lm(sales ~ insta_post+insta_good+flyer+event+new_item+holiday, data = df)
step(res)
## Start: AIC=428.75
## sales ~ insta_post + insta_good + flyer + event + new_item +
## holiday
##
## Df Sum of Sq RSS AIC
## - new_item 1 942 133638 427.13
## - insta_post 1 4476 137171 428.51
## <none> 132695 428.75
## - holiday 1 5709 138405 428.99
## - insta_good 1 7759 140454 429.76
## - event 1 28670 161365 437.12
## - flyer 1 48334 181029 443.21
##
## Step: AIC=427.13
## sales ~ insta_post + insta_good + flyer + event + holiday
##
## Df Sum of Sq RSS AIC
## - insta_post 1 3600 137238 426.54
## <none> 133638 427.13
## - insta_good 1 7175 140813 427.90
## - holiday 1 7819 141456 428.14
## - flyer 1 48810 182448 441.63
## - event 1 55167 188805 443.44
##
## Step: AIC=426.54
## sales ~ insta_good + flyer + event + holiday
##
## Df Sum of Sq RSS AIC
## - holiday 1 5182 142420 426.50
## <none> 137238 426.54
## - insta_good 1 14832 152070 429.98
## - flyer 1 46831 184069 440.10
## - event 1 65383 202620 445.19
##
## Step: AIC=426.5
## sales ~ insta_good + flyer + event
##
## Df Sum of Sq RSS AIC
## <none> 142420 426.50
## - insta_good 1 21965 164384 432.10
## - flyer 1 43924 186344 438.75
## - event 1 60632 203052 443.30
##
## Call:
## lm(formula = sales ~ insta_good + flyer + event, data = df)
##
## Coefficients:
## (Intercept) insta_good flyer event
## 135.7852 0.8480 0.1943 271.8685
AIC=426.5 まで減少し、変数は3個に絞られました。
絞られた3個の変数で summaryを出してみます。
res <- lm(sales ~ insta_good + flyer + event, data = df)
summary(res)
##
## Call:
## lm(formula = sales ~ insta_good + flyer + event, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -126.196 -37.984 5.256 21.297 124.121
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 135.78521 14.11109 9.623 7.11e-13 ***
## insta_good 0.84795 0.30846 2.749 0.008347 **
## flyer 0.19431 0.04998 3.887 0.000305 ***
## event 271.86850 59.52426 4.567 3.35e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 53.91 on 49 degrees of freedom
## Multiple R-squared: 0.7234, Adjusted R-squared: 0.7064
## F-statistic: 42.71 on 3 and 49 DF, p-value: 1.03e-13
自由度修正済み決定係数は、0.7064 です。
変数を3個に絞りながら、当てはまりはよくなっています。
残差の箱ヒゲ図も左右均等に近づいています。
boxplot(resid(res),cex.lab = 2,horizontal= T)