libsvmに/からデータを読み書きするにはどうすればよいRですか?
形式は次のlibsvmようなスパース データです。
<class/target>[ <attribute number>:<attribute value>]*
(cf. Compressed Row Storage (CRS) ) たとえば、
1 10:3.4 123:0.5 34567:0.231
0.2 22:1 456:03
私は自分で何かを泡立てることができると確信していますが、むしろ既製のものを使用したいと思います. ただし、Rライブラリforeignは必要な機能を提供していないようです。
e1071既製です：install.packages("e1071")
library(e1071)
read.matrix.csr(...)
write.matrix.csr(...)
注：ではなく、で実装されているため、dog-slowです。RC
パッケージe1071のlibsvmへのインターフェースである特別なビネットサポートベクターマシンもあります。
r.vwにバンドルされていますvowpal_wabbit注：ではなく、で実装されているため、dog-slowです。RC
現在、25,000 の観測 (行) を持つデータセットで zygmuntz ソリューションを使用して、ほぼ 5 時間ジョブを実行しています。3k っぽい行を実行しました。その間、私はこれをコード化するのに非常に時間がかかっていました (zygmuntz のコードに基づいて):
require(Matrix)
read.libsvm = function( filename ) {
content = readLines( filename )
num_lines = length( content )
tomakemat = cbind(1:num_lines, -1, substr(content,1,1))
# loop over lines
makemat = rbind(tomakemat,
do.call(rbind,
lapply(1:num_lines, function(i){
# split by spaces, remove lines
line = as.vector( strsplit( content[i], ' ' )[[1]])
cbind(i, t(simplify2array(strsplit(line[-1],
':'))))
})))
class(makemat) = "numeric"
#browser()
yx = sparseMatrix(i = makemat[,1],
j = makemat[,2]+2,
x = makemat[,3])
return( yx )
}
これは、同じマシンで数分で実行されました (zygmuntz ソリューションにもメモリの問題があった可能性がありますが、わかりません)。これが同じ問題を抱えている人に役立つことを願っています。
R で大きな計算を行う必要がある場合は、ベクトル化することを忘れないでください。
編集: 今朝見つけたインデックス作成エラーを修正しました。
私は、いくつかのユーティリティを活用する独自のアドホックソリューションを思いつきました。data.table
私が見つけたテスト データ セット ( Boston Housing data ) では、ほとんどすぐに実行されました。
それをに変換しますdata.table（ソリューションに直交しますが、再現性を高めるためにここに追加します）：
library(data.table)
x = fread("/media/data_drive/housing.data.fw",
sep = "\n", header = FALSE)
#usually fixed-width conversion is harder, but everything here is numeric
columns = c("CRIM", "ZN", "INDUS", "CHAS",
"NOX", "RM", "AGE", "DIS", "RAD",
"TAX", "PTRATIO", "B", "LSTAT", "MEDV")
DT = with(x, fread(paste(gsub("\\s+", "\t", V1), collapse = "\n"),
header = FALSE, sep = "\t",
col.names = columns))
ここにあります：
DT[ , fwrite(as.data.table(paste0(
MEDV, " | ", sapply(transpose(lapply(
names(.SD), function(jj)
paste0(jj, ":", get(jj)))),
paste, collapse = " "))),
"/path/to/output", col.names = FALSE, quote = FALSE),
.SDcols = !"MEDV"]
#what gets sent to as.data.table:
#[1] "24 | CRIM:0.00632 ZN:18 INDUS:2.31 CHAS:0 NOX:0.538 RM:6.575
# AGE:65.2 DIS:4.09 RAD:1 TAX:296 PTRATIO:15.3 B:396.9 LSTAT:4.98 MEDV:24"
#[2] "21.6 | CRIM:0.02731 ZN:0 INDUS:7.07 CHAS:0 NOX:0.469 RM:6.421
# AGE:78.9 DIS:4.9671 RAD:2 TAX:242 PTRATIO:17.8 B:396.9 LSTAT:9.14 MEDV:21.6"
# ...
よりもこれを理解するためのより良い方法があるかもしれませんが、私はそれを考えることができません（ベクトルで動作するまで）。fwriteas.data.tablesetDT
これを複製して、より大きなデータセットでパフォーマンスをテストしました（現在のデータセットを爆破するだけです）：
DT2 = rbindlist(replicate(1000, DT, simplify = FALSE))
ここで報告されているいくつかの時間と比較して、操作はかなり高速でした (まだ直接比較する必要はありません)。
system.time(.)
# user system elapsed
# 8.392 0.000 8.385
writeLinesの代わりに も使用してテストしましfwriteたが、後者の方が優れていました。
もう一度調べてみると、何が起こっているのかを理解するのに時間がかかるかもしれません。おそらくmagrittr-piped バージョンの方がわかりやすいでしょう:
DT[ ,
#1) prepend each column's values with the column name
lapply(names(.SD), function(jj)
paste0(jj, ":", get(jj))) %>%
#2) transpose this list (using data.table's fast tool)
# (was column-wise, now row-wise)
#3) concatenate columns, separated by " "
transpose %>% sapply(paste, collapse = " ") %>%
#4) prepend each row with the target value
# (with Vowpal Wabbit in mind, separate with a pipe)
paste0(MEDV, " | ", .) %>%
#5) convert this to a data.table to use fwrite
as.data.table %>%
#6) fwrite it; exclude nonsense column name,
# and force quotes off
fwrite("/path/to/data",
col.names = FALSE, quote = FALSE),
.SDcols = !"MEDV"]
そのようなファイルの読み取りははるかに簡単です**
#quickly read data; don't split within lines
x = fread("/path/to/data", sep = "\n", header = FALSE)
#tstrsplit is transpose(strsplit(.))
dt1 = x[ , tstrsplit(V1, split = "[| :]+")]
#even columns have variable names
nms = c("target_name",
unlist(dt1[1L, seq(2L, ncol(dt1), by = 2L),
with = FALSE]))
#odd columns have values
DT = dt1[ , seq(1L, ncol(dt1), by = 2L), with = FALSE]
#add meaningful names
setnames(DT, nms)
**これは、「不規則な」/まばらな入力データでは機能しません。そのような場合にこれを拡張して機能させる方法はないと思います。
data.frame を svm light 形式に書き込む関数。データにラベルがない場合に備えて、train={TRUE, FALSE} 引数を追加しました。この場合、クラス インデックスは無視されます。
write.libsvm = function(data, filename= "out.dat", class = 1, train=TRUE) {
out = file(filename)
if(train){
writeLines(apply(data, 1, function(X) {
paste(X[class],
apply(cbind(which(X!=0)[-class],
X[which(X!=0)[-class]]),
1, paste, collapse=":"),
collapse=" ")
}), out)
} else {
# leaves 1 as default for the new data without predictions.
writeLines(apply(data, 1, function(X) {
paste('1',
apply(cbind(which(X!=0), X[which(X!=0)]), 1, paste, collapse=":"),
collapse=" ")
}), out)
}
close(out)
}
** 編集 **
library(data.table)
data.table.fm <- function (data = X, fileName = "../out.fm", target = "y_train",
train = TRUE) {
if (train) {
if (is.logical(data[[target]]) | sum(levels(factor(data[[target]])) ==
levels(factor(c(0, 1)))) == 2) {
data[[target]][data[[target]] == TRUE] = 1
data[[target]][data[[target]] == FALSE] = -1
}
}
specChar = "\\(|\\)|\\||\\:"
specCharSpace = "\\(|\\)|\\||\\:| "
parsingNames <- function(x) {
ret = c()
for (el in x) ret = append(ret, gsub(specCharSpace, "_",
el))
ret
}
parsingVar <- function(x, keepSpace, hard_parse) {
if (!keepSpace)
spch = specCharSpace
else spch = specChar
if (hard_parse)
gsub("(^_( *|_*)+)|(^_$)|(( *|_*)+_$)|( +_+ +)",
" ", gsub(specChar, "_", gsub("(^ +)|( +$)",
"", x)))
else gsub(spch, "_", x)
}
setnames(data, names(data), parsingNames(names(data)))
target = parsingNames(target)
format_vw <- function(column, formater) {
ifelse(as.logical(column), sprintf(formater, j, column),
"")
}
all_vars = names(data)[!names(data) %in% target]
cat("Reordering data.table if class isn't first\n")
target_inx = which(names(data) %in% target)
rest_inx = which(!names(data) %in% target)
cat("Adding Variable names to data.table\n")
for (j in rest_inx) {
column = data[[j]]
formater = "%s:%f"
set(data, i = NULL, j = j, value = format_vw(column,
formater))
cat(sprintf("Fixing %s\n", j))
}
data = data[, c(target_inx, rest_inx), with = FALSE]
drop_extra_space <- function(x) {
gsub(" {1,}", " ", x)
}
cat("Pasting data - Removing extra spaces\n")
data = apply(data, 1, function(x) drop_extra_space(paste(x,
collapse = " ")))
cat("Writing to disk\n")
write.table(data, file = fileName, sep = " ", row.names = FALSE,
col.names = FALSE, quote = FALSE)
}
次の関数と例を試してください。
最初に R データを別の形式に変換し、次に LIBSVM に変換します。
私のデータ セットは 200K x 500 で、これには 3 ～ 5 分しかかかりませんでした。