1

R でナイーブ ベイズのカスタム修正バージョンを作成していますが、処理中のデータのサイズが原因でランタイムの問題が発生しています。それぞれ 95 個の要素を持つ最大 145,000 行を処理する必要があります。現在、次の関数を使用して、単純ベイズの最初のステップを取得しています。

probGen <- function(x, i)
{
  return(1/(sqrt(2*pi*sdBreakdown[i,]^2)
            *exp(-((x - meanBreakdown[i,])^2)/(2*(sdBreakdown[i,]^2)))))
}

この関数の sdBreakdown と meanBreakdown は、考えられる各解の集計値です。適用が実行されるたびに、指定された各列の確率が取得されます。適用は、各行が分類しようとしている別の要素であるマトリックスで次のように実行されます。

test.1 <- t(apply(temp,MARGIN=1,FUN=probGen, 1))
test.2 <- t(apply(temp,MARGIN=1,FUN=probGen, 2))
test.3 <- t(apply(temp,MARGIN=1,FUN=probGen, 3))
test.4 <- t(apply(temp,MARGIN=1,FUN=probGen, 4))
test.5 <- t(apply(temp,MARGIN=1,FUN=probGen, 5))
test.6 <- t(apply(temp,MARGIN=1,FUN=probGen, 6))
test.7 <- t(apply(temp,MARGIN=1,FUN=probGen, 7))
test.8 <- t(apply(temp,MARGIN=1,FUN=probGen, 8))
test.9 <- t(apply(temp,MARGIN=1,FUN=probGen, 9))

これが私が現在各申請者を呼び出す方法です。これにより、可能な分類 1 ～ 9 ごとに各要素の確率が得られます。私は、R をよりよく理解しようとしており、いくつかの潜在的な精度の向上を実験したいので、すぐに使用できる Naive Bayes を使用したくありません。

これをよりタイムリーに実行する方法はわかりませんが、コーディングすると数時間かかり、実行中に他のプロジェクトに積極的に取り組んでいる場合は最大で 7 ～ 8 時間かかることがあります。

編集：

この例のデータを明確にするため。

temp は 145kx95 の行列で、各行は分類される項目で、各列は数値で表される品質です。

meanBreakdown は 9x95 行列で、各行は異なる分類であり、各列は分類の平均品質に対応します。

sdBreakdown は meanBreakdown と同じですが、平均ではなく標準偏差が保存されます。

並列処理は機能するように見えますが、データセットが必要なほど大きいとは思いませんでした (明らかに私が間違っていました)。

編集 2: 完全なコードは次のとおりです。とてつもなく悪いRコードでしたらご容赦ください。私はずっと C の開発者だったので、R は考え方の大きな変化であり、R でほんの一握りの小さなプロジェクトを実行して、詳細を学習しただけです。

training <- read.csv(file = 'data\\train.csv', sep=',', header=T)

negativeOne <- function(x)
{
  x <- pmin(1, x)
  return(1-mean(x))
}

pullZeros <- function(x)
{
  x <- ifelse(x == 0, 1, 0)
  return(mean(x))
}

trainingSet <- function(x)
{
  x <- ifelse(x == 0, NA, x)
  return(mean(x, na.rm=T))
}
trainingSetSd <- function(x)
{
  x <- ifelse(x == 0, NA, x)
  return(sd(x, na.rm=T))
}

positiveBreakDown <- aggregate(x=training[,colnames(training)[grepl("feat",colnames(training))]],
                         by=list(training$target), FUN=trainingSet)

positiveBreakDownSd <- aggregate(x=training[,colnames(training)[grepl("feat",colnames(training))]],
                               by=list(training$target), FUN=trainingSetSd)

negativeBreakDown <- aggregate(x=training[,colnames(training)[grepl("feat",colnames(training))]],
                     by=list(training$target), FUN=negativeOne)

meanBreakdown <- positiveBreakDown[,colnames(positiveBreakDown)[grepl("feat",colnames(positiveBreakDown))]]

sdBreakdown <- positiveBreakDownSd[,colnames(positiveBreakDownSd)[grepl("feat",colnames(positiveBreakDownSd))]]

probGen <- function(x, i)
{
  return(1/(sqrt(2*pi*sdBreakdown[i,]^2)
            *exp(-((x - meanBreakdown[i,])^2)/(2*(sdBreakdown[i,]^2)))))
}

test <-  read.csv(file = 'data\\test.csv', sep=',', header=T)

PosTest <- test[,colnames(test)[grepl("feat",colnames(test))]]


NegTest <- aggregate(x=test[,colnames(test)[grepl("feat",colnames(test))]],
                  by=list(test$id), FUN=pullZeros)

NegTest$Group.1 <- NULL
temp <- PosTest

sweepTest.1 <- t(apply(temp,MARGIN=1,FUN=probGen, 1))
sweepTest.2 <- t(apply(temp,MARGIN=1,FUN=probGen, 2))
sweepTest.3 <- t(apply(temp,MARGIN=1,FUN=probGen, 3))
sweepTest.4 <- t(apply(temp,MARGIN=1,FUN=probGen, 4))
sweepTest.5 <- t(apply(temp,MARGIN=1,FUN=probGen, 5))
sweepTest.6 <- t(apply(temp,MARGIN=1,FUN=probGen, 6))
sweepTest.7 <- t(apply(temp,MARGIN=1,FUN=probGen, 7))
sweepTest.8 <- t(apply(temp,MARGIN=1,FUN=probGen, 8))
sweepTest.9 <- t(apply(temp,MARGIN=1,FUN=probGen, 9))

temp <- NegTest
temp$Group.1 <- NULL

N.sweepTest.1 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[1, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.2 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[2, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.3 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[3, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.4 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[4, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.5 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[5, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.6 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[6, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.7 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[7, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.8 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[8, grepl("feat",colnames(positiveBreakDown))]),`*`)
N.sweepTest.9 <- sweep(as.matrix(temp),MARGIN=2,
                       as.numeric(negativeBreakDown[9, grepl("feat",colnames(positiveBreakDown))]),`*`)


sweepTest.1 <- (-1*(N.sweepTest.1 - 1)*sweepTest.1) + N.sweepTest.1
sweepTest.2 <- (-1*(N.sweepTest.2 - 1)*sweepTest.2) + N.sweepTest.2
sweepTest.3 <- (-1*(N.sweepTest.3 - 1)*sweepTest.3) + N.sweepTest.3
sweepTest.4 <- (-1*(N.sweepTest.4 - 1)*sweepTest.4) + N.sweepTest.4
sweepTest.5 <- (-1*(N.sweepTest.5 - 1)*sweepTest.5) + N.sweepTest.5
sweepTest.6 <- (-1*(N.sweepTest.6 - 1)*sweepTest.6) + N.sweepTest.6
sweepTest.7 <- (-1*(N.sweepTest.7 - 1)*sweepTest.7) + N.sweepTest.7
sweepTest.8 <- (-1*(N.sweepTest.8 - 1)*sweepTest.8) + N.sweepTest.8
sweepTest.9 <- (-1*(N.sweepTest.9 - 1)*sweepTest.9) + N.sweepTest.9

rm(N.sweepTest.1,N.sweepTest.2,N.sweepTest.3,N.sweepTest.4,N.sweepTest.5,N.sweepTest.6,N.sweepTest.7,N.sweepTest.8,N.sweepTest.9)

dist <- 1:9

for(i in 1:9)
{
  dist[i] <- nrow(training[training$target == paste0("Class_",i),])
}

res1 <- dist[1]*apply(t(sweepTest.1), MARGIN=2, FUN=prod)
res2 <- dist[2]*apply(t(sweepTest.2), MARGIN=2, FUN=prod)
res3 <- dist[3]*apply(t(sweepTest.3), MARGIN=2, FUN=prod)
res4 <- dist[4]*apply(t(sweepTest.4), MARGIN=2, FUN=prod)
res5 <- dist[5]*apply(t(sweepTest.5), MARGIN=2, FUN=prod)
res6 <- dist[6]*apply(t(sweepTest.6), MARGIN=2, FUN=prod)
res7 <- dist[7]*apply(t(sweepTest.7), MARGIN=2, FUN=prod)
res8 <- dist[8]*apply(t(sweepTest.8), MARGIN=2, FUN=prod)
res9 <- dist[9]*apply(t(sweepTest.9), MARGIN=2, FUN=prod)

rm(sweepTest.1,sweepTest.2,sweepTest.3,sweepTest.4,sweepTest.5,sweepTest.6,sweepTest.7,sweepTest.8,sweepTest.9)

interRes <- data.frame(Class_1 = res1, Class_2 = res2,Class_3 = res3,
                       Class_4 = res4,Class_5 = res5,Class_6 = res6,
                       Class_7 = res7,Class_8 = res8,Class_9 = res9)


rm(res1,res2,res3,res4,res5,res6,res7,res8,res9)

temp <- apply(t(interRes), MARGIN=2, FUN=sum)

tempRes <- interRes/temp

data<- data.frame(id=test$id)

data <- cbind(data,tempRes)

fname <- file.choose()
write.table(data, fname, row.names=FALSE, sep=",")
4

2 に答える 2

2

コードを適切にベクトル化する必要があります。applyこのような単純な関数を使用すると、基本的に単なるforループを使用する必要がなくなります。

まず、いくつかの偽データを生成します。

rm(list = ls())
set.seed(1)
# Dimensions of data and some faux data
n <- 144000
m <- 95
temp <- matrix(rnorm(n*m), nrow = n, ncol = m)

meanBreakdown <- matrix(seq(-1, 1, l = 9*m), 9, m)  # Matrix of means
sdBreakdown <- matrix(seq(1, 2, l = 9*m), 9, m)  # Matrix of std. deviations

単一のバージョンの時間を計りましょうi = 1。私はそれをより読みやすくするために自由を取りました。また、エラーを見つけたと思います（関数がガウス密度だけの場合）。ともかく、

probGen <- function(x, means, sds) { # NOTE THAT THIS HAS CHANGED
   return(1/sqrt(2*pi*sds^2)*exp(-(1/(2*sds^2))*(x - means)^2) )
}

i <- 1
t1 <- system.time({
  res1 <- t(apply(temp, 1, probGen, mean = meanBreakdown[i,], 
                                    sds = sdBreakdown[i,]))
})
print(res1[1:5, 1:7])
#          [,1]       [,2]        [,3]       [,4]       [,5]      [,6]           [,7]
#[1,] 0.3720575 0.38038806 0.385805475 0.36747185 0.32253028 0.3008070 0.37473829
#[2,] 0.1980087 0.02837476 0.019424716 0.03520653 0.25872889 0.2223151 0.05506068
#[3,] 0.3935892 0.24920567 0.116377580 0.13580043 0.07012818 0.1682480 0.35898510
#[4,] 0.0137505 0.37288236 0.002338961 0.21928922 0.36341271 0.0250388 0.05103852
#[5,] 0.1648476 0.32981193 0.031723978 0.12681473 0.25509082 0.1959218 0.35277957
print(t1)
#   user  system elapsed 
#  3.452   0.205   3.662

これは、行列が R のレプリケーション ルールと共に列優先の方法で格納されることを利用する別のバージョンです。

probGen2 <- function(x, means, sds) {    
  return(t(1/sqrt(2*pi*sds^2)*exp(-(1/(2*sds^2))*(t(x) - means)^2)))
}

i <- 1
t2 <- system.time({
  res2 <- probGen2(x = temp, means = meanBreakdown[i, ],
                             sds = sdBreakdown[i, ])
})
print(res2[1:5, 1:7])
#          [,1]       [,2]        [,3]       [,4]       [,5]      [,6]       [,7]
#[1,] 0.3720575 0.38038806 0.385805475 0.36747185 0.32253028 0.3008070 0.37473829
#[2,] 0.1980087 0.02837476 0.019424716 0.03520653 0.25872889 0.2223151 0.05506068
#[3,] 0.3935892 0.24920567 0.116377580 0.13580043 0.07012818 0.1682480 0.35898510
#[4,] 0.0137505 0.37288236 0.002338961 0.21928922 0.36341271 0.0250388 0.05103852
#[5,] 0.1648476 0.32981193 0.031723978 0.12681473 0.25509082 0.1959218 0.35277957
print(t2)
#   user  system elapsed 
#  0.499   0.014   0.515

ご覧のとおり、いくつかの非常に単純な変更については、すでにかなりの速度向上が見られます。これを並列計算と組み合わせて、さらに高速化することができます。

最後に、すべてが実際に同じであることを確認しましょう。

 all.equal(res1, res2)
 # [1] TRUE
于 2015-03-18T18:13:12.937 に答える
0

parallelパッケージをチェックアウトし、呼び出しを並行して実行しmcmapplyます。書かれているように、コードは順番に実行されます (つまり、2 に進む前に 1 の分類をすべて終了する必要があります)。mclapplyapply

私の理解では、同じデータに対して同じ関数を実行していますが、パラメーターが異なります。複数のapply呼び出しを行うのではなく、機能を使用できるように関数を再構築してみませんかmcmapply- これにより、apply機能を使用できますが、複数のパラメーターを反復処理できます。

于 2015-03-18T17:02:46.907 に答える