放送大学

度数分布とその特徴

放送大学「心理統計法」第2章 度数分布とその特徴

「問題解決の数理第6章 在庫管理」ABC分析 にも関連あり

ヒストグラム

1
2
3
4
5
6
7
math<-c(52,50,91,58,81,18,69,94,84,73,71,93,51,89,83,50,71,94,52,89,
92,60,77,70,19,71,51,95,92,5,63,71,88,55,84,74,19,80,54,95,88,32,64,68,88,64,80,73,14,67,49,90,88,48,57,74,48,99,77,44,
77,78,24,23,36,91,67,8,68,62,48,99,78,55,77,66,29,41,38,34,78,21,57,68,69,100,48,99,88,55,77,39,47,20,49,31,88,8,57,39)
#ヒストグラム
#png("hist01.png",width=1000,height=800)
h <- hist(math,breaks=seq(0,100,10),xlab="class",main="ヒストグラム")
#dev.off()

関数histの戻り値を使う

1
2
3
4
5
6
7
8
9
10
library(knitr)
#度数分布表(縦長)
break1<-h$breaks[1:(length(h$breaks)-1)]
break2<-h$breaks[2:length(h$breaks)]
#class分けの表示に工夫が必要
class_names<-paste(break1+1,"～",break2,sep="")
#1～10を0～10に書き換え
class_names[1]<-"0～10"
number_table <- data.frame(class=class_names,freq=h$counts) 
kable(number_table)
class freq
0～10 3
11～20 5
21～30 4
31～40 7
41～50 11
51～60 13
61～70 13
71～80 18
81～90 13
91～100 13 
1
2
3
4
#度数分布表(横長)
number_table2<-t(number_table[,2])
rownames(number_table2)<-"freq";colnames(number_table2)<-t(number_table[,1])
kable(number_table2)

kable関数で打ち出された表に文字列「class」を記入

class 0～10 11～20 21～30 31～40 41～50 51～60 61～70 71～80 81～90 91～100
freq 3 5 4 7 11 13 13 18 13 13

パレート図

その１(qccパッケージのpareto.chart)

1
2
3
4
5
6
library(qcc)
freq<-c(15,2,4,12,1,5,1,3,6,1)
names(freq)<-LETTERS[1:10]
#png("pareto01.png",width=1000,height=800)
pareto.chart(freq,las=1)
#dev.off()

その2(qichartsパッケージのparetochart)

1
2
3
4
5
library(qicharts)
x<-rep(LETTERS[1:10], c(15,2,4,12,1,5,1,3,6,1))
#png("pareto02.png",width=1000,height=800)
paretochart(x,las=1)
#dev.off()

その3(関数を定義して使うときに調整する)

データフレームの１列目：クラスや選択肢、２列目：度数に固定

関数を定義

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#色はお好みで。
abc.chart<-function(df){
#降順にしないときは,行頭に#をつけてコメントアウト
df<-df[order(df[,2],decreasing=T),]
par(mar = c(5,5,4,6))
# barplot関数の戻り値は、各バーの座標位置
barx <- barplot(df[,2],names.arg=df[,1],las=1,ylim=c(0,sum(df[,2])),panel.first=grid(NA,NULL),col="lightblue",ylab="frequency")
lines(barx,cumsum(df[,2]),col="red")
par(xpd=T)
points(barx,cumsum(df[,2]),col="red",pch=20)
par(xpd=F)
abline(h=0.8*sum(df[,2]),col="blue",lty=3)
axis(4,c(0,0.2*sum(df[,2]),0.4*sum(df[,2]),0.6*sum(df[,2]),0.8*sum(df[,2]),sum(df[,2])),c("0%","20%","40%","60%","80%","100%"),las=1)
mtext("累計(パーセント)",4,3)
}

定義したabc.chart関数を使ってグラフ作成

1
2
3
4
5
6
7
選択肢<-LETTERS[1:10]
度数<-c(15,2,4,12,1,5,1,3,6,1)
df<-data.frame(選択肢,度数)
#png("pareto03.png",width=1000,height=800)
abc.chart(df)
title("パレート図")
#dev.off()

abc.chart関数を調整してこの記事の最初で作成したデータフレーム　number_tableをグラフ化

(以下のとおり変更)
並べ替えしない。ヒストグラムの色を変える。折れ線を点線。80%lineを50%lineに。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#色はお好みで。
abc.chart<-function(df){
#降順にしないときは,行頭に#をつけてコメントアウト
#df<-df[order(df[,2],decreasing=T),]
par(mar = c(5,5,4,6))
# barplot関数の戻り値は、各バーの座標位置
barx <- barplot(df[,2],names.arg=df[,1],las=1,ylim=c(0,sum(df[,2])),panel.first=grid(NA,NULL),col="lightgreen",ylab="frequency")
lines(barx,cumsum(df[,2]),col="red",lty=3)
par(xpd=T)
points(barx,cumsum(df[,2]),col="red",pch=20)
par(xpd=F)
abline(h=0.5*sum(df[,2]),col="blue",lty=3)
axis(4,c(0,0.2*sum(df[,2]),0.4*sum(df[,2]),0.6*sum(df[,2]),0.8*sum(df[,2]),sum(df[,2])),c("0%","20%","40%","60%","80%","100%"),las=1)
mtext("累計(パーセント)",4,3)
}

調整して読み込み直したabc.chart関数を使ってグラフ作成

1
2
3
4
#png("pareto04.png",width=1000,height=800)
abc.chart(number_table)
title("ヒストグラムと累計")
#dev.off()