![[RjpWiki]](image/../Rlogo.png "[RjpWiki]")
COLOR(green){SIZE(20){データを分析して報告書を作成するまでの作業を支援するプログラム}}~ データを分析して報告書を作成するまでの作業を支援するプログラムを作ってみます。~ バッチ処理システムを作ってみることにしました。~ バッチ用の関数ではありますが，直接に使えば，より柔軟な操作はできるでしょう。 様々な関数をコンソールに入力して結果を得てそれをまとめて報告書を作るのも，結構大変です。なるべく簡単にことをすませたいものです。 出力ファイルのフォーマットとしては，LaTeX と Word とシンプルなテキスト形式を想定しておきましょう。 気が向いたら，日々修正します。 ~ COLOR(red){時限消滅コメント}：力作有難うございます。お願いですが、一部のブラウザでは一行を長くし過ぎると、左端が左の更新情報欄と重なってしまい、読みにくくなります。適当に改行を入れるようにお願いします。} なるほど，参考までに，どのようなプラットフォームのどのようなブラウザでしょうか。バージョンも。 文字サイズを小さくするとか，別のブラウザをお使いいただくというわけにも行かないのでしょうか。 WindowsでIEということなら，最大多数の最大幸福と言うことで屈服しますがあ。(^_^;) #contents ~ ---- *ドライバ コントロール・ステートメント・ファイルの内容を読み，書かれている内容に従って処理を進める，メイン・プログラムです。 R.stat <- function(control.file, output.file=NULL) # 引数は，コントロール・ステートメント・ファイルの名前 { remove.blanks <- function(str) # 文字列から空白を除いて返す関数 { a <- unlist(strsplit(str, "")) paste(a[a != " "], collapse="") } control <- scan(control.file, what="", sep="?n") n.control <- length(control) # default values percent <- "row" chisq <- fisher <- TRUE paren <- TRUE format <- "latex" caption <- label <- "" for (i in 1:n.control) { line <- unlist(strsplit(control[i], " *= *")) # コマンドは command = argument という形式である command <- line[1] arg <- paste(line[2:length(line)]) if (command == "data.file") { # 入力ファイルはとりあえずデータ・フレームに限定する data <- read.table(remove.blanks(arg), header=TRUE) attach(data) # 分析対象変数の指示は，データフ・レームの変数名を使う } else if (command %in% c("format", "output.file", "percent", "chisq", "fisher")) { # 単純なコマンドの解釈 eval(parse(text=paste(command, "<- arg"))) # command という R オブジェクトに arg を付値する } else if (command == "crosstabs") { # クロス集計コマンド pair <- unlist(strsplit(arg, " *by *")) # 集計対象変数は x1, x2, x3... by y1, y2 という形で指定する pair1 <- unlist(strsplit(pair[1], "[ ,]+")) # by はキーワードで変数名に使えない pair2 <- unlist(strsplit(pair[2], "[ ,]+")) for (i in 1:length(pair1)) { for (j in 1:length(pair2)) { caption <- paste(pair1[i], "(row) by ", pair2[j], "(column)", sep="") # 表のタイトル label <- paste(pair1[i], "-/-", pair2[j], sep="") # LaTeX 用の出力で使う ?label{} eval(parse(text=paste("make.report.table(", pair1[i], ", ", pair2[j], " , format=format, percent=percent, label=label , caption=caption, output.file=output.file)"))) } } } } } # R.stat("control.statements") **クロス集計 クロス集計を行うサブ・プログラムです。 ***ソース・プログラム # 2変数を指定して，クロス集計表を作り，列方向か行方向かのパーセントを付加し， # LaTeX ファイルまたはタブ区切りテキストファイルで書き出す。 # # 引数~ # x, y クロス集計する二変数（今のところ整数値）~ # percent=c("row", "column") パーセントを取る方向~ # rownames=NULL 変数xの値ラベル~ # colnames=NULL 変数yの値ラベル~ # format=c("simple", "latex", "word") 出力フォーマット~ # label="" LaTeXの表のラベル~ # caption="" 表のタイトル~ # paren=TRUE Wordフォーマットのときにパーセントをかっこで囲む~ # output.file=NULL sink()で書き出すときのファイル名~ # chisq=TRUE カイ二乗検定の結果も書き出す（2×2分割表のときはFisherの直接確率検定結果も） # make.report.table <- function(x, y, percent=c("row", "column"), rownames=NULL, colnames=NULL, format=c("simple", "latex", "word"), label="", caption="", paren=TRUE, output.file=NULL, chisq=TRUE, Fisher=TRUE) { format <- match.arg(format) tbl <- addmargins(tbl0 <- table(x, y)) nr <- nrow(tbl) nc <- ncol(tbl) if (!is.null(rownames)) { rownames(tbl)[1:(nr-1)] <- rownames } if (!is.null(colnames)) { colnames(tbl)[1:(nc-1)] <- colnames } sufix <- sapply(1:nc, function(i) c(i,i+nc)) pcnt <- if (match.arg(percent) == "row") tbl/tbl[,nc] else t(t(tbl)/tbl[nr,]) tbl <- cbind(tbl, round(pcnt*1000)/10)[,sufix] colnames(tbl) <- c(colnames(tbl)[1:nc*2-1], rep(ifelse(format == "latex", "??%", "%"), nc))[sufix] if (!is.null(output.file)) { sink(output.file, append=TRUE) } if (format == "latex") { # LaTeX 用の出力 cat("%", rep("-", 30), "?n", sep="") cat("??begin{table}[htbp]?n") cat("??begin{center}?n") cat("??caption{",caption, "}?n", sep="") cat("??label{",label, "}?n", sep="") cat("??begin{tabular}{", rep("c", 2*nc+1), "} ??hline?n", sep="") cat("&", paste(colnames(tbl), c(rep("&", nc*2-1), "???? ??hline?n"))) str <- character(2*nc+1) for (i in 1:nr) { str[1] <- sprintf("%s & ", rownames(tbl)[i]) for (j in 1:(nc*2)) { str[j+1] <- if (j %% 2) sprintf("%i & ", as.integer(tbl[i, j])) else sprintf("%.1f %s", tbl[i, j], ifelse(j == 2*nc, "????", "& ")) } cat(paste(str), if (i > nr-2) "??hline ?n" else "?n") } cat("??end{tabular}?n") cat("??end{center}?n") cat("??end{table}?n") } else if (format == "word") { # Word や Excel 用の出力 lparen <- rparen <- "" if (paren) { lparen <- "(" rparen <- ")" } cat("?nTable x. ",caption, "?n", sep="") cat("?t", paste(colnames(tbl), c(rep("?t", nc*2-1), "?n")), sep="") str <- character(2*nc+1) for (i in 1:nr) { str[1] <- sprintf("%s?t", rownames(tbl)[i]) for (j in 1:(nc*2-1)) { str[j+1] <- if (j %% 2) sprintf("%i?t", as.integer(tbl[i, j])) else sprintf("%s%.1f%s?t", lparen, tbl[i, j], rparen) } cat(paste(str), sprintf("%s%.1f%s?n", lparen, tbl[i, nc*2], rparen), sep="") } } else { # 単純な出力 print("----") print(tbl) } if (chisq) { result <- chisq.test(tbl0) cat("Chi-sq. =", result$statistic, ", d.f. =", result$parameter, ", P-value =", result$p.value, "?n") if (result$parameter == 1 && Fisher) { cat("Fisher's exact test. P-value =", fisher.test(tbl0)$p.value, "?n") } } if (!is.null(output.file)) { sink() } invisible(tbl) } ***テスト・データ・ファイル x y z 1 1 5 2 3 4 1 3 4 3 3 1 1 1 1 2 2 2 2 4 1 1 4 5 1 2 1 2 4 5 【以下略】 ***コントロール・ステートメント・ファイル data.file = test.dat output.file = output format = latex label = latex-table percent = row crosstabs = x, y by z format = word percent = column crosstabs = y by z ***出力結果 > R.stat("control.statements") Read 8 items %------------------------------ ?begin{table}[htbp] ?begin{center} ?caption{x(row) by z(column)} ?label{x-/-z} ?begin{tabular}{ccccccccccccc} ?hline & 1 & ?% & 2 & ?% & 3 & ?% & 4 & ?% & 5 & ?% & Sum & ?% ?? ?hline 1 & 33 & 19.9 & 37 & 22.3 & 34 & 20.5 & 29 & 17.5 & 33 & 19.9 & 166 & 100.0 ?? 2 & 21 & 12.8 & 33 & 20.1 & 38 & 23.2 & 36 & 22.0 & 36 & 22.0 & 164 & 100.0 ?? 3 & 31 & 18.2 & 43 & 25.3 & 24 & 14.1 & 36 & 21.2 & 36 & 21.2 & 170 & 100.0 ?? ?hline Sum & 85 & 17.0 & 113 & 22.6 & 96 & 19.2 & 101 & 20.2 & 105 & 21.0 & 500 & 100.0 ?? ?hline ?end{tabular} ?end{center} ?end{table} Chi-sq. = 8.548776 , d.f. = 8 , P-value = 0.3817767 %------------------------------ ?begin{table}[htbp] ?begin{center} ?caption{y(row) by z(column)} ?label{y-/-z} ?begin{tabular}{ccccccccccccc} ?hline & 1 & ?% & 2 & ?% & 3 & ?% & 4 & ?% & 5 & ?% & Sum & ?% ?? ?hline 1 & 22 & 18.6 & 20 & 16.9 & 27 & 22.9 & 20 & 16.9 & 29 & 24.6 & 118 & 100.0 ?? 2 & 16 & 12.2 & 31 & 23.7 & 25 & 19.1 & 28 & 21.4 & 31 & 23.7 & 131 & 100.0 ?? 3 & 26 & 20.8 & 31 & 24.8 & 24 & 19.2 & 24 & 19.2 & 20 & 16.0 & 125 & 100.0 ?? 4 & 21 & 16.7 & 31 & 24.6 & 20 & 15.9 & 29 & 23.0 & 25 & 19.8 & 126 & 100.0 ?? ?hline Sum & 85 & 17.0 & 113 & 22.6 & 96 & 19.2 & 101 & 20.2 & 105 & 21.0 & 500 & 100.0 ?? ?hline ?end{tabular} ?end{center} ?end{table} Chi-sq. = 10.80069 , d.f. = 12 , P-value = 0.5460725 Table x. y(row) by z(column) 1 % 2 % 3 % 4 % 5 % Sum % 1 22 (25.9) 20 (17.7) 27 (28.1) 20 (19.8) 29 (27.6) 118 (23.6) 2 16 (18.8) 31 (27.4) 25 (26.0) 28 (27.7) 31 (29.5) 131 (26.2) 3 26 (30.6) 31 (27.4) 24 (25.0) 24 (23.8) 20 (19.0) 125 (25.0) 4 21 (24.7) 31 (27.4) 20 (20.8) 29 (28.7) 25 (23.8) 126 (25.2) Sum 85 (100.0) 113 (100.0) 96 (100.0) 101 (100.0) 105 (100.0) 500 (100.0) Chi-sq. = 10.80069 , d.f. = 12 , P-value = 0.5460725 LaTeX 出力をタイプセットしたもの #ref(tbl.png)
