get.factor <- function(x, minx, maxx)
{
for (i in c(1:10, -1:-10)) {
ll <- trunc(maxx*10^i)-trunc(minx*10^i)
if (ll >= 2 && ll < 19) {
return(10^i)
}
}
return(1)
}
# f は小数点の移動（元の値を10^f倍した整数部をstemにする）
my.stem <- function(d, f=-99)
{
DUMMY <- 99 # ダミーの leaf
MINUS <- -0.1 # -0.xxx などの stem
f <- ifelse(f == -99, get.factor(d, min(d), max(d)), 10^f)
temp <- trunc(d*f*10)
stem <- trunc(temp/10)
leaf <- abs(temp)-abs(stem*10)
stem <- ifelse(stem == 0, ifelse(d > 0, 0, MINUS), stem)
# 跳んでいる stem を補間する
min.stem <- min(stem)
max.stem <- max(stem)
stem <- c(stem, min.stem:max.stem)
leaf <- c(leaf, rep(DUMMY, max.stem-min.stem+1))
# -0.xxx と +0.yyy が存在しうるとき
if (max.stem > 0 && min.stem < 0) {
stem <- c(stem, MINUS)
leaf <- c(leaf, DUMMY)
}
res <- table(stem,leaf)
sapply(1:nrow(res),
function(i) {
stem.temp <- dimnames(res)$stem[i]
cat(ifelse(as.numeric(stem.temp) == MINUS, "-0", stem.temp), "| ")
sapply(1:ncol(res),
function(le) {
if (dimnames(res)$leaf[le] != DUMMY) {
sapply(rep(dimnames(res)$leaf[le], res[i,le]), cat)
}
}
)
cat("\n")
}
)
cat("stem * ", 1/f, "\n")
}