R で ピラミッド図 ～少年サッカー データ分析～

データ読み込み

setwd("e:/data")
d <- read.table("stats_all.txt", header=T)

度数分布を得る

d_win  <- subset(d, 勝敗=="勝")
h_win  <- hist(d_win$"自チーム.TOUCH数",  breaks=seq(0, 600, 50))

> h_win
$breaks
 [1]   0  50 100 150 200 250 300 350 400 450 500 550 600

$counts
 [1]  0  0  0  6  6  5 13 13  3  3  0  0

$density
 [1] 0.000000000 0.000000000 0.000000000 0.002448980 0.002448980 0.002040816
 [7] 0.005306122 0.005306122 0.001224490 0.001224490 0.000000000 0.000000000

$mids
 [1]  25  75 125 175 225 275 325 375 425 475 525 575

$xname
[1] "d_win$自チーム.TOUCH数"

$equidist
[1] TRUE

attr(,"class")
[1] "histogram"

d_lose <- subset(d, 勝敗=="負")
h_lose <- hist(d_lose$"自チーム.TOUCH数", breaks=seq(0, 600, 50))

> h_lose
$breaks
 [1]   0  50 100 150 200 250 300 350 400 450 500 550 600

$counts
 [1]  0  0  2  4 10 14 12  5  3  0  0  0

$density
 [1] 0.0000 0.0000 0.0008 0.0016 0.0040 0.0056 0.0048 0.0020 0.0012 0.0000
[11] 0.0000 0.0000

$mids
 [1]  25  75 125 175 225 275 325 375 425 475 525 575

$xname
[1] "d_lose$自チーム.TOUCH数"

$equidist
[1] TRUE

attr(,"class")
[1] "histogram"

度数分布を連結

h_bind <- cbind(h$breaks, h_win$counts, h_lose$counts)
colnames(h_bind) <- c("breaks","counts_win","counts_lose")
d_bind <- data.frame(h_bind)

> d_bind 
   breaks counts_win counts_lose
1       0          0           0
2      50          0           0
3     100          0           2
4     150          6           4
5     200          6          10
6     250          5          14
7     300         13          12
8     350         13           5
9     400          3           3
10    450          3           0
11    500          0           0
12    550          0           0
13    600          0           0

描画

library(ggplot2) 
legend.labels <- c("勝", "敗")
g <- ggplot(d_bind,aes(x=breaks))
g <- g + geom_bar(data=d_bind,aes(y=-d_bind$counts_win,  fill="blue", color="blue"), alpha=0.5,stat = "identity")
g <- g + geom_bar(data=d_bind,aes(y=d_bind$counts_lose,fill="red", color="red"), alpha=0.5, stat = "identity")
g <- g + xlab("10分あたりのボールタッチ回数")
g <- g + ylab("度数")
g <- g + labs(colour="凡例", fill="凡例")
g <- g + scale_color_discrete(labels = legend.labels)
g <- g + scale_fill_discrete(labels = legend.labels)
g <- g + theme_bw()
g <- g + xlim(c(50, 500))
g <- g + ylim(c(-15, 15))
print(g)

上下逆やんって思うでしょ。
ところがどっこい

...省略...
g <- g + coord_flip()
print(g)

ヒストグラムらしく、棒の間を詰める

...省略...
g <- g + geom_bar(data=d_bind,aes(y=-d_bind$counts_win,  fill="blue", color="blue"), alpha=0.5,stat = "identity",width = 50)
g <- g + geom_bar(data=d_bind,aes(y=d_bind$counts_lose,fill="red", color="red"), alpha=0.5, stat = "identity",width = 50)
...省略...

これで、ど？