R言語　解析結果を自動で色塗りできる関数【エクセル操作不要】

こんにちは、usagi-sanです。

R言語で統計解析を行う際、検定結果がsummary(ans)の中にリストとして格納されているため、検定結果の操作が難しいと思う方が多いと思います。

また結果の表をcsvやexcelに出力できても、有意な変数がどれなのか分からない場合がほとんどです。

今回は、統計検定の結果についてのデータフレームを自動で色塗りする関数を作ってみました。

今回紹介する関数は次の記事のパッケージをインストールすることで利用可能です。また、スクリプトファイルをダウンロードしたい方は、この記事の下のダウンロードリンクからダウンロードしてください。

: R言語　自作パッケージ　UsagiSan
こんにちは、usagi-sanです。 R言語の自作パッケージを紹介します。統計解析のアルバイトをしている中、暇な時間を見つけて自分でパッケージを作ってみました。 Rのパッケージには、統計解析用のパッ ...
続きを見る

自由なメモ

2020-7-28に関数を更新しました。関数のエラーの修正と有意水準の指定、また色塗りの実行時間を考慮し横のずれを修正する機能を無くすオプションも付けました。

2020-9-18にp値に対応する列名を任意に選択できるようにしました。また、各種不具合を修正しました。

自作色塗り関数の紹介

csvやexcelなどの検定結果のファイルをread.tableやread.csvでデータフレームに格納したあと、そのデータフレームを自動で色塗りするプログラムの概要を紹介します。

下のような検定結果のヘッダーと有意な説明変数を自動で色塗りするプログラムです。

色塗り後は次のようになります。

エクセル色塗り

例では、ロジスティック回帰の結果について色塗りをしています。

また、もちろん任意のデータの重回帰分析、ロジスティック回帰、Cox回帰などの様々な検定結果にも適用できます。

また上の画像のように複数の検定結果を一度に色塗りすることも可能です。

さらに上で示しているように、解析結果が横にずれていたり、異なる検定の解析結果を一度に色塗りしたい場合などでも有効です。

関数の使いかた

次に、関数の使いかたを説明をします。

関数のプログラミングコードとともに説明します。

excelColor

次のプログラミングコードは検定結果の色塗りに用います。

ヘッダーと有意水準以下の変数を色塗りしてくれます。

excelColor <- function(dataName, fileName, level = 0.05, pValue = c("Pr(>|z|)", "Pr(>|t|)", "p-value"), significanceColor = "#FFFF00", headerColor = "#92D050", fontSize = 11, fontName = "Yu Gothic", fontColor = "#000000",  intercept = FALSE, adj = TRUE, fileEncoding = "CP932") {
  options(warn = -1)
  if (is.na(dataName)) {
    stop("There is no data-name")
  }
  options(warn = 0)
  if (is.na(fileName)) {
    stop("There is no file-name")
  }
  if (!(is.character(fileName))) {
    stop("The file-name must be character")
  }
  data <- utils::read.table(paste0(dataName, ".csv"), fill = TRUE, header = FALSE, sep = ",", blank.lines.skip = FALSE, fileEncoding = fileEncoding)
  wb <- openxlsx::createWorkbook()
  openxlsx::addWorksheet(wb, "Sheet 1")
  st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize)
  openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1:2, rows = 1:2)
  openxlsx::writeData(wb, sheet = "Sheet 1", x = data, colNames = F, withFilter = F)
  openxlsx::modifyBaseFont(wb, fontSize = fontSize, fontColour = fontColor, fontName = fontName)
  
  init <- initialize(data, pValue, mode = "test")
  tmp <- init$tmp
  tmp2 <- init$tmp2
  green_header <- init$gr_header
  footer <- init$footer
  col_count <- NULL
  col_intercept <- NULL
  table_rightLim <- NULL
  
  options(warn = -1)
  if (length(tmp) == 0) {
    stop("There is no such pvalue' colname")
  }
  options(warn = 0)
  if (adj == TRUE) {
    cols <- getPotision_sigVar_Intercpt_rLim(green_header, data,
                                             pValue, tmp2,  col_count,
                                             col_intercept, table_rightLim)
    col_count <- cols$count
    col_intercept <- cols$intercept
    table_rightLim <- cols$rightLim
    
    #setStyle for headers
    for (i in seq_len(length(green_header))) {
      st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i]:table_rightLim[i], rows = green_header[i])
    }
    
    factor_list <- list(NULL)
    factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)
    
    factor_row <- list(NULL)
    for (i in seq_len(length(factor_list))) {
      bar <-  factor_list[[i]]
      factor_row[[i]] <- bar[as.numeric(data[factor_list[[i]], col_count[i]]) < level]
    }
    
    #removing NA
    factor_row <- removeNA(factor_row, adj)
    
    #write data
    writeDatas(factor_list, data, wb)
    
    #setStyle for significant variables
    st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = significanceColor)
    for (i in seq_len(length(factor_list))) {
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_count[i], rows = factor_row[[i]])
    }
    
    if (intercept == TRUE) {
      for (i in seq_len(length(factor_list))) {
        openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i], rows = factor_row[[i]])
      }
    }else {
      for (i in seq_len(length(factor_list))) {
        openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i], rows = setdiff(factor_row[[i]], green_header[i] + 1))
      }
    }
  }else {
    st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)
    for (k in seq_len(ncol(data))) {
      for (l in seq_len(length(pValue))) {
        if (tmp2[1, k] ==  pValue[l]) {
          col_count[1] <- k
        }
      }
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = k, rows = green_header)
    }
    
    options(warn = -1)
    factor_row <- as.numeric(rownames(data[replace(as.numeric(data[, col_count[1]]) < level, is.na(as.numeric(data[, col_count[1]]) < level), FALSE), ]))
    options(warn = 0)
    
    #removing NA
    factor_row <- removeNA(factor_row, adj)
    
    factor_list <- list(NULL)
    factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)
    
    #write data
    writeDatas(factor_list, data, wb)
    
    st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = significanceColor)
    openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_count[1], rows = factor_row)
    
    if (intercept == TRUE) {
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1, rows = factor_row)
    }else {
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1, rows = setdiff(factor_row, green_header[i] + 1))
    }
  }
  
  openxlsx::saveWorkbook(wb, paste0(fileName, ".xlsx"), overwrite = TRUE)
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

excelColor <- function(dataName, fileName, level = 0.05, pValue = c("Pr(>|z|)", "Pr(>|t|)", "p-value"), significanceColor = "#FFFF00", headerColor = "#92D050", fontSize = 11, fontName = "Yu Gothic", fontColor = "#000000", intercept = FALSE, adj = TRUE, fileEncoding = "CP932") {

options(warn = -1)

if (is.na(dataName)) {

stop("There is no data-name")

}

options(warn = 0)

if (is.na(fileName)) {

stop("There is no file-name")

}

if (!(is.character(fileName))) {

stop("The file-name must be character")

}

data <- utils::read.table(paste0(dataName, ".csv"), fill = TRUE, header = FALSE, sep = ",", blank.lines.skip = FALSE, fileEncoding = fileEncoding)

wb <- openxlsx::createWorkbook()

openxlsx::addWorksheet(wb, "Sheet 1")

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize)

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1:2, rows = 1:2)

openxlsx::writeData(wb, sheet = "Sheet 1", x = data, colNames = F, withFilter = F)

openxlsx::modifyBaseFont(wb, fontSize = fontSize, fontColour = fontColor, fontName = fontName)

init <- initialize(data, pValue, mode = "test")

tmp <- init$tmp

tmp2 <- init$tmp2

green_header <- init$gr_header

footer <- init$footer

col_count <- NULL

col_intercept <- NULL

table_rightLim <- NULL

options(warn = -1)

if (length(tmp) == 0) {

stop("There is no such pvalue' colname")

}

options(warn = 0)

if (adj == TRUE) {

cols <- getPotision_sigVar_Intercpt_rLim(green_header, data,

pValue, tmp2, col_count,

col_intercept, table_rightLim)

col_count <- cols$count

col_intercept <- cols$intercept

table_rightLim <- cols$rightLim

#setStyle for headers

for (i in seq_len(length(green_header))) {

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i]:table_rightLim[i], rows = green_header[i])

}

factor_list <- list(NULL)

factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)

factor_row <- list(NULL)

for (i in seq_len(length(factor_list))) {

bar <- factor_list[[i]]

factor_row[[i]] <- bar[as.numeric(data[factor_list[[i]], col_count[i]]) < level]

}

#removing NA

factor_row <- removeNA(factor_row, adj)

#write data

writeDatas(factor_list, data, wb)

#setStyle for significant variables

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = significanceColor)

for (i in seq_len(length(factor_list))) {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_count[i], rows = factor_row[[i]])

}

if (intercept == TRUE) {

for (i in seq_len(length(factor_list))) {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i], rows = factor_row[[i]])

}

}else {

for (i in seq_len(length(factor_list))) {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i], rows = setdiff(factor_row[[i]], green_header[i] + 1))

}

}else {

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)

for (k in seq_len(ncol(data))) {

for (l in seq_len(length(pValue))) {

if (tmp2[1, k] == pValue[l]) {

col_count[1] <- k

}

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = k, rows = green_header)

}

options(warn = -1)

factor_row <- as.numeric(rownames(data[replace(as.numeric(data[, col_count[1]]) < level, is.na(as.numeric(data[, col_count[1]]) < level), FALSE), ]))

options(warn = 0)

#removing NA

factor_row <- removeNA(factor_row, adj)

factor_list <- list(NULL)

factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)

#write data

writeDatas(factor_list, data, wb)

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = significanceColor)

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_count[1], rows = factor_row)

if (intercept == TRUE) {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1, rows = factor_row)

}else {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1, rows = setdiff(factor_row, green_header[i] + 1))

}

openxlsx::saveWorkbook(wb, paste0(fileName, ".xlsx"), overwrite = TRUE)

}

関数excelColorの引数については以下の表にまとめました。上の画像のように検定結果を色塗りしたい場合はexcelColorを用います。

excelColorの引数
dataName	統計解析の結果が含まれているファイル名（csvのファイルのみ）	fontSize	フォントのサイズ
fileName	色塗り後の解析結果のファイル名	fontName	フォント名
significanceColor	有意な変数の色	fontColor	フォントの色
excelHeadColorColor	解析結果のヘッダーの色	intercept	切片パラメータの色を塗るかどうか（TUREの場合、色が塗られます）
leve	色塗りをする有意水準の基準（level = 0.1だと0.1以下の変数が色塗りの対象となります。）	adj	TRUEの場合、検定結果の横のずれを修正する機能をもつ
pValue	塗りたいp値の列の名前。初期値として、c("Pr(>\|z\|)", "Pr(>\|t\|)", "p-value")のベクトルをもつ。	fileEncoding	ファイルエンコーディング。初期値は"CP932"である。

excelHeadColor

2つ目の関数として、ヘッダーのみを色塗りする関数excelHeadColorを紹介します。

こちらは検定結果ではなく、簡単な集計表のヘッダーの色塗りに用います。

次のプログラミングコードが関数excelHeadColorとなります。

excelHeadColor <- function(dataName, fileName, header, headerColor = "#92D050", fontSize = 11, fontName = "Yu Gothic", fontColor = "#000000", adj = TRUE, fileEncoding = "CP932") {
  options(warn = -1)
  if (is.na(dataName)) {
    stop("There is no data-name")
  }
  options(warn = 0)
  if (is.na(fileName)) {
    stop("There is no file-name")
  }
  if (!(is.character(fileName))) {
    stop("The file-name must be character")
  }
  data <- utils::read.table(paste0(dataName, ".csv"), fill = TRUE, header = FALSE, sep = ",", blank.lines.skip = FALSE, fileEncoding = fileEncoding)
  wb <- openxlsx::createWorkbook()
  openxlsx::addWorksheet(wb, "Sheet 1")
  st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize)
  openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1:2, rows = 1:2)
  openxlsx::writeData(wb, sheet = "Sheet 1", x = data, colNames = F, withFilter = F)
  openxlsx::modifyBaseFont(wb, fontSize = fontSize, fontColour = fontColor, fontName = fontName)
  
  init <- initialize(data, header = header, mode = "header")
  green_header <- init$gr_header
  footer <- init$footer
  col_intercept <- NA
  table_rightLim <- NULL
  
  if (adj == TRUE) {
    cols <- getPosition_intercpt_rightLim(green_header, data, col_intercept, table_rightLim)
    col_intercept <- cols$intercept
    table_rightLim <- cols$rightLim
    
    #setStyle for headers
    for (i in seq_len(length(green_header))) {
      st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i]:table_rightLim[i], rows = green_header[i])
    }
    
    factor_list <- list(NULL)
    factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)
    
    #write data
    writeDatas(factor_list, data, wb)
  }
  else {
    st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)
    for (k in seq_len(ncol(data))) {
      openxlsx::addStyle(wb, "Sheet 1", style = st, cols = k, rows = green_header)
    }
    factor_list <- list(NULL)
    factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)
    
    #write data
    writeDatas(factor_list, data, wb)
  }
  openxlsx::saveWorkbook(wb, paste0(fileName, ".xlsx"), overwrite = TRUE)
}

excelHeadColor <- function(dataName, fileName, header, headerColor = "#92D050", fontSize = 11, fontName = "Yu Gothic", fontColor = "#000000", adj = TRUE, fileEncoding = "CP932") {

options(warn = -1)

if (is.na(dataName)) {

stop("There is no data-name")

}

options(warn = 0)

if (is.na(fileName)) {

stop("There is no file-name")

}

if (!(is.character(fileName))) {

stop("The file-name must be character")

}

data <- utils::read.table(paste0(dataName, ".csv"), fill = TRUE, header = FALSE, sep = ",", blank.lines.skip = FALSE, fileEncoding = fileEncoding)

wb <- openxlsx::createWorkbook()

openxlsx::addWorksheet(wb, "Sheet 1")

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize)

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = 1:2, rows = 1:2)

openxlsx::writeData(wb, sheet = "Sheet 1", x = data, colNames = F, withFilter = F)

openxlsx::modifyBaseFont(wb, fontSize = fontSize, fontColour = fontColor, fontName = fontName)

init <- initialize(data, header = header, mode = "header")

green_header <- init$gr_header

footer <- init$footer

col_intercept <- NA

table_rightLim <- NULL

if (adj == TRUE) {

cols <- getPosition_intercpt_rightLim(green_header, data, col_intercept, table_rightLim)

col_intercept <- cols$intercept

table_rightLim <- cols$rightLim

#setStyle for headers

for (i in seq_len(length(green_header))) {

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = col_intercept[i]:table_rightLim[i], rows = green_header[i])

}

factor_list <- list(NULL)

factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)

#write data

writeDatas(factor_list, data, wb)

}

else {

st <- openxlsx::createStyle(fontName = fontName, fontSize = fontSize, fgFill = headerColor)

for (k in seq_len(ncol(data))) {

openxlsx::addStyle(wb, "Sheet 1", style = st, cols = k, rows = green_header)

}

factor_list <- list(NULL)

factor_list <- mkFactorList(green_header, footer, factor_list, 1, data)

#write data

writeDatas(factor_list, data, wb)

}

openxlsx::saveWorkbook(wb, paste0(fileName, ".xlsx"), overwrite = TRUE)

}

関数excelHeadColorの引数については以下の表にまとめました。

excelHeadColorの引数
dataName	統計解析の結果が含まれているファイル名（csvのファイルのみ）	fontSize	フォントのサイズ
fileName	色塗り後の解析結果のファイル名	fontName	フォント名
excelHeadColor	色塗りするヘッダーに含まれる文字列（列名）	fontColor	フォントの色
excelHeadColorColor	解析結果のヘッダーの色	adj	TRUEの場合、検定結果の横のずれを修正する機能をもつ
fileEncoding	ファイルエンコーディング。初期値は"CP932"。

関数の使用例

最後に使用例をプログラミングコードで紹介します。

excelColor

step
1解析結果を用意する

最初に検定結果を色塗りする関数excelColorの使用例を重回帰分析を例に、見ていきます。

まず、下の重回帰分析の結果の表をcsvに出力する関数を読み込んでください。（.Rをダウンロードもできます。）

reg_fun <- function(data, fileName, dependentVariable = NULL, level = 0.05 ,ci = TRUE ,sigma = FALSE, df = FALSE, R2 = TRUE, R =TRUE , R2.adj =TRUE, R.adj = FALSE, N=TRUE, dcml.plc = 5, AIC = TRUE, BIC = FALSE, append = TRUE){ 　
  if(is.null(dependentVariable)){dependentVariable <- colnames(data)[1]}
  y <- data[,dependentVariable] 
  ans <- lm(y ~., data = data[, setdiff(colnames(data), dependentVariable)]) 
  s.ans <- summary(ans) 
  round(s.ans$coefficient,5)
  coe <- round(s.ans$coefficient,dcml.plc)
  ci <-  round(cbind(s.ans$coefficients[,1]-qt(level/2, s.ans$df[2])*s.ans$coefficients[,2],s.ans$coefficients[,2]+qt(level/2, s.ans$df[2])*s.ans$coefficients[,2]),dcml.plc)
  colnames(ci) <- c(paste0(100-100*level, "%CI.low"), paste0(100-100*level, "%CI.up"))
  res <- cbind(coe, ci)
  
  if(df == TRUE){df <- data.frame(matrix(rep(round(s.ans$df, dcml.plc),nrow(coe)),nrow = 1 ))}
  if(R2 == TRUE){R2 <- round(s.ans$r.squared, dcml.plc)}
  if(R == TRUE){R <- round(sqrt(s.ans$r.squared), dcml.plc)}
  if(R2.adj == TRUE){R2.adj <- round(s.ans$adj.r.squared, dcml.plc)}
  if(R.adj == TRUE){R.adj <- round(sqrt(s.ans$adj.r.squared), dcml.plc)}
  if(AIC == TRUE){AIC <- round(AIC(ans), dcml.plc)}
  if(BIC == TRUE){BIC <- round(BIC(ans), dcml.plc)}
  if(N == TRUE){N <- nrow(data)}
    
  colName <- c("sigma","df","R", "R2", "R.adj", "R2.adj", "AIC", "BIC", "N")
  col_list <-list(sigma,df,R, R2, R.adj, R2.adj, AIC, BIC, N)
  for(i in  1:length(col_list)){
    options(warn=-1)
    if(any(col_list[[i]]) != FALSE){
    res <- cbind(res, col_list[[i]])
    colnames(res)[ncol(res)] <- colName[i] 
    }
    options(warn=0)
  }
  #colnames(res) <- c(colnames(coe), colnames(ci), c("sigma","df","R", "R2", "R.adj", "R2.adj", "AIC", "BIC", "N"))
  fact <- colnames(data)[sapply(data,is.factor) | sapply(data,is.character)]
  
  for(f in fact){
    idx <- grep(paste0("^",f),rownames(coe))
    if(is.na(idx[1])){
      idx <-  grep(paste0("^`",f,"`"),rownames(coe))
    }
    rownames(coe)[idx] <- paste0(rownames(coe)[idx],"(vs ",levels(as.factor(data[,f]))[1],")")
  }
  
  if(nrow(res) >= 2){
    res[2:nrow(res),setdiff(colnames(res), c(colnames(coe),colnames(ci)))] <- ""
  }
  rowName <- data.frame(matrix(colnames(res),nrow=1))
  colnames(rowName) <- colnames(res)
  res <- cbind(c("",rownames(res)) , rbind(rowName, res))
  table <- rbind(c(dependentVariable, rep("", ncol(res)-1)), res, rep("", ncol(res)))
  options(warn=-1)
  write.table(table,paste0(fileName, ".csv"),append=append,sep = ",", row.names=F,col.names=F,fileEncoding="CP932")
  options(warn=0)
}

reg_fun <- function(data, fileName, dependentVariable = NULL, level = 0.05 ,ci = TRUE ,sigma = FALSE, df = FALSE, R2 = TRUE, R =TRUE , R2.adj =TRUE, R.adj = FALSE, N=TRUE, dcml.plc = 5, AIC = TRUE, BIC = FALSE, append = TRUE){ 　

if(is.null(dependentVariable)){dependentVariable <- colnames(data)[1]}

y <- data[,dependentVariable]

ans <- lm(y ~., data = data[, setdiff(colnames(data), dependentVariable)])

s.ans <- summary(ans)

round(s.ans$coefficient,5)

coe <- round(s.ans$coefficient,dcml.plc)

ci <- round(cbind(s.ans$coefficients[,1]-qt(level/2, s.ans$df[2])*s.ans$coefficients[,2],s.ans$coefficients[,2]+qt(level/2, s.ans$df[2])*s.ans$coefficients[,2]),dcml.plc)

colnames(ci) <- c(paste0(100-100*level, "%CI.low"), paste0(100-100*level, "%CI.up"))

res <- cbind(coe, ci)

if(df == TRUE){df <- data.frame(matrix(rep(round(s.ans$df, dcml.plc),nrow(coe)),nrow = 1 ))}

if(R2 == TRUE){R2 <- round(s.ans$r.squared, dcml.plc)}

if(R == TRUE){R <- round(sqrt(s.ans$r.squared), dcml.plc)}

if(R2.adj == TRUE){R2.adj <- round(s.ans$adj.r.squared, dcml.plc)}

if(R.adj == TRUE){R.adj <- round(sqrt(s.ans$adj.r.squared), dcml.plc)}

if(AIC == TRUE){AIC <- round(AIC(ans), dcml.plc)}

if(BIC == TRUE){BIC <- round(BIC(ans), dcml.plc)}

if(N == TRUE){N <- nrow(data)}

colName <- c("sigma","df","R", "R2", "R.adj", "R2.adj", "AIC", "BIC", "N")

col_list <-list(sigma,df,R, R2, R.adj, R2.adj, AIC, BIC, N)

for(i in 1:length(col_list)){

options(warn=-1)

if(any(col_list[[i]]) != FALSE){

res <- cbind(res, col_list[[i]])

colnames(res)[ncol(res)] <- colName[i]

}

options(warn=0)

}

#colnames(res) <- c(colnames(coe), colnames(ci), c("sigma","df","R", "R2", "R.adj", "R2.adj", "AIC", "BIC", "N"))

fact <- colnames(data)[sapply(data,is.factor) | sapply(data,is.character)]

for(f in fact){

idx <- grep(paste0("^",f),rownames(coe))

if(is.na(idx[1])){

idx <- grep(paste0("^`",f,"`"),rownames(coe))

}

rownames(coe)[idx] <- paste0(rownames(coe)[idx],"(vs ",levels(as.factor(data[,f]))[1],")")

}

if(nrow(res) >= 2){

res[2:nrow(res),setdiff(colnames(res), c(colnames(coe),colnames(ci)))] <- ""

}

rowName <- data.frame(matrix(colnames(res),nrow=1))

colnames(rowName) <- colnames(res)

res <- cbind(c("",rownames(res)) , rbind(rowName, res))

table <- rbind(c(dependentVariable, rep("", ncol(res)-1)), res, rep("", ncol(res)))

options(warn=-1)

write.table(table,paste0(fileName, ".csv"),append=append,sep = ",", row.names=F,col.names=F,fileEncoding="CP932")

options(warn=0)

}

関数を読み込んだら、次のように引数を与えます。

reg_fun(iris, "重回帰分析",R=F, R2.adj = F, AIC =F , N=F)

1	reg_fun(iris, "重回帰分析",R=F, R2.adj = F, AIC =F , N=F)

すると下の画像の解析結果が重回帰分析.csvというファイルに出力されます。

重回帰

これで色塗りをする準備が整いました。また、下に検定結果の注意を記したので、実際に使うときは読んでください。

注意ポイント

excelColorに使用できる解析結果は上の画像のように、p値を指す列名（Pr(>|t|)やPr(>|z|)やp.valueなど）をもち、テーブルの左上が空白となっているものとなっています。

先ほど使用した関数reg_funの引数の説明を以下に記します。

回帰分析の結果をまとめたいときに使ってみてください。

data	回帰分析を行うデータ（データフレーム）	R	重相関係数（TRUEとすると結果に出力される）
fileName	解析結果を出力するcsvファイルの名前	R2.adj	自由度調整済み決定係数（TRUEとすると結果に出力される
dependentVariable	目的変数の名前（指定しない場合1列目の名前が目的変数となる）	R.adj	自由度調整済み重相関係数（TRUEとすると結果に出力される）
level	有意水準（指定しない場合0.05）	N	標本数（TRUEとすると結果に出力される）
ci	回帰係数の信頼区間（TRUEとすると結果に出力される）	dcml.plc	出力結果の小数点以下の桁数
sigma	残差の標準偏差（TRUEとすると結果に出力される）	AIC	赤池情報量基準、AIC（TRUEとすると結果に出力される）
df	検定統計量の自由度（TRUEとすると結果に出力される）	BIC	ベイズ情報量基準、BIC（TRUEとすると結果に出力される）
R2	決定係数（TRUEとすると結果に出力される）	append	ファイルのappend機能（TRUEとするとappendされる）

step
2色塗りをしてみる

次に、この出力結果のデータフレームに対して、次を実行します。

関数excelColorはこの記事の下にあるダウンロードリンクから入手してください。

library(openxlsx)

 excelColor("重回帰分析","重回帰分析_色塗り", excelHeadColorColor = "#00B0F0")

library(openxlsx)

excelColor("重回帰分析","重回帰分析_色塗り", excelHeadColorColor = "#00B0F0")

すると、先ほどの重回帰分析.csvの結果のヘッダーと有意な変数に色がついています。

検定結果が断然見やすくなったかと思います。

色塗り

また、検定結果が大量にあり実行時間が長いという方は、関数の引数のadjをadj=FALSEとしてください。

ポイント

引数adj検定がTUREの場合（デフォルトの場合）、結果のテーブルが横方向にずれている場合や異なる横の長さのテーブルに対して、補正し色塗りしてくれますが、FALSEの場合この機能がなくなります。

横のずれを補正する機能はなくなりますが、1時間ほどかかるものが20秒で終わります。

上で説明した通り、異なる横の長さの検定結果が1000~10000個格納されたcsvファイルに使用したい場合は、adjをFALSEにしても、うまく色塗りされないので注意してください。

excelHeadColor

step
1解析結果を用意する

次にヘッダーを色塗りする関数excelHeadColorの使用例をデータirisを例に、見ていきます。

検定結果の色塗りとは違い、集計表などの検定結果以外の任意のテーブルのヘッダー（列名）を色塗りすることができます。

いまずデータirisを次のコードを実行することでcsvにファイルに保存します。

 write.csv(iris, "iris.csv",  quote=F, row.names=F, fileEncoding="CP932")

1	write.csv(iris, "iris.csv", quote=F, row.names=F, fileEncoding="CP932")

上を実行すると、作業ディレクトリ中に"iris.csv"というデータセットirisが入ったcsvファイルが保存されていることが分かります。

これで、色塗りする準備が整いました。次で、この"iris.csv"のヘッダーを色塗りしていきます。

注意ポイント

excelHeadColorに使用できるテーブルは次のステップの画像のように、長方形の形をしたテーブルや左上が空白のテーブルとなっています。

step
2色塗りをしてみる

では、関数excelHeadColorを実行してみます。次のコードを実行してみましょう。

excelHeadColor("iris", "iris", "Sepal.Length")

1	excelHeadColor("iris", "iris", "Sepal.Length")

excelHeadColor色塗り

上の画像のようにデータirisのヘッダーに色が塗られていることが分かります。

エクセルの書式や色を変更したい場合、excelHeadColorで紹介した引数を変更してください。

ポイント

excelColorと同様に、引数adj検定がTUREの場合（デフォルトの場合）、結果のテーブルが横方向にずれている場合や異なる横の長さのテーブルに対して、補正し色塗りしてくれますが、FALSEの場合この機能がなくなります。

excelColorと同様に、テーブルが多い場合は、adjをFALSEにすると実行時間が改善します。

ダウンロード方法

関数excelColor、excelHeadColorのダウンロードリンクを以下に貼ります。上で紹介した重回帰分析の関数reg_funも入っています。

R言語_エクセル色塗り関数　Rスクリプト

1 ファイル 3.79 KB

ダウンロード

まだまだ不具合があると思うので、皆さんからのご意見をお待ちしております。

あと、この関数を含んだパッケージをGigHub上に公開したのでいずれ、その記事も書いていきます。

usagi-san

統計学とゲームとかをメインに解説していくよ。数式とかプログラミングコードにミスがあったり質問があったりする場合はコメントで受け付けます。すぐに対応します。

2024/04/10

【R言語】ベータ関数とガンマ関数　関数beta, gammaの使い方

2024/01/20

【R言語】1標本t検定テンプレートスクリプト

2024/01/10

【統計学】標準偏差の不偏推定量

usagi-sanの記事をもっと見る

-R言語
-R言語, プログラミング, 統計学, 統計解析

comment コメントをキャンセル

: R言語
【R言語】分散が既知のときの母平均の信頼区間
R言語で分散が既知のときの母平均の信頼区間を算出する関数やその実行例について解説します。実行例では、母平均の信頼区間だけでなく母平均の差の信頼区間の求め方について見ていきます。母平均の差の信頼区間の ...

: R言語
R言語　分散分析ANOVAで多群の比較を行う【初心者向け】
こんにちは、usagi-sanです。今回は、前回の2標本検定の続きの3群以上の比較方法について解説していきます。前回の2標本検定の記事が見たい方は、次のリンクをクリックしてください。この記事では ...

: R言語
【R言語】主成分分析　変数の寄与率の計算や次元の削減
R言語で主成分分析を実行する関数やその実行例を解説していきます。多変量解析において各変数の寄与率を調べるためや多変量データの要約に用いられる主成分分析をR言語で実行する流れを詳しくみていきます。実 ...

: R言語
【R言語】棒グラフ・円グラフ・折れ線グラフのプロット
R言語で棒グラフ、円グラフ、折れ線グラフをプロットする方法を紹介します。グラフをプロットするための関数やその実行例について解説します。この記事で扱うプログラミングコードは以下からダウンロードできま ...

: R言語
【R言語】繰り返しの処理　for文・while文・repeat文
R言語で繰り返しの処理を行う方法を解説します。この記事ではfor文、while文、repeat文の使用例について見ていきます。繰り返しの処理の具体例を交えて、R言語のfor文、while文、rep ...

R言語入門　データフレーム練習【初心者向け】

条件付き期待値の補足

R言語 解析結果を自動で色塗りできる関数【エクセル操作不要】

R言語 自作パッケージ UsagiSan

自作色塗り関数の紹介

関数の使いかた

excelColor

excelHeadColor

関数の使用例

excelColor

excelHeadColor

ダウンロード方法

R言語　解析結果を自動で色塗りできる関数【エクセル操作不要】

R言語　自作パッケージ　UsagiSan