4

スペースで区切られた要素を含む文字列のセットがあります。どの要素がどの文字列の一部であったかを教えてくれるマトリックスを作成したいと思います。例えば：

""
"A B C"
"D"
"B D"

次のようなものを与える必要があります：

  A B C D
1
2 1 1 1
3       1
4   1   1

今、私は解決策を手に入れましたが、糖蜜のように遅く実行され、それを高速化する方法についてのアイデアが不足しています:

reverseIn <- function(vector, value) {
    return(value %in% vector)
}

buildCategoryMatrix <- function(valueVector) {
    allClasses <- c()
    for(classVec in unique(valueVector)) {
        allClasses <- unique(c(allClasses,
                               strsplit(classVec, " ", fixed=TRUE)[[1]]))
    }

    resMatrix <- matrix(ncol=0, nrow=length(valueVector))
    splitValues <- strsplit(valueVector, " ", fixed=TRUE)

    for(cat in allClasses) {
        if(cat=="") {
            catIsPart <- (valueVector == "")
        } else {
            catIsPart <- sapply(splitValues, reverseIn, cat)
        }
        resMatrix <- cbind(resMatrix, catIsPart)
    }
    colnames(resMatrix) <- allClasses

    return(resMatrix)
}

関数をプロファイリングすると、次のようになります。

$by.self
                  self.time self.pct total.time total.pct
"match"               31.20    34.74      31.24     34.79
"FUN"                 30.26    33.70      74.30     82.74
"lapply"              13.56    15.10      87.86     97.84
"%in%"                12.92    14.39      44.10     49.11

だから私の実際の質問は次のようになります: - %in% 呼び出しを高速化する方法はありますか?

ループに入る前に文字列を因数に変換して、文字列の代わりに数字を一致させようとしましたが、実際には R がクラッシュします。また、部分行列代入 (IE、resMatrix[i,x] <- 1) を試みました。ここで、i は文字列の番号で、x は要素のベクトルです。無限に動き続けるように見えるので、サイコロもありません。

4

3 に答える 3

5

私の「splitstackshape」パッケージの開発バージョンには、次のcharBinaryMatような目的で使用できるヘルパー関数が含まれています。

関数は次のとおりです (CRAN のパッケージのバージョンにはまだ含まれていないため)。

charBinaryMat <- function(listOfValues, fill = NA) {
  lev <- sort(unique(unlist(listOfValues, use.names = FALSE)))
  m <- matrix(fill, nrow = length(listOfValues), ncol = length(lev))
  colnames(m) <- lev
  for (i in 1:nrow(m)) {
    m[i, listOfValues[[i]]] <- 1
  }
  m
}

入力は次の出力であると予想されますstrsplit:

そして、ここでそれが使用されています：

str <- c("" , "A B C" , "D" , "B D" )

## Fill is `NA` by default
charBinaryMat(strsplit(str, " ", fixed=TRUE))
#       A  B  C  D
# [1,] NA NA NA NA
# [2,]  1  1  1 NA
# [3,] NA NA NA  1
# [4,] NA  1 NA  1

## Can easily be set to another value
charBinaryMat(strsplit(str, " ", fixed=TRUE), fill = 0)
#      A B C D
# [1,] 0 0 0 0
# [2,] 1 1 1 0
# [3,] 0 0 0 1
# [4,] 0 1 0 1

ベンチマーク

あなたの質問はより速いアプローチに関するものなので、ベンチマークしましょう。

  1. ベンチマーク用の関数:

    CBM <- function() {
  charBinaryMat(strsplit(str, " ", fixed=TRUE), fill = 0)
}
BCM <- function() {
  buildCategoryMatrix(str)*1L
}
Sapply <- function() {
  y <- unique( unlist( strsplit( str , " " ) ) )
  out <- t(sapply(str, function(x) y %in% unlist(strsplit(x , " " )),
                  USE.NAMES = FALSE )) * 1L
  colnames(out) <- y
  out
}

  2. いくつかのサンプルデータ:

    set.seed(1)
A = sample(10, 100000, replace = TRUE)
str <- sapply(seq_along(A), function(x)
  paste(sample(LETTERS[1:10], A[x]), collapse = " "))
head(str)
# [1] "H G C"               "F H J G"             "H D J A I B"        
# [4] "A C F H J B E G D I" "F C H"               "I C G B J D F A E"

  3. 出力例:

    ## Automatically sorted
head(CBM())
#      A B C D E F G H I J
# [1,] 0 0 1 0 0 0 1 1 0 0
# [2,] 0 0 0 0 0 1 1 1 0 1
# [3,] 1 1 0 1 0 0 0 1 1 1
# [4,] 1 1 1 1 1 1 1 1 1 1
# [5,] 0 0 1 0 0 1 0 1 0 0
# [6,] 1 1 1 1 1 1 1 0 1 1

## Sorting just for comparison
head(BCM())[, LETTERS[1:10]]
#      A B C D E F G H I J
# [1,] 0 0 1 0 0 0 1 1 0 0
# [2,] 0 0 0 0 0 1 1 1 0 1
# [3,] 1 1 0 1 0 0 0 1 1 1
# [4,] 1 1 1 1 1 1 1 1 1 1
# [5,] 0 0 1 0 0 1 0 1 0 0
# [6,] 1 1 1 1 1 1 1 0 1 1

## Sorting just for comparison
head(Sapply())[, LETTERS[1:10]]
#      A B C D E F G H I J
# [1,] 0 0 1 0 0 0 1 1 0 0
# [2,] 0 0 0 0 0 1 1 1 0 1
# [3,] 1 1 0 1 0 0 0 1 1 1
# [4,] 1 1 1 1 1 1 1 1 1 1
# [5,] 0 0 1 0 0 1 0 1 0 0
# [6,] 1 1 1 1 1 1 1 0 1 1

  4. ベンチマーク:

    library(microbenchmark)
microbenchmark(CBM(), BCM(), Sapply(), times=20)
# Unit: milliseconds
#      expr        min         lq     median         uq        max neval
#     CBM()   675.0929   718.3454   777.2423   805.3872   858.6609    20
#     BCM() 11059.6305 11267.9888 11367.3283 11595.1758 11792.5950    20
#  Sapply()  3536.7755  3687.0308  3759.7388  3813.4233  3968.3192    20
于 2013-10-25T16:18:53.667 に答える
2

Here's one way of doing this. There is a lot going on in the line where out is assigned. Basically, we loop over each element of your input vector. We split each element into individual characters, then we look to see which of these is present in a vector of all the unique values in your dataset. This returns either TRUE or FALSE. We use * 1L at the end to turn logical values into integer but you could just wrap the whole thing in as.integer instead. sapply returns the results column-wise but you want them row-wise so we use the transpose function t() to achieve this.

The final line converts to a data.frame and applies column names.

#  Data
str <- c("" , "A B C" , "D" , "B D" )

#  Unique column headers (excluding empty strings as in example)
y <- unique( unlist( strsplit( str , " " ) ) )

#  Results
out <- t( sapply( str , function(x) y %in% unlist( strsplit( x , " " ) ) , USE.NAMES = FALSE ) ) * 1L

#  Combine to a data.frame
setNames( data.frame( out ) , y )
#  A B C D
#1 0 0 0 0
#2 1 1 1 0
#3 0 0 0 1
#4 0 1 0 1
于 2013-10-25T16:10:23.640 に答える