arulesSequenceをWindowsRStudioから呼び出せるように修正するパッチ

わんばんこ、年末も近づいてきてアソシエーション真っ盛りの季節ですね!


さて、RのarulesSequenceパッケージのcspade関数をWindows7でRStudioから呼び出そうとしたところ、エラーになる事象が発生。
同様の事象は海外でも報告されている。(以下のリンクを参照)


http://grokbase.com/t/r/r-help/124gp26w8r/r-system2-and-cspade-on-windows
https://stat.ethz.ch/pipermail/r-help/2012-April/308802.html


特徴的なのは、RStudioから呼び出そうするとエラーになるが、普通のRConsoleから呼び出す時には動くこと。
で、原因調べてみるとcspade内でsystem2コマンドで実行した結果の標準出力の出力先をstdoutオプションで指定できるはずだが、stdout引数で指定された出力先にリダイレクトされていないのが原因の模様。このため、本来Rのテンプディレクトリに出力されているはずの標準出力結果をリダイレクトしたファイルが存在しないと怒られる。

> s<-cspade(zaki, parameter=list(support=0.5), control = list(verbose = TRUE))

parameter specification:
support : 0.5
maxsize :  10
maxlen  :  10

algorithmic control:
bfstype : FALSE
verbose :  TRUE
summary : FALSE

preprocessing ... 1 partition(s), 0 MB [0.02s]
mining transactions ... NA MB [0.01s]
reading sequences ...
 以下にエラー file(con, "r") :  コネクションを開くことができません 
 追加情報:   警告メッセージ: 
In file(con, "r") :
   ファイル 'C:\Users\******\AppData\Local\Temp\Rtmp2VKdgt\cspade16503e135e49.out' を開くことができません: No such file or directory 


でもって、さらに調べてみると、cspadeコードの上部で、この問題に対応できるようにWindowsの場合のsystem2関数を上書きしている。
ただし、GUIがRStudioの場合を考慮していない。このため、RGuiであれば正しく実行できるが、RStudioだと実行できないということになる。


そこで、この問題を解決するためのアドホックパッチを作成した。
下記のコードを実行すれば解決すると思われる。ただし、cspadeではなく、arulesSequencesのcspadeを呼び出すこと。


ポイントは#change modified function's environmentで修正した関数mod.cspadeに対して環境を設定しているところ。
これをしないとcspade内部で.formatSPというエクスポートされていない関数が呼び出せず落ちてしまうので要注意。

> s<-arulesSequences::cspade(zaki, parameter=list(support=0.5), control = list(verbose = TRUE))

parameter specification:
 以下にエラー cat(.formatSP(parameter), sep = "\n") : 
   関数 ".formatSP" を見つけることができませんでした 

パッチ

library(arulesSequences)

#modified cspade
mod.cspade<-function (data, parameter = NULL, control = NULL, tmpdir = tempdir()) 
{
                                   #fix only here
  if (.Platform$OS == "windows" && .Platform$GUI %in% c("Rgui", "RStudio")) 
    system2 <- function(command, args = character(), stdout = "", 
                        ...) {
      if (is.character(stdout) && nzchar(stdout)) {
        args <- c(args, ">", stdout)
        stdout <- NULL
      }
      args <- c("/c", shQuote(command), args)
      command <- Sys.getenv("COMSPEC")
      if (!nzchar(command)) 
        stop("environment variable 'COMSPEC' not set")
      base::system2(command, args = args, stdout = stdout, 
                    ...)
    }
  if (!inherits(data, "transactions")) 
    stop("'data' not of class transactions")
  if (!all(c("sequenceID", "eventID") %in% names(transactionInfo(data)))) 
    stop("slot transactionInfo: missing 'sequenceID' or 'eventID'")
  if (!all(dim(data))) 
    return(new("sequences"))
  parameter <- as(parameter, "SPparameter")
  control <- as(control, "SPcontrol")
  if (control@verbose) {
    t1 <- proc.time()
    cat("\nparameter specification:\n")
    cat(.formatSP(parameter), sep = "\n")
    cat("\nalgorithmic control:\n")
    cat(.formatSP(control), sep = "\n")
    cat("\npreprocessing ...")
  }
  exe <- "bin"
  if (.Platform$r_arch != "") 
    exe <- file.path(exe, .Platform$r_arch)
  exe <- system.file(exe, package = "arulesSequences")
  file <- tempfile(pattern = "cspade", tmpdir)
  on.exit(unlink(paste(file, "*", sep = ".")))
  opt <- ""
  nop <- ceiling((dim(data)[1] + 2 * length(data@data@i)) * 
                   .Machine$sizeof.long/4^10/5)
  if (length(control@memsize)) {
    opt <- paste("-m", control@memsize)
    nop <- ceiling(nop * 32/control@memsize)
  }
  if (length(control@numpart)) {
    if (control@numpart < nop) 
      warning("'numpart' less than recommended")
    nop <- control@numpart
  }
  out <- paste(file, "stdout", sep = ".")
  if (FALSE) {
    asc <- paste(file, "asc", sep = ".")
    write_cspade(data, con = asc)
    if (system2(file.path(exe, "makebin"), args = c(asc, 
                                                    paste(file, "data", sep = "."))) || system2(file.path(exe, 
                                                                                                          "getconf"), args = c("-i", file, "-o", file), stdout = out)) 
      stop("system invocation failed")
    file.append("summary.out", out)
  }
  else makebin(data, file)
  if (system2(file.path(exe, "exttpose"), args = c("-i", file, 
                                                   "-o", file, "-p", nop, opt, "-l -x -s", parameter@support), 
              stdout = out)) 
    stop("system invocation failed")
  file.append("summary.out", out)
  if (length(parameter@maxsize)) 
    opt <- paste(opt, "-Z", parameter@maxsize, collapse = "")
  if (length(parameter@maxlen)) 
    opt <- paste(opt, "-z", parameter@maxlen, collapse = "")
  if (length(parameter@mingap)) 
    opt <- paste(opt, "-l", parameter@mingap, collapse = "")
  if (length(parameter@maxgap)) 
    opt <- paste(opt, "-u", parameter@maxgap, collapse = "")
  if (length(parameter@maxwin)) 
    opt <- paste(opt, "-w", parameter@maxwin, collapse = "")
  if (!length(control@bfstype) || !control@bfstype) 
    opt <- paste(opt, "-r", collapse = "")
  if (control@verbose) {
    t2 <- proc.time()
    du <- sum(file.info(list.files(path = dirname(file), 
                                   pattern = basename(file), full.names = TRUE))$size)
    cat(paste("", nop, "partition(s),", round(du/4^10, digits = 2), 
              "MB"))
    cat(paste(" [", format((t2 - t1)[3], digits = 2, format = "f"), 
              "s]", sep = ""))
    cat("\nmining transactions ...")
  }
  out <- paste(file, "out", sep = ".")
  if (system2(file.path(exe, "spade"), args = c("-i", file, 
                                                "-s", parameter@support, opt, "-e", nop, "-o"), stdout = out)) 
    stop("system invocation failed")
  if (control@verbose) {
    t3 <- proc.time()
    du <- file.info(out)$size
    cat(paste("", round(du/4^10, digits = 2), "MB"))
    cat(paste(" [", format((t3 - t2)[3], digits = 2, format = "f"), 
              "s]", sep = ""))
    cat("\nreading sequences ...")
  }
  out <- read_spade(con = out, labels = itemLabels(data))
  out@info <- c(data = match.call()$data, ntransactions = length(data), 
                out@info, support = parameter@support)
  if (control@verbose) {
    t4 <- proc.time()
    cat(paste(" [", format((t4 - t3)[3], digits = 2, format = "f"), 
              "s]", sep = ""))
    cat("\n\ntotal elapsed time: ", (t4 - t1)[3], "s\n", 
        sep = "")
  }
  if (!control@summary) 
    unlink("summary.out")
  out
}
#change modified function's environment 
environment(mod.cspade)<-environment(cspade)

#unlock and assign
unlockBinding("cspade", getNamespace("arulesSequences"))
assign("cspade", mod.cspade, getNamespace("arulesSequences"))
lockBinding("cspade", getNamespace("arulesSequences")) 

#doing cspade(note:cpade itself does not change.try to call cspade not arulesSequences::cspade)
data(zaki)
s<-arulesSequences::cspade(zaki, parameter=list(support=0.5), control = list(verbose = TRUE))