[２]　度数分布表とヒストグラム

asahi.df <- read.table( "F:\\Rwork\\asahi98.df", header=TRUE )
head( asahi.df )  # 最初の６行を表示
  No  sex age kanji  noun   MVR   VNR demon  past simili color
1  1 <NA>  16 25.53 58.97  5.41 53.62  2.56 33.33      0     0
2  2    M  14 22.55 51.61 32.00 52.08  6.45 72.73      1     0
3  3    F  15 23.39 53.24 16.67 56.76  3.60 53.85      0     1
4  4    M  18 32.30 55.77 13.33 51.72  1.92  0.00      0     0
5  5    F  15 29.28 56.73 12.12 55.93  3.85 28.57      0     0
6  6    M  18 36.74 65.00 11.11 39.56  0.71 25.00      0     0
  onom idiom yoji slength quote kata basic
1    2     0    0   26.25  6.67    4 26.74
2    0     1    0   27.92  5.67    2 24.36
3    0     1    0   35.14  0.81    4 29.31
4    0     0    0   38.30  8.09    2 34.67
5    0     1    0   45.13  4.99    8 28.57
6    0     1    0   52.89  3.15    6 37.35

asahi.df[1, 4]   # 第１行第４列にあるデータを表示
[1] 25.53
asahi.df[2, ]   # 2行目のデータをすべて表示
  No sex age kanji  noun MVR   VNR demon  past simili color onom
2  2   M  14 22.55 51.61  32 52.08  6.45 72.73      1     0    0
  idiom yoji slength quote kata basic
2     1    0   27.92  5.67    2 24.36
asahi.df[, 3]   # 3列目のデータをすべて表示
   [1] 16 14 15 18 15 18 18 19 18 18 17 18 17 15 15 17 18 19 18 14
  [21] 17 18 17 18 16 12 13 15 19 18 17 12 14 16 15 18 14 17 18 16
  [41] 15 18 19 10 18 17 16 16 16 19 17 18 17 14 16 15 18 17 17 12
  [61] 18 13 14 15 19 17 17 17 15 18 18 18 18 17 14 17 15 14 15 15
  [81] 15 14 14 19 15 14 16 15 17 10 14 19 17 19 19 19 15 18 16 16
 [101] 14 15 17 14 18 16 16 12 18 12 17 11 19 17 12 22 24 28 29 25
  ... （以下省略）

asahi.df[1:3, ]  # １〜３行目データ
  No  sex age kanji  noun   MVR   VNR demon  past simili color onom idiom
1  1   16 25.53 58.97  5.41 53.62  2.56 33.33      0     0    2     0
2  2    M  14 22.55 51.61 32.00 52.08  6.45 72.73      1     0    0     1
3  3    F  15 23.39 53.24 16.67 56.76  3.60 53.85      0     1    0     1
  yoji slength quote kata basic
1    0   26.25  6.67    4 26.74
2    0   27.92  5.67    2 24.36
3    0   35.14  0.81    4 29.31
asahi.df[1:3, 2:4]  # １〜３行目の２〜４列目データ
   sex age kanji
1   16 25.53
2    M  14 22.55
3    F  15 23.39

head( asahi.df$kanji )   # kanji列の先頭６データ
[1] 25.53 22.55 23.39 32.30 29.28 36.74
attach( asahi.df )       # データセットを登録
head( kanji )            # 変数名だけ
[1] 25.53 22.55 23.39 32.30 29.28 36.74

# 年齢データのヒストグラムを描画
hist( age, right=FALSE )

# 年齢データのヒストグラムを描画
hist( age, right=FALSE, 
breaks=c( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100 ),
xlim=c( 0, 100 ),
ylim=c( 0, 600 ),
xlab="年齢（歳）",
ylab="頻度（人）",
main="年齢データのヒストグラム" )

c( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100 )
[1] 10  20  30  40  50  60  70  80  90 100
seq( 10, 100, 10 )
[1] 10  20  30  40  50  60  70  80  90 100

age.class <- cut( age, breaks=seq( 10, 100, 10 ), right=FALSE, 
    ordered_result=TRUE )
head( age.class )   # 年齢クラス分けされた先頭６データ
[1] [10,20) [10,20) [10,20) [10,20) [10,20) [10,20)   # いずれも「10以上20未満」のクラス
9 Levels: [10,20) < [20,30) < [30,40) < [40,50) < [50,60) < ... < [90,100)
( age.tab <- table( age.class ) )
age.class
 [10,20)  [20,30)  [30,40)  [40,50)  [50,60)  [60,70)  [70,80)  [80,90) [90,100) 
     115      179      400      407      459      560      274       73        5

# 相対度数rel を計算する
( total <- sum( age.tab ) )
[1] 2472
( rel <- age.tab / total * 100 )
age.class
   [10,20)    [20,30)    [30,40)    [40,50)    [50,60)    [60,70) 
 4.6521036  7.2411003 16.1812298 16.4644013 18.5679612 22.6537217 
   [70,80)    [80,90)   [90,100) 
11.0841424  2.9530744  0.2022654
# 累積相対度数cumを計算する
rel.sum <- 0   # 相対度数合計 rel.sum の値を初期化
n <- length( rel )   # データの数
cum <- numeric( length=n )  # 9個の累積相対度数を入れるベクトル変数
for ( i in 1:n ) {   # relの個数分、処理を繰り返す
    rel.sum <- rel.sum + rel[i]   # 相対度数を累加
    cum[i] <- rel.sum             # 累積の値を格納
}
cum   # 結果を表示
[1]   4.652104  11.893204  28.074434  44.538835  63.106796  85.760518
[7]  96.844660  99.797735 100.000000

cbind( age.tab, rel, cum )
         age.tab        rel        cum
[10,20)      115  4.6521036   4.652104
[20,30)      179  7.2411003  11.893204
[30,40)      400 16.1812298  28.074434
[40,50)      407 16.4644013  44.538835
[50,60)      459 18.5679612  63.106796
[60,70)      560 22.6537217  85.760518
[70,80)      274 11.0841424  96.844660
[80,90)       73  2.9530744  99.797735
[90,100)       5  0.2022654 100.000000
class( age.freq.table )
[1] "matrix"
age.freq.table <- cbind( age.tab, round( rel, 2 ), round( cum, 2 ) )
         age.tab             
[10,20)      115  4.65   4.65
[20,30)      179  7.24  11.89
[30,40)      400 16.18  28.07
[40,50)      407 16.46  44.54
[50,60)      459 18.57  63.11
[60,70)      560 22.65  85.76
[70,80)      274 11.08  96.84
[80,90)       73  2.95  99.80
[90,100)       5  0.20 100.00

rownames( age.freq.table )
[1] "[10,20)"  "[20,30)"  "[30,40)"  "[40,50)"  "[50,60)"  "[60,70)" 
[7] "[70,80)"  "[80,90)"  "[90,100)"
colnames( age.freq.table ) <- c( "freq", "rel.freq", "cumul.freq" )
age.freq.table
 age.freq.table
         freq rel.freq cumul.freq
[10,20)   115     4.65       4.65
[20,30)   179     7.24      11.89
[30,40)   400    16.18      28.07
[40,50)   407    16.46      44.54
[50,60)   459    18.57      63.11
[60,70)   560    22.65      85.76
[70,80)   274    11.08      96.84
[80,90)    73     2.95      99.80
[90,100)    5     0.20     100.00

# 累積相対度数を折れ線グラフに描画する
( xvals <- seq( 15, 95, 10 ) )
[1] 15 25 35 45 55 65 75 85 95
( yvals <- cum )
[1]   4.652104  11.893204  28.074434  44.538835  63.106796  85.760518
[7]  96.844660  99.797735 100.000000
plot( xvals, yvals,    # データを
type="b", pch=1,                         # ○点と線で
xlim=c(0, 100), ylim=c(0,100),           # X軸、Y軸の範囲
xlab="", ylab="",                        # 軸ラベルなし
axes=F )                                 # 軸目盛を自動で描画しない
axis(1, at=xvals, labels=rownames(age.freq.table) ) # X軸目盛を表示
axis(4)                                  # 第２Y軸目盛を表示
box()                                    # グラフ部分を枠線で囲む
title( "年齢データの累積相対頻度" )      # グラフタイトルを追加

# 棒グラフと折れ線グラフを重ね描きする
hist( age, right=FALSE, breaks=seq(10, 100, 10 ), # ヒストグラム
   xlim=c( 0, 100 ), ylim=c( 0, 600 ),            # X, Y軸目盛範囲
   xlab="age", ylab="freq(age.class)",
   axes=FALSE )
axis( 2 )     # グラフ左側に第１Ｙ軸を表示
par( new = T )                                    # 重ね描き宣言
plot( seq( 15, 95, 10 ), cum,                     # 折れ線グラフ
   type="b", pch=1, lwd=2, 
   xlim=c( 0, 100 ), ylim=c( 0, 100 ),
   xlab="", ylab="", axes = FALSE )
axis( 1, at=seq( 15, 95, 10 ), labels=rownames( age.freq.table ) )
axis( 4 )     # グラフ右側に第２Ｙ軸を表示
box()
title( "年齢データのヒストグラムと累積相対度数" )

# ----------- [ freqtable.R ] ---------
# 対象の数量データの度数頻度表と、ヒストグラムと累積頻度をグラフ表示する
# usage: freqtable( target.vector, from, to, by )
# arguments: target.vector=対象となる数量ベクトル変数名
#            from=始点, to=終点, by=クラス幅
# by Kaoru Fukuda, on Dec. 11, 2012

freqtable <- function( target.vector, from, to, by ) {
    # 度数分布表の作成
    res <- cut( target.vector, breaks=seq( from, to, by ), right=FALSE, 
         ordered_result=TRUE )
    res.tab <- table( res )
    total <- sum( res.tab )
    relfreq <- res.tab / total * 100
    rel.sum <- 0
    n <- length( relfreq )
    cumfreq <- numeric( length = n )
	for ( i in 1:n ) {
        rel.sum <- rel.sum + relfreq[i]
        cumfreq[i] <- rel.sum
    }
    freq.tab <- cbind( res.tab, round( relfreq, 2 ), round( cumfreq, 2 ) )
    colnames( freq.tab ) <- c( "freq", "rel.freq", "cumul.freq" )
    print( freq.tab )
    # ヒストグラムと累積相対度数を描画する
    hist.data <- hist( target.vector, right=FALSE, breaks=seq( from, to, by ), 
        xlim=c( from, to ), xlab="", ylab="", main="", axes=F )
    axis( 2 )
    par( new = T )
    mids <- hist.data$mids           # ヒストグラムの棒の中点X座標
    plot( mids, cumfreq, type="b", xlim=c( from, to ), ylim=c( 0, 100 ), 
        xlab="", ylab="", pch=1, lwd=2, axes=F )
    axis( 1, at=mids, labels=rownames( freq.tab ) )
    axis( 4 )
    box()
}

# 漢字率データの度数分布グラフを描画する
summary( kanji )
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  13.93   27.85   31.84   32.22   36.20   54.05
freqtable( kanji, 10, 60, 5 )
title( "漢字率データのヒストグラムと累積相対頻度" )