htest クラスの結果の日本語化の編集

[[RjpWiki]]

ほとんど冗談でですが。。。

というか，どんな些細なことでも，日本語で書かれていれば。。。ということもあるかもしれない。

ということで，

以下のような関数を定義しておけば，base の統計的検定関数（htest クラスを持つもの）の結果を日本語で表示できます(^_^;)

すべての検定関数，全てのオプション（要するに出力される全ての可能性）について，日本語訳しないといけない。

大本の検定関数を日本語化するという方向性もあるのだけど。修正する関数を局限するという観点からはこの関数だけをいじくる方が良いのかもしれない。（どうなんだろう）

* 関数

print.htest <- function (x, digits = 4, quote = TRUE, prefix = "", ...) 
 {
     conv1 <- function(x) ##### 検定の名称
     {
 #     	print(x)
 	if(any(grep("[0-9]+-sample test for equality of proportions without continuity correction", x))) {
 		x <- "割合の一様性の検定（連続性の補正なし）"
	}
     	else if(any(grep("[0-9]+-sample proportions test without continuity correction", x))) {
 		x <- "割合の検定（連続性の補正なし）"
	}
     	else if (x == "Box-Pierce test") { # Box.test
     		x <- "Box-Pierce検定"
     	}
     	else if (x == "Box-Ljung test") {
     		x <- "Box-Ljung検定"
     	}
     	else if (x == "Phillips-Perron Unit Root Test") { # PP.test
     		x <- "Phillips-Perronの単位根検定"
     	}
     	else if (x == "Ansari-Bradley test") { # ansari.test
     		x <- "アンサリ・ブラドレイ検定"
     	}
      	else if (x == "Bartlett test of homogeneity of variances") { # bartlett.tes
     		x <- "分散の一様性の検定（バートレット検定）"
     	}
    	else if (x == "Exact binomial test") { # binom.test
     		x <- "二項検定"
     	}
     	else if (x == "Pearson's Chi-squared test with Yates' continuity correction") { # chisq.test
     		x <- "ピアソンのカイ二乗検定（イエーツの連続性補正）"
     	}
      	else if (x == "Pearson's Chi-squared test") { # chisq.test
     		x <- "ピアソンのカイ二乗検定（連続性補正なし）"
     	}
    	else if (x == "Chi-squared test for given probabilities") { # chisq.test
     		x <- "理論比が与えられたときのカイ二乗検定（適合度検定）"
     	}
     	else if (x == "Pearson's product-moment correlation") { # cor.test
     		x <- "ピアソンの積率相関係数"
     	}
     	else if (x == "Spearman's rank correlation rho") { # cor.test
     		x <- "スピアマンの順位相関係数"
     	}
     	else if (x == "Kendall's rank correlation tau") { # cor.test
     		x <- "ケンドールの順位相関係数"
     	}
     	else if (x == "Fisher's Exact Test for Count Data") { # fisher.test
     		x <- "計数データにおけるフィッシャーの正確確率検定"
     	}
     	else if (x == "Fligner-Killeen test of homogeneity of variances") { # fligner.test
     		x <- "分散の一様性の検定（Fligner-Killeen検定）"
     	}
     	else if (x == "Friedman rank sum test") { # fredman.test
     		x <- "フリードマン検定"
     	}
     	else if (x == "Kruskal-Wallis rank sum test") { # kruskal.test
     		x <- "クラスカル・ウォリス検定"
     	}
     	else if (x == "Two-sample Kolmogorov-Smirnov test") { # ks.test
     		x <- "二標本コルモゴロフ・スミルノフ検定"
     	}
     	else if (x == "One-sample Kolmogorov-Smirnov test") { # ks.test
     		x <- "一標本コルモゴロフ・スミルノフ検定"
     	}
     	else if (x == "Mantel-Haenszel chi-squared test with continuity correction") { # mantelhaen.test
     		x <- "マンテル・ヘンツェルのカイ二乗検定（連続性の補正）"
     	}
     	else if (x == "Exact conditional test of independence in 2 x 2 x k tables") { # mantelhaen.test
     		x <- "2 x 2 x k 分割表における条件付き独立性の正確検定"
     	}
     	else if (x == "Cochran-Mantel-Haenszel test") { # mantelhaen.test
     		x <- "コクラン・マンテル・ヘンツェル検定"
     	}
     	else if (x == "McNemar's Chi-squared test with continuity correction") { # mcnemar.test
     		x <- "マクネマー検定（連続性の補正）"
     	}
     	else if (x == "Mood two-sample test of scale") { # mood.test
     		x <- "尺度についての二標本ムード検定"
     	}
      	else if (x == "One-way analysis of means") { # oneway.test
     		x <- "一元配置分散分析"
     	}
      	else if (x == "One-way analysis of means (not assuming equal variances)") { # oneway.test
     		x <- "一元配置分散分析（等分散を仮定しない場合）"
     	}
      	else if (x == "Chi-squared Test for Trend in Proportions") { # prop.trend.test
     		x <- "割合の傾向についてのカイ二乗検定（傾向検定）"
     	}
      	else if (x == "Quade test") { # quade.test
     		x <- "Quade検定"
     	}
      	else if (x == "Shapiro-Wilk normality test") { # shapiro.test
     		x <- "シャピロ・ウィルクの正規性検定"
     	}
     	else if (x == "Welch Two Sample t-test") { # t.test
     		x <- "二標本t検定（Welchの方法）"
     	}
     	else if (x ==" Two Sample t-test") { # t.test
     		x <- "二標本t検定（分散が等しいと仮定できるとき）"
     	}
     	else if (x == "One Sample t-test") { # t.test
     		x <- "一標本t検定（母平均の検定）"
     	}
     	else if (x == "Paired t-test") { # t.test
     		x <- "対応のある場合のt検定"
     	}
     	else if (x == "F test to compare two variances") { # var.test
     		x <- "二群の等分散性の検定"
     	}
     	else if (x == "Wilcoxon signed rank test") { # wilcox.test
     		x <- "ウィルコクソンの符号付順位和検定"
     	}
     	else if (x == "Wilcoxon rank sum test") { # wilcox.test
     		x <- "ウィルコクソンの順位和検定（マン・ホイットニーのU検定）"
     	}
     	else if (x == "Wilcoxon rank sum test with continuity correction") { # wilcox.test
     		x <- "ウィルコクソンの順位和検定（連続性の補正）"
     	}
     	else if (x == "Wilcoxon signed rank test with continuity correction") { # wilcox.test
     		x <- "ウィルコクソンの符号付順位和検定（連続性の補正）"
     	}
     	return(x)
     }
     conv2 <- function(x)
     {
     	if (length(x) == 2) {
     		if (x[1] == "num df") {
     			x[1] <- "第1自由度"
     		}
     		if (x[2] == "denom df") {
     			x[2] <- "第2自由度"
     		}
     	}
     	else if (x == "df") {
     		x <- "自由度"
     	}
     	else if (x == "Truncation lag parameter") {
     		x <- "切り捨てラグ・パラメータ"
     	}
     	else if (x == "number of trials") {
     		x <- "試行数"
     	}
     	return(x)
     }
     conv3 <- function(x) ##### 検定対象の名前
     {
     	if (x =="difference in means") {
     		x <- "母平均の差"
     	}
     	else if (x == "mean") {
     		x <- "母平均"
     	}
     	else if (x == "mu") {
     		x <- "母平均"
     	}
     	else if (x == "correlation") {
     		x <- "母相関"
     	}
     	else if (x == "rho") {
     		x <- "母相関（ρ）"
     	}
     	else if (x == "tau") {
     		x <- "母相関（τ）"
     	}
     	else if (x == "probability of success") {
     		x <- "成功確率（母比率）"
     	}
     	else if (x == "ratio of scales") {
     		x <- "尺度の比"
     	}
     	else if (x == "common odds ratio") {
     		x <- "共通オッズ比"
     	}
     	else if (x == "odds ratio") {
     		x <- "オッズ比"
     	}
     	else if (x == "ratio of variances") {
     		x <- "分散比"
     	}
     	return(x)
     }
     conv4 <- function(x) ##### 推定値の名前
     {
     	names(x) <- sub("mean of the differences", "差の平均値", names(x))
     	names(x) <- sub("mean of ", "平均値", names(x))
     	names(x) <- sub("prop ", "割合", names(x))
      	if (any(grep("mean in group [0-9]+", names(x)[1]))) {
     		names(x) <- paste("グループ", 1:length(x), "の平均値", sep="")
     	}
     	names(x) <- sub("cor", "相関係数", names(x))
     	names(x) <- sub("rho", "ρ", names(x))
     	names(x) <- sub("tau", "τ", names(x))
     	names(x) <- sub("probability of success", "成功確率（母比率）", names(x))
     	names(x) <- sub("ratio of scales", "尺度の比", names(x))
     	names(x) <- sub("common odds ratio", "共通オッズ比", names(x))
     	names(x) <- sub("odds ratio", "オッズ比", names(x))
     	names(x) <- sub("ratio of variances", "分散比", names(x))
     	names(x) <- sub("difference in location", "位置母数の差", names(x))
     }
     conv5 <- function(x)
     {
     	if (any(grep(" and ", x))) {
     		return(gsub(" and ", " と ", x))
     	}
     	else if (any(grep(" by ", x))) {
     		y <- unlist(strsplit(x, " "))
     		return(paste(y[1], "を", y[3], "で層別"))
     	}
     	else if (any(grep("null probability", x))) {
     		return(gsub("null probability", "帰無仮説における母比率", x))
     	}
     	else if (any(grep("using scores", x))) {
     		return(gsub("using scores", "使用したスコア", x))
     	}
     	else {
     		return(x)
     	}
     }
     conv6 <- function(x) ##### 検定統計量の名前 STATISTIC
     {
     	if (x == "X-squared") {
     		x <- "カイ二乗値"
     	}
     	else if (x == "t") {
     		x <- "t値"
     	}
     	else if (x == "Z") {
     		x <- "Z値"
     	}
     	else if (x == "Bartlett's K-squared") {
     		x <- "バートレットのK二乗値"
     	}
     	else if (x == "number of successes") {
     		x <- "成功数"
     	}
     	else if (x == "Friedman chi-squared") {
     		x <- "フリードマンのカイ二乗値"
     	}
     	else if (x == "Mantel-Haenszel X-squared") {
     		x <- "マンテル・ヘンツェルのカイ二乗値"
     	}
     	else if (x == "Cochran-Mantel-Haenszel M^2") {
     		x <- "コクラン・マンテル・ヘンツェルのM二乗値"
     	}
     	else if (x == "Fligner-Killeen:med chi-squared") {
     		x <- "Fligner-Killeenのカイ二乗値"
     	}
     	else if (x == "Kruskal-Wallis chi-squared") {
     		x <- "クラスカル・ウォリスのカイ二乗値"
     	}
     	else if (x == "McNemar's chi-squared") {
     		x <- "マクネマーのカイ二乗値"
     	}
     	return(x)
     }
   #  cat("\n")
     #@1
     writeLines(strwrap(conv1(x$method)))
     cat("\n")
     #@5
     cat("データ: ", conv5(x$data.name), "\n")
     out <- character()
     if (!is.null(x$statistic))
         #@6
         out <- c(out, paste(conv6(names(x$statistic)), "=", format(round(x$statistic, 
             4))))
     if (!is.null(x$parameter))
         #@2
         out <- c(out, paste(conv2(names(x$parameter)), "=", format(round(x$parameter, 
             3))))
     if (!is.null(x$p.value)) {
         fp <- format.pval(x$p.value, digits = digits)
         out <- c(out, paste("P値", if (substr(fp, 1, 1) == 
             "<") fp else paste("=", fp)))
     }
     writeLines(strwrap(paste(out, collapse = ", ")))
     if (!is.null(x$alternative)) {
         cat("対立仮説: ")
         if (!is.null(x$null.value)) {
             if (length(x$null.value) == 1) {
                 alt.char <- switch(x$alternative, two.sided = "ではない", 
                   less = "より小さい", greater = "より大きい")
                 #@3
                 cat(conv3(names(x$null.value)), "は，", x$null.value, alt.char, 
                   "\n", sep="")
             }
             else {
                 cat(x$alternative, "\nnull values:\n")
                 print(x$null.value, ...)
             }
         }
         else {
         	alt.char <- switch(x$alternative, two.sided = "等しくない", 
                   less = "小さい", greater = "大きい")
         	cat(alt.char, "\n")
         }
     }
     if (!is.null(x$conf.int)) {
         cat(format(100 * attr(x$conf.int, "conf.level")), "パーセント信頼区間: ", 
             format(c(x$conf.int[1], x$conf.int[2])), "\n")
     }
     if (!is.null(x$estimate)) {
         cat("標本推定値: \n")
         #@4
         names(x$estimate) <- conv4(x$estimate)
         print(x$estimate, ...)
     }
     cat("\n")
     invisible(x)
 }

* 応用例

上の関数を有効にした後。
 t.test(rnorm(10), rnorm(14, mean=0.6))
とすれば，以下のように表示される
 二標本 t 検定（Welchの方法）
 
 データ:  rnorm(10) と rnorm(14, mean = 0.6) 
 t = -1.2367, 自由度 = 19.745, P 値 = 0.2307
 対立仮説: 母平均の差は，0ではない
 95パーセント信頼区間: -1.2538991 0.3209893
 標本推定値: 
        平均値x        平均値y 
 -0.01261903  0.45383583
また，
 t.test(rnorm(100, mean=0.5))
では
 一標本 t 検定（母平均の検定）
 
 データ:  rnorm(100, mean = 0.5) 
 t = 5.2999, 自由度 = 99, P 値 = 7.037e-07
 対立仮説: 母平均は，0ではない
 95パーセント信頼区間: 0.3507048 0.7704521
 標本推定値: 
      平均値x 
 0.5605784

タイムスタンプを変更しない