#author("2019-04-28T09:41:14+00:00","","") #mynavi(R言語入門) #setlinebreak(on); * 目次 [#v004469d] #contents - 関連 -- [[R言語入門]] -- [[Rで複数のCSVを1つのデータフレームに読み込む]] * 設定ファイルの管理クラス [#e50cd139] #html(<div style="padding-left: 10px;">) Rの練習用に iniファイルを扱うクラスを書いてみた。 ※クラスを扱う為、R6を使用。 ※forの部分はapply 等でもっと高速化できそう。 #mycode2(){{ 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 #mycode2{{ # テスト用の設定1 [setting1] var1=111 var2=222 var3=333 # テスト用の設定2 [setting2] var1=xxx var2=yyy var3=zzz }} 利用例) #myterm2(){{ > setting <- Setting$new("test.ini") > print(setting$get("setting1.var1")) [1] "111" }} #html(</div>) * 連想配列 [#r2634946] #html(<div style="padding-left: 10px;">) JavaのHashMapやPythonの辞書型のようなものを書いてみた。 #mycode2(){{ 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) } }} 使用例) そのままクラスを使用する場合 #myterm2(){{ > 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 }} 使用例) ラッパー経由で使用する場合 #myterm2(){{ > 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 }} #html(</div>) * applyに慣れる [#b1e8097a] #html(<div style="padding-left:10px;">) 繰り返し処理は apply系 や do.call を使用する事で、処理速度が劇的に改善する。 ※python で言うと for文を内包表記に置き換える感覚? 以下に for文 と lapply を使ってデータフレームをHTMLに変換する処理を書いて比較してみた。 #mycode2(){{ # # データフレームを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行) #myterm2(){{ ユーザ システム 経過 0.320 0.038 0.357 ユーザ システム 経過 0.043 0.002 0.045 same html! }} 結果(2列 * 10,000行) #myterm2(){{ ユーザ システム 経過 24.069 2.618 26.699 ユーザ システム 経過 0.335 0.006 0.340 }} 件数が増えるにつれて、差が顕著に現れるようになる。 上記では lapply のみを使用したが、do.call を使用した場合のサンプルも書いてみたい。 ※関連 : [[Rで複数のCSVを1つのデータフレームに読み込む]] #html(</div >)