R言語の練習 - 闘うITエンジニアの覚え書き

Rの練習用に iniファイルを扱うクラスを書いてみた。
※クラスを扱う為、R6を使用。
※forの部分はapply 等でもっと高速化できそう。

library(R6)

Setting <- R6::R6Class(
  "Setting",
  public = list(
    initialize = function(file) {
      private$data <- private$load(file)
    },
    get = function(key){
      invisible(private$data[1,key])
    }
  ),
  private = list(
    data = data.frame(),
    load = function(file) {
      data <- readLines(file)
      data <- data[grep("^[^#]", data)]  # コメント行の除去
      data <- data[data != ""]                 # 空行の除去
      df <- data.frame()
      group <- ""
      for (line in data) {
        if (length(grep("^\\[.+\\]$", line)) > 0) {
          group <- gsub("^\\[(.+)\\]$", "\\1", line)
        }
        keyVal <- unlist(strsplit(line, "="))
        if (length(keyVal)>1) {
          key <- paste(group, ".", keyVal[1], sep="")
          df[1,key] <- keyVal[2]
        }
      }
      invisible(df)
    }
  )
)

test.ini

# テスト用の設定1
[setting1]
var1=111
var2=222
var3=333

# テスト用の設定2
[setting2]
var1=xxx
var2=yyy
var3=zzz

利用例)

> setting <- Setting$new("test.ini")
> print(setting$get("setting1.var1"))
[1] "111"

JavaのHashMapやPythonの辞書型のようなものを書いてみた。

library(R6)

Holder <- R6::R6Class(
  "Holder",
  public = list(
    get = function(key){
      i <- which(private$keyNames == key)
      if (length(i) == 0) {
        return(NULL)
      } else {
        return(private$Objects[[i]])
      }
    },
    set = function(key, val){
      i <- which(private$keyNames == key)
      if (length(i) == 0) {
        private$keyNames <- c(private$keyNames, key)
        i <- length(private$keyNames)
        private$Objects <- append(private$Objects, list(val))
      } else {
        private$Objects[[i]] <- val
      }
    },
    remove = function(key){
      i <- which(private$keyNames == key)
      if (length(i) > 0) {
        private$Objects <- private$Objects[-i]
        private$keyNames <- private$keyNames[-i]
      }
    }
  ),
  private = list(
    # キー名の管理用
    keyNames = c(),
    # 値の管理用(何でも格納できるようにlist型にする)
    Objects = list()
  )
)

#####################################
# 以下、シングルトンに使用できるようにラッパーを用意してみた
# TODO: ただしグローバル変数を利用しているので名前が被ればアウト。
#####################################
getCacheInstance <- function(){
  if (exists("singletonHolder")){
    return(singletonHolder)
  } else {
    singletonHolder <<- Holder$new()
    return(singletonHolder)
  }
}

getCache <- function(key){
  holder <- getCacheInstance()
  return(holder$get(key))
}

setCache <- function(key, val){
  holder <- getCacheInstance()
  holder$set(key, val)
}

removeCache <- function(key){
  holder <- getCacheInstance()
  holder$remove(key)
}

使用例) そのままクラスを使用する場合

> holder <- Holder$new()
> holder$set("str1", "value1")
> holder$set("vec1", c(1,2,3))
> holder$set("df1", data.frame(col1=1:5,col2=11:15))
> 
> holder$get("str1")
[1] "value1"
> holder$remove("str1")
> holder$get("str1")
NULL
> 
> holder$get("vec1")
[1] 1 2 3
> holder$remove("vec1")
> holder$get("vec1")
NULL
> 
> holder$get("df1")
  col1 col2
1    1   11
2    2   12
3    3   13
4    4   14
5    5   15
> holder$remove("df1")
> holder$get("df1")
NULL

使用例) ラッパー経由で使用する場合

> setCache("str1", "value1")
> setCache("vec1", c(1,2,3))
> setCache("df1", data.frame(col1=1:5,col2=11:15))
> 
> getCache("str1")
[1] "value1"
> removeCache("str1")
> getCache("str1")
NULL
> 
> getCache("vec1")
[1] 1 2 3
> removeCache("vec1")
> getCache("vec1")
NULL
> 
> getCache("df1")
  col1 col2
1    1   11
2    2   12
3    3   13
4    4   14
5    5   15
> removeCache("df1")
> getCache("df1")
NULL

繰り返し処理は apply系 や do.call を使用する事で、処理速度が劇的に改善する。
※python で言うと for文を内包表記に置き換える感覚？
以下に for文 と lapply を使ってデータフレームをHTMLに変換する処理を書いて比較してみた。

#
# データフレームをHTMLに変換する(for版)
#
df2htmlNormal <- function(df){

  html <- "<table>\n"

  html <- paste(html, "<thead>\n", "\t<tr>\n", sep="")
  for (name in colnames(df)) {
    html <- paste(html, "\t\t<td>", name, "</td>\n", sep="")
  }
  html <- paste(html, "\t</tr>\n", "</thead>\n", sep="")

  html <- paste(html, "<tbody>\n", sep="")
  for (i in seq(nrow(df))) {
    html <- paste(html, "\t<tr>\n", sep="")
    for (name in colnames(df)) {
      html <- paste(html, "\t\t<td>", df[i, name], "</td>\n", sep="")
    }
    html <- paste(html, "\t</tr>\n", sep="")
  }
  html <- paste(html, "</tbody>\n", sep="")

  html <- paste(html, "</table>\n", sep="")
  return(html)
}

#
# データフレームをHTMLに変換する(lapply版)
#
df2htmlTuning <- function(df){
  
  header <- lapply(colnames(df), function(name){paste("\t\t<td>", name, "</td>\n", sep="")})
  html <- paste("<table>\n",
                "<thead>\n",
                "\t<tr>\n",
                paste(header, collapse=""),
                "\t</tr>\n",
                "</thead>\n",
                sep="")

  tbody <- lapply(seq(nrow(df)), function(i){
    rowdata <- lapply(colnames(df), function(name){ paste("\t\t<td>", as.character(df[i,name]), "</td>\n", sep="") })
    paste("\t<tr>\n", paste(rowdata, collapse=""), "\t</tr>\n", sep="")
  })
  html <- paste(html, "<tbody>\n", paste(tbody, collapse=""), "</tbody>\n", sep="")

  html <- paste(html, "</table>\n", sep="")

  return(html)
}

#
# 比較の実行
#
count <- 1000
df <- data.frame(col1=1:count, col2=count+1:count*2)

stime <- proc.time()
html1 <- df2htmlNormal(df)
print(proc.time() - stime)

stime <- proc.time()
html2 <- df2htmlTuning(df)
print(proc.time() - stime)

if (html1 == html2) {
  message("same html!")
} else {
  warning("not same html")
}
#cat(html1)

結果(2列 * 1,000行)

   ユーザ   システム       経過  
     0.320      0.038      0.357 
   ユーザ   システム       経過  
     0.043      0.002      0.045 
same html!

結果(2列 * 10,000行)

   ユーザ   システム       経過  
    24.069      2.618     26.699 
   ユーザ   システム       経過  
     0.335      0.006      0.340

件数が増えるにつれて、差が顕著に現れるようになる。
上記では lapply のみを使用したが、do.call を使用した場合のサンプルも書いてみたい。
※関連 : Rで複数のCSVを1つのデータフレームに読み込む