データの見えざる手の理解

http://www.ikedahayato.com/20150127/16567647.html

このサイトに紹介されている本を読んだのだけど、 いまいちピンと来なかったので、実際に乱数を発生させて確認してみた。

問題: 以下の二つの場合でばらつきに差が出るか？

• ランダムで割り振った場合
• ランダムで受け渡しをした場合

library(ggplot2)

まずは簡単に理解するために1次元で考えて見る。x 軸がidで、100人の人間がいるとする。
次に、10000 の数値をランダムで振り分ける。 方法はランダムで1人選んで+1 する… という行為を10000回繰り返す。

len <- 100
id <- 1:len
y <- numeric(len)

data1 <- data.frame(id, y)
for(i in 1:10000){
    temp <- sample(1:len, 1)
    data1[temp[1],2] <- data1[temp[1],2] + 1
    }

qplot(data = data1, x = id, y = y, stat = "identity", geom="bar")

qplot(data1$y, geom="histogram", binwidth=5)

sortlist_data1 <- order(data1$y, decreasing = T)
ordered_data1 <- data1[sortlist_data1, ]
plot(ordered_data1$y)

mean(data1$y)

## [1] 100

sd(data1$y)

## [1] 9.17066

平均が100、標準偏差が10である正規分布に従う。(と思う。確認必要)

つぎに、以下のように数値の受け渡しをランダムで行う。
方法は、ランダムに2個のid を選択し、片方を+1 しもう片方を-1 する。これを何枚回か繰り返し、再度Barplot する。

この結果、受け渡しを行うとばらつきが大きくなる事がわかった。

次の課題: 受け渡し回数を増やした場合、収束するかどうか、収束するならどのような関数で書けるか、書けない場合なぜ発散するのかを調べる。

data2 <- data1
for(i in 1:100000){
    temp <- sample(1:len,2)
    data2[temp[1],2] <- data2[temp[1],2] - 1
    data2[temp[2],2] <- data2[temp[2],2] + 1
    }

qplot(data = data2, x = id, y = y,stat = "identity", geom="bar")

## Warning in loop_apply(n, do.ply): Stacking not well defined when ymin != 0

sortlist_data2 <- order(data2$y, decreasing = T)
ordered_data2 <- data2[sortlist_data2, ]
plot(ordered_data2$y)

qplot(data2$y, geom="histogram", binwidth=10)

mean(data2$y)

## [1] 100

sd(data2$y)

## [1] 45.48659