- 追加された行はこの色です。
- 削除された行はこの色です。
#author("2019-04-14T12:02:11+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 >)