bitWalk's: ヒストグラムの作成

2015-01-03

ヒストグラムの作成

2015 年は、データ解析手段として R をとことん使いこなさなければならない年になりそうです。いくつか頻繁に使うコードについて整理をしておく必要がありそうですので、以前本ブログで紹介したコードについて再整理して再び紹介します。今回はヒストグラムです。以前の記事は下記の通りです。

bitWalk's: ヒストグラムの作成

今回は、ファイル選択ダイアログを加えました。例に使用したデータは sample_hist.csv.zip からダウンロードできるようにしてあります。ご興味があれば、展開してご利用下さい。

require("tcltk")
require("KernSmooth")

###############################################################################
# chart.hist
###############################################################################
chart.hist <- function(tbl, x.val, g.title = "", x.label = "data") {
  x <- sort(tbl[, x.val])
  x.max <- max(x, na.rm = TRUE)
  x.min <- min(x, na.rm = TRUE)
  x.limit <- c(x.min, x.max)

  h <- try(dpih(x))
  if (!is.numeric(h)) {
    h <- 10^round(log(range(x)[2] - range(x)[1]))
  }
  bins <- seq(x.min - h, x.max + h, by = h)

  hist(x, breaks = bins, freq = FALSE,
       main = g.title, xlab = x.label, xlim = x.limit,
       col = "LightBlue", cex.main = 1, family = "mono")
  
  points(x, dnorm(x, mean(x), sd(x), log = FALSE),
         type='l', col = "Magenta", lwd = 1)
  points(density(x), type = 'l', col = "MidnightBlue", lwd = 1)
}

###############################################################################
# open.png
###############################################################################
open.png <- function(imgName, picWidth = 640, picHeight = 400) {
  png(filename = imgName, width = picWidth, height = picHeight, units = "px",
      pointsize = 14, bg = "white", res = NA)
}

###############################################################################
# MAIN
###############################################################################

# READ CSV DATA
file.name<-tclvalue(tkgetOpenFile())
tbl.data <- read.csv(file.name, header = T, as.is = T)

# generate HISTOGRAM
head.x <- names(tbl.data)[1]
title.hist <- paste("SAMPLE (n = ", length(tbl.data[, head.x]), ")", sep = "")
label.x <- "Measurement"
chart.hist(tbl.data, head.x, title.hist, label.x)

# generate PNG FILE
open.png("sample_hist.png")
chart.hist(tbl.data, head.x, title.hist, label.x)
dev.off()

# ---
# END PROGRAM

Fedora での実行例です。

$ R

R version 3.1.2 (2014-10-31) -- "Pumpkin Helmet"
...
（省略）
...
 'q()' と入力すれば R を終了します。 

> source("histogram.R")
 要求されたパッケージ tcltk をロード中です 
 要求されたパッケージ KernSmooth をロード中です 
KernSmooth 2.23 loaded
Copyright M. P. Wand 1997-2009
>

スクリプトを実行するとファイル選択ダイアログが表示されます。