広告セグメント情報(カテゴリカルデータ)に対するロジスティック回帰分析の適用

ロジスティック回帰分析を調べていると、説明変数が連続ではない場合（カテゴリカルデータ）について知りたくなった。
試しに擬似データで、一通り分析をしてみる。

性別と年齢層が説明変数、クリックしたかどうかが目的変数のデータを用意した。ディスプレイ広告を想定している。
https://drive.google.com/file/d/1yqUND_5lih4cHqAr3QFjsjaJc7IFoLz4/view

# 全体のコード
https://github.com/tamanobi/playground/tree/master/logistic_regression

# 必要なライブラリ
カテゴリカルデータを可視化するパッケージ `vcd` が必要となる。

```r
install.packages('vcd')
```

# データ生成の方法

## 整数の一様乱数
`floor(runif(n = 10, min = 0, max = 2))` とすることで、0か1の数値を10個生成することができる[^1]
[^1]: [整数の一様乱数を得る](http://d.hatena.ne.jp/biochem_fan/20131116/1384586970)

## データの偏らせ方
性別が男性(male)であること、年代が30代(30s)であることのいずれかのとき、クリックをしやすいように調整した。

具体的には、`rbinom`で試行を1回(`size=1`)、観測回数を1(`n=1`)を指定して確率だけ変更した。例えば、maleであるときに成功確率を0.7としている。

clickするかどうかは、click_rateが0.5を超えるかどうかで0,1を分けている。

## コード
```r
samplesize <- 1000
sex <- factor(floor(runif(n = samplesize, min = 0, max = 3)), labels = c("male", "female", "other"))
agegroup <- factor(floor(runif(n = samplesize, min = 0, max = 5)), labels = c("10s", "20s", "30s", "40s", "50s"))

a <- sapply(sex, function (x) {
  b <- 0
  if(x == 'male') b <- rbinom(n=1,size=1,prob = 0.7)
  else if (x == 'female') b <- rbinom(n=1,size=1,prob = 0.5)
  else b <- rbinom(n=1,size=1,prob = 0.1)
  return(b)
})

b <- sapply(agegroup, function (x) {
  c <- 0
  if (x == '30s') c <- rbinom(n=1,size=1,prob = 0.7)
  else c <- rbinom(n=1,size=1,prob = 0.5)
  return (c)
})

click_rate <- scale(x = (a+b), center=min(a+b), scale = (max(a+b) - min(a+b)))
click <- factor(ifelse(click_rate > 0.5, 1, 0), labels = c("n", "y"))
ad_click <- data.frame(click=click, sex=sex, agegroup)
```


# 記述統計量
生成された、ad_clickについてどのようになっているか観察する。clickは大きく偏っているが、sexやagegroupには一様に分布しているようだ。

![20180609182311.png](https://qiita-image-store.s3.amazonaws.com/0/38967/2a66f149-11de-0a31-a9c5-7131a01248c9.png)

# 集計表を用いたカテゴリカルデータの分布
集計表を作り、どこに偏りがあるか確認する。

```r
# visualization
crosstab <- xtabs(~ click + agegroup + sex, data=ad_click)
pairs(crosstab, lower_panel = pairs_assoc, shade=TRUE) # https://www.slideshare.net/KumarP34/using-r-for-customer-segmentation
```

![20180609184332.png](https://qiita-image-store.s3.amazonaws.com/0/38967/d7137803-9a05-d6c8-2686-cdb47b2a928d.png)


左下三角成分は、各変数間のアソシエーショングラフである。`lower_panel = pairs_assoc`を指定することで、左下三角成分をアソシエーショングラフ(`assoc`で生成されるグラフ)に変更できる。

![20180609185050.png](https://qiita-image-store.s3.amazonaws.com/0/38967/ba41e16e-822d-068c-6308-cfbba0e7656d.png)


## アソシエーショングラフ
clickとsexについて`assoc` を使ってグラフを描いた。上の図の3行1列のグラフに相当。

![20180609191337.png](https://qiita-image-store.s3.amazonaws.com/0/38967/f9977682-4e9d-3b4e-6f0e-00ecf0628e5f.png)


[Ｒによるカテゴリカルデータの視覚化](https://www1.doshisha.ac.jp/~mjin/R/46/46.html) によれば、グラフは以下を示しているらしい。
> 長方形の高さは残差、幅は期待度数の平方根、面積は観測度数と期待度数の差に比例する。各長方形はゼロをベースラインとし、残差が正の場合は場合はベースラインの上方、その逆であればベースラインの下方に配置する。

公式のDocmentも見ておいたほうがよさそうである([assoc function](https://www.rdocumentation.org/packages/vcd/versions/1.4-4/topics/assoc))。

このアソシエーショングラフからわかるのは、以下の2点である

* clickしたmaleの数が期待値よりも大きいこと
* clickしなかったotherの数が期待値よりも小さいこと

# ロジスティック回帰
Rでは以下のコマンドを使う。

```r
ad_click.glm <- glm(formula = click ~ sex + agegroup, data = ad_click, family="binomial")
summary(ad_click.glm)
```

```
Call:
glm(formula = click ~ sex + agegroup, family = "binomial", data = ad_click)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.1280  -0.8558  -0.4470  -0.3402   2.3993  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -1.36684    0.21408  -6.385 1.72e-10 ***
sexmale      0.69872    0.17350   4.027 5.65e-05 ***
sexother    -1.43706    0.24924  -5.766 8.13e-09 ***
agegroup20s  0.19564    0.25298   0.773   0.4393    
agegroup30s  0.55084    0.24969   2.206   0.0274 *  
agegroup40s -0.01657    0.26547  -0.062   0.9502    
agegroup50s  0.31678    0.26197   1.209   0.2266    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1085.75  on 999  degrees of freedom
Residual deviance:  974.58  on 993  degrees of freedom
AIC: 988.58

Number of Fisher Scoring iterations: 5
```

sexmaleの項、sexotherの項、そしてagegroup30sの項がかなり強い影響を及ぼしていることが`Pr(>|z|)`の列から見てとれる

Coefficientsの列が、推定された係数である。この係数をexp関数にかけるとオッズ比が求まる。

# オッズ比
クリック確率を`p`としたとき、クリックしない確率 `1 - p` の比をオッズ比という。

説明変数それぞれのオッズ比は、ロジスティック回帰によって推定された係数から導ける。

```r
exp(ad_click.glm$coefficients)
```

```
(Intercept)     sexmale    sexother agegroup20s agegroup30s agegroup40s agegroup50s 
  0.2549121   2.0111755   0.2376243   1.2160923   1.7347097   0.9835625   1.3726984 
```

得られた数値は、各変数が1増加したときのオッズ比である。すなわち、sexmaleがTrueになるとオッズ比が2倍になる。

# 分析
よりビジネスに近い形で説明する。

* 男性(male)は、ほかの性別よりもクリック率が2.01倍になる
* 男女以外(other)は、ほかの性別よりも、クリック率が0.23倍になる
* 30代(30s)は、ほかの年代よりも、クリック率が1.73倍になる

以上のことから、 **30代男性** に広告を多く配信するとクリック率向上が見込める。