R用のコマンドラインオプションパーサ（PerlのGetopt::Longもどき）を作ってみた
(
)
@y_benjoさんがRのコマンドライン引数関係で苦しんでいらっしゃったので、以前作成した簡単なパーサをブログで公開しようと思いました。
Rのコマンドラインオプションをパースしたいなんて需要があるとは思っていなかったんですが、CRANにgetoptパッケージとoptparseパッケージという凝ったパッケージが存在するではないですか！！
このまま終わるのが悔しかったので、夜な夜なPerlのGetopt::Longに近い挙動を示す関数を作成してみました！！
やっつけで書いたのでコードが汚いですけど一応それなりに動きます！
エラーメッセージ皆無ですけど！
GetoptLong.R
parseSpec <- function(spec) {
vars <- strsplit(spec, "\\|")[[1]]
if (any(grepl("\\s", vars))) {
stop()
}
#lastvar <- sub("([^=:]+)([=:])?", "\\1 \\2 ", vars[length(vars)])
lastvar <- sub("([^=:]+)(=)?", "\\1 \\2 ", vars[length(vars)])
lastvar.elems <- strsplit(lastvar, " ")[[1]]
strlen <- nchar(lastvar.elems[1])
if (substring(lastvar.elems[1], strlen) %in% c("!", "+")) {
opt.class <- substring(lastvar.elems[1], strlen)
vars[length(vars)] <- substr(lastvar.elems[1], 1, strlen - 1)
} else {
vars[length(vars)] <- lastvar.elems[1]
}
if (lastvar.elems[2] != "" && (lastvar.elems[3] == "" || lastvar.elems[3] %in% c("!", "+"))) {
stop()
}
if (length(lastvar.elems) == 3) {
opt.class <- lastvar.elems[3]
} else if (!exists("opt.class")) {
opt.class <- "l"
}
if (!grepl("^[filos+!][@%]?$", opt.class)) {
stop()
}
ret <- rep(opt.class, length(vars))
names(ret) <- vars
return(ret)
}
checkType <- function(value, opt.class) {
type <- substr(opt.class, 1, 1)
if (type == "i" && grepl("^[+-]?\\d+$", value)) {
value <- as.numeric(value)
} else if (type == "f" && grepl("^[+-]?(?:\\d+(?:\\.?\\d*)|\\d*(?:\\.\\d+))$", value)) {
value <- as.numeric(value)
} else if (type == "o" && grepl("^(?:0x\\d+|[+-]?(?:[1-9]\\d*(?:\\.?\\d*)|0?(?:\\.\\d+)))$", value)) {
value <- as.numeric(value)
} else if (type == "o" && grepl("^0\\d+$", value)) {
value <- as.numeric(as.octmode(value))
} else if (type == "s") {
value <- value
} else {
stop()
}
return(value)
}
GetOptions <- function(..., opts = NULL) {
if (length(match.call()) == 1) {
stop("specify at least 1 argument!")
}
func.name <- as.character(match.call()[1])
var.names <- as.character(match.call()[-1]) # parent.frameで代入する変数の名前
spec <- names(substitute(list(...)))[-1]
parsed.spec <- lapply(spec, parseSpec) # 順番にvar.namesに対応するspec
# 最後に指定されたものが適用されるようにrevする
spec.list <- rev(unlist(lapply(spec, parseSpec)))
# spec.list と var.names を対応付ける
# (spec.list の n 番目にマッチするコマンドラインパラメータは var.names[var.spec.map[n]] に代入)
if (is.null(opts)) {
# opts argument is for Unit test
opts <- commandArgs(trailingOnly = TRUE)
} else {
var.names <- var.names[-length(var.names)]
}
var.spec.map <- rev(rep(seq(length(var.names)), sapply(parsed.spec, length)))
i <- 1
ret <- list()
pos <- NULL
while (i <= length(opts)) {
opt <- opts[i]
opt.name <- sub("^--?([^=]+).*", "\\1", opt)
if (opt.name == opt) {
stop()
}
if (substr(opt.name, 1, 2) == "no") {
match.pos <- which(names(spec.list) == substring(opt.name, 3))
match.pos.no <- which(names(spec.list) == opt.name)
if (!(length(match.pos) == 0 || (length(match.pos.no) > 0 && min(match.pos.no) < min(match.pos))) && spec.list[substring(opt.name, 3)] == "!") {
pos <- min(which(names(spec.list) == substring(opt.name, 3)))
#ret[[substring(opt.name, 3)]] <- FALSE
ret[[var.names[var.spec.map[pos]]]] <- FALSE
i <- i + 1
next
}
}
if (!(opt.name %in% names(spec.list))) {
stop()
}
pos <- min(which(names(spec.list) == opt.name))
opt.class <- spec.list[pos]
var.name <- var.names[var.spec.map[pos]]
if (opt.class %in% c("l", "!")) {
ret[[var.name]] <- TRUE
} else if (opt.class == "+") {
ret[[var.name]] <- ifelse(is.null(ret[[var.name]]), 1, ret[[var.name]] + 1)
} else {
value <- sub(".*?=(.+)", "\\1", opt)
if (value == opt) {
# --hoge=hoge ではなく --hoge hoge という指定
i <- i + 1
value <- opts[i]
}
if (nchar(opt.class) == 1) {
ret[[var.name]] <- checkType(value, opt.class)
} else if (substr(opt.class, 2, 2) == "@") {
ret[[var.name]] <- c(ret[[var.name]], checkType(value, opt.class))
} else if (substr(opt.class, 2, 2) == "%") {
keyvalue <- strsplit(value, "=")[[1]]
tmp.value <- checkType(keyvalue[2], opt.class)
names(tmp.value) <- keyvalue[1]
ret[[var.name]] <- c(ret[[var.name]], tmp.value)
}
}
i <- i + 1
}
for (var in names(ret)) {
assign(var, ret[[var]], envir = parent.frame())
}
}
使い方
例えば次のようなファイルがあったとします。
test.R
source("GetoptLong.R")
GetOptions('save.path=s' = save.path)
cat("save.path\n")
print(save.path)
実行！！
$ Rscript test.R --save.path=/tmp
save.path
[1] "/tmp"
save.path に /tmp という文字列が入っていますね！
詳しくはGetopt::Longのドキュメントをご覧ください！
ファジーマッチングに対応していなかったり、連続で値を記述することができなかったりと漏れはだいぶありますが、一晩で作った割にはそれなりに使えるかと思います。
RUnitで一応テスト
RUnit初めて使ってみました！
ちゃんとドキュメント読んでないんで正しい使い方かどうかよくわかりませんが、一応テストできてるっぽいです。
test_GetoptLong.R
test.parseSpec <- function() {
checkEquals(c(hoge = "l"), parseSpec("hoge"))
checkEquals(c(hoge = "!"), parseSpec("hoge!"))
checkEquals(c(hoge = "+"), parseSpec("hoge+"))
checkEquals(c(hoge = "i"), parseSpec("hoge=i"))
checkException(parseSpec("hoge|fuga=s+"))
checkEquals(c(hoge = "s@", fuga = "s@"), parseSpec("hoge|fuga=s@"))
}
test.checkType <- function() {
checkEquals(20, checkType("20", "i")) # integer
checkEquals(16, checkType("020", "o")) # octal
checkEquals(32, checkType("0x20", "o")) # hex
checkEquals("0", checkType("0", "s")) # string
checkException(checkType("0.20", "i"))
checkException(checkType("0x20", "i"))
}
test.GetOptions <- function() {
opts <- c("--hoge=1", "--fuga")
GetOptions('hoge=i'= hogehoge, 'fuga' = fugafuga, opts = opts)
checkEquals(list(1, TRUE), list(hogehoge, fugafuga))
opts <- c("--hoge", "1", "--fuga", "--hoge=2")
GetOptions('hoge=i'= hogehoge, 'fuga' = fugafuga, opts = opts)
checkEquals(list(2, TRUE), list(hogehoge, fugafuga))
opts <- c("--hoge=1", "--fuga", "--hoge=2")
GetOptions('hoge=i@'= hogehoge, 'fuga' = fugafuga, opts = opts)
checkEquals(list(c(1, 2), TRUE), list(hogehoge, fugafuga))
opts <- c("--piyo=1", "--fuga")
GetOptions('hoge|piyo=i@'= hogehoge, 'fuga' = fugafuga, opts = opts)
checkEquals(list(1, TRUE), list(hogehoge, fugafuga))
opts <- c("--piyo=1", "--nofuga")
GetOptions('hoge|piyo=i@'= hogehoge, 'fuga!' = fugafuga, opts = opts)
checkEquals(list(1, FALSE), list(hogehoge, fugafuga))
opts <- c("--piyo=1", "--nofuga")
GetOptions('hoge|piyo=i@'= hogehoge, 'fuga!' = fugafuga, 'nofuga' = piyo, opts = opts)
checkEquals(list(1, TRUE), list(hogehoge, piyo))
checkException(ls(fugafuga))
opts <- c("--piyo=1", "--nofuga")
GetOptions('hoge|piyo=i@'= hogehoge, 'nofuga' = piyo, 'fuga!' = fugafuga, opts = opts)
checkEquals(list(1, FALSE), list(hogehoge, fugafuga))
checkException(ls(piyo))
opts <- c("--piyo", "a=1", "--nofuga", "--hoge", "b=2")
GetOptions('hoge|piyo=i%'= hogehoge, 'fuga!' = fugafuga, opts = opts)
checkEquals(list(c(a = 1, b = 2), FALSE), list(hogehoge, fugafuga))
}
# Getopt::Longメモ
# Getoptions('verbose!' => \$verbose, noverbose => \$noverbose); --noverbose は$noverbose=1
# Getoptions(noverbose => \$noverbose, 'verbose!' => \$verbose); --noverbose は$verbose=0
# GetOptions('fuga' => \$fuga, 'hoge|fuga' =>\$hoge); --fuga は$hoge=1
# GetOptions('hoge|fuga' =>\$hoge, 'fuga' => \$fuga); --fuga は$fuga=1
テスト実行！
> library(RUnit)
> source("GetoptLong.R")
> runTestFile("test_GetoptLong.R")
Executing test function test.checkType ... Error in checkType("0.20", "i") :
Error in checkType("0x20", "i") :
done successfully.
Executing test function test.GetOptions ... Error in as.environment(pos) : invalid object for 'as.environment'
Error in as.environment(pos) : invalid object for 'as.environment'
done successfully.
Executing test function test.parseSpec ... Error in parseSpec("hoge|fuga=s+") :
done successfully.
Number of test functions: 3
Number of errors: 0
Number of failures: 0
以上です！便所さんの出勤時間までに間に合ったでしょうか！？