« 2022年10月 | トップページ | 2022年12月 »
> dtf <- read.csv("table1_1_10.csv", header = TRUE)
> mi <- dtf$midpoint
> fi <- dtf$frequency
> nn <- sum(fi)
> xm <- sum(mi * fi) / nn
> ss2 <- sum((mi - xm) ^ 2 * fi) / nn
> ss <- sqrt(ss2)
> a4 <- sum((mi - xm) ^ 4 * fi) / (nn * ss ^ 4)
> cat(sprintf("尖度 a4 = %f\n", a4))
尖度 a4 = 2.783519
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> xi <- dtf$height
> nn <- length(xi)
> xm <- mean(xi)
> ss <- sqrt((nn - 1) / nn * var(xi))
> a3 <- sum((xi - xm) ^ 3) / (nn * ss ^ 3)
> cat(sprintf("歪度 a3 = %f\n", a3))
歪度 a3 = 0.045148
書籍の計算では、計算途中で適宜切り捨てを行っているらしく、分散や標準偏差はぴったり一致しない。
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> k <- 6
> nn <- nrow(dtf)
> xm <- xv <- double(k)
> xm <- apply(dtf[, -1], 2, mean)
> for (i in 1:k) xv[i] <- sum((dtf[, i + 1] - xm[i]) ^ 2 / nn)
> xs <- sqrt(xv)
> xmin <- apply(dtf[, -1], 2, min)
> xmax <- apply(dtf[, -1], 2, max)
> rdtf <- data.frame(xm, xv, xs, xmin, xmax)
> print(rdtf)
xm xv xs xmin xmax
height 157.775 25.42437 5.042259 143 170
weight 50.475 31.09937 5.576681 38 70
bust 81.870 14.02310 3.744743 71 98
waist 61.570 7.08510 2.661785 56 72
hip 87.135 15.00677 3.873858 78 98
male 175.695 16.24198 4.030133 163 185
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> xi <- dtf$height
> nn <- length(xi)
> xm <- mean(xi)
> ss2 <- sum((xi - xm) ^ 2) / nn
> s2 <- sum((xi - xm) ^ 2) / (nn - 1)
> ss <- sqrt(ss2)
> s <- sqrt(s2)
> cat(sprintf("女子大生200人の身長の標準偏差 S = %.4f\n", ss))
女子大生200人の身長の標準偏差 S = 5.0423
> cat(sprintf("女子大生200人の身長の不偏分散の平方根 s = %.4f\n", s))
女子大生200人の身長の不偏分散の平方根 s = 5.0549
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> xi <- dtf$height
> nn <- length(xi)
> xm <- mean(xi)
> ss2 <- sum((xi - xm) ^ 2) / nn
> s2 <- sum((xi - xm) ^ 2) / (nn - 1)
> cat(sprintf("女子大生200人の身長の分散 S^2 = %.2f\n", ss2))
女子大生200人の身長の分散 S^2 = 25.42
> cat(sprintf("女子大生200人の身長の不偏分散 s^2 = %.2f\n", s2))
女子大生200人の身長の不偏分散 s^2 = 25.55
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> cat(sprintf("%.2f\n", median(dtf$height)))
157.00
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> print(mean(dtf$height))
[1] 157.775
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> bust <- dtf$bust
> w <- 3
> sumn <- length(which(bust > 71 & bust <= 98))
> cumn <- cumrf <- 0.0
> cat("女子大生199人のバストの度数分布表\n")
女子大生199人のバストの度数分布表
> for (i in seq(71, 98 - w, w)) {
+ n <- length(which(bust > i & bust <= i + w))
+ rf <- n / sumn
+ cumn <- cumn + n
+ cumrf <- cumrf + rf
+ cat(sprintf("%d～%d %2d %4.1f%% %3d %5.1f%%\n", i, i + w, n, rf * 100, cumn, cumrf * 100))
+ }
71～74 0 0.0% 0 0.0%
74～77 8 4.0% 8 4.0%
77～80 88 44.2% 96 48.2%
80～83 53 26.6% 149 74.9%
83～86 35 17.6% 184 92.5%
86～89 6 3.0% 190 95.5%
89～92 4 2.0% 194 97.5%
92～95 3 1.5% 197 99.0%
95～98 2 1.0% 199 100.0%
> cat(sprintf("計 %d\n", sumn))
計 199
> hist(dtf$bust, breaks = seq(71, 98, length = 10))
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> weight <- dtf$weight
> w <- (70.0 - 38) / 9
> sumn <- length(which(weight > 38 & weight <= 70.0))
> cumn <- cumrf <- 0.0
> cat("女子大生198人の体重の度数分布表\n")
女子大生198人の体重の度数分布表
> for (i in seq(38, 70 - w, w)) {
+ n <- length(which(weight > i & weight <= i + w))
+ rf <- n / sumn
+ cumn <- cumn + n
+ cumrf <- cumrf + rf
+ cat(sprintf("%.2f～%.2f %2d %4.1f%% %3d %5.1f%%\n", i, i + w, n, rf * 100, cumn, cumrf * 100))
+ }
38.00～41.56 5 2.5% 5 2.5%
41.56～45.11 29 14.6% 34 17.2%
45.11～48.67 47 23.7% 81 40.9%
48.67～52.22 53 26.8% 134 67.7%
52.22～55.78 30 15.2% 164 82.8%
55.78～59.33 20 10.1% 184 92.9%
59.33～62.89 7 3.5% 191 96.5%
62.89～66.44 4 2.0% 195 98.5%
66.44～70.00 3 1.5% 198 100.0%
> cat(sprintf("計 %d\n", sumn))
計 198
> hist(dtf$weight, breaks = seq(38, 70.0, length = 10))
本書では200人分の測定値をまとめているが、pp.10-11で階級に属するのは145～148であれば不等式で145＜x≦148ということと約束しており、測定値に143が1つあり、その約束どおりにすると143は143～146の階級には含まれない。本計算では、その約束に従い計算している。
> dtf <- read.csv("table1_1_1.csv", header = TRUE)
> height <- dtf$height
> w <- (170 - 143) / 9
> sumn <- length(which(height > 143 & height <= 170))
> cumn <- cumrf <- 0.0
> cat("女子大生199人の身長の度数分布表\n")
女子大生199人の身長の度数分布表
> for (i in seq(143, 170 - w, w)) {
+ n <- length(which(height > i & height <= i + w))
+ rf <- n / sumn
+ cumn <- cumn + n
+ cumrf <- cumrf + rf
+ cat(sprintf("%d～%d %2d %4.1f%% %3d %5.1f%%\n", i, i + w, n, rf * 100, cumn, cumrf * 100))
+ }
143～146 2 1.0% 2 1.0%
146～149 5 2.5% 7 3.5%
149～152 17 8.5% 24 12.1%
152～155 41 20.6% 65 32.7%
155～158 47 23.6% 112 56.3%
158～161 37 18.6% 149 74.9%
161～164 30 15.1% 179 89.9%
164～167 12 6.0% 191 96.0%
167～170 8 4.0% 199 100.0%
> cat(sprintf("計 %d\n", sumn))
計 199
> hist(dtf$height, breaks = seq(143, 173, by = 3))
ADOのStreamオブジェクトを使う。以下のようなワークシートを開いた状態で、以下のSubプロシージャを実行する。
Sub StreamWriteTest()
Dim i As Long
Dim s As String
Dim adodbsm As Object
Set adodbsm = CreateObject("ADODB.Stream")
adodbsm.Charset = "utf-8"
adodbsm.Open
For i = 1 To 6
s = ActiveWorkbook.ActiveSheet.Cells(i, 1).Value
adodbsm.WriteText s, 1
Next i
adodbsm.SaveToFile ActiveWorkbook.Path & "\stream.txt", 2
adodbsm.Close
Set adodbsm = Nothing
End Sub
そのブックが置かれたフォルダーに、ファイルstream.txtが作成されて、メモ帳で開くと、中身は以下のようになっているはず。
ABC
123
あいう
辰𠮷𠀋一郎
𩸽（ホッケ）を食べる
𩹉（トビウオ）を捕まえる
そのような機能を実現する演算子や関数はRには標準で搭載されていない。paste関数とrep関数を組み合わせて使う。
> paste(rep("A", 3), collapse = "")
[1] "AAA"
> paste(rep("Abc", 4), collapse = "")
[1] "AbcAbcAbcAbc"
formatメソッドまたは整形済み文字列リテラル（f文字列）を使用する。以下は、数値1.23456789を小数点以下4桁で表示（1.2346、四捨五入の処理により1.2345にはならない）するために、小数点以下4桁の指定（.4f）を、変数で指定した例。
>>> d = 1.23456789
>>> n = 4
>>> print('{:.{}f}'.format(d, n))
1.2346
>>> print(f'{d:.{n}f}')
1.2346
