1

次のような文字列の大きなベクトルがあります。

d <- c("herb", "market", "merchandise", "fun", "casket93", "old", "herbb", "basket", "bottle", "plastic", "baskket", "markket", "pasword", "plastik", "oldg", "mahagony", "mahaagoni", "sim23", "asket", "trump" )

同じベクトル d から各文字列に対して同様の文字列を取得したくありません。


1. 文字列ごとに、数字が存在する場合やアルファベット文字数が 5 未満の場合に完全一致を強制するなどの特定のルールに基づいて、他のすべての文字列文字列との編集距離を計算します
。文字列とともにデータフレーム dist。
3. 距離 < 3 に基づいて dist をサブセット化します。
4. 同様の文字列を折りたたんで、新しい列として元のデータフレームに追加します。

stringrとstringdistパッケージを使用しています

d <-as.data.frame(d)
M <- nrow(d)
Dist <- data.frame(matrix(nrow=M, ncol=2)) 
colnames(Dist) <- c("string" ,"dist")
Dist$string <- d$d
d$sim <- character(length=M)

require(stringr)
require(stringdist)

for (i in 1:M){
  # if string has digits or is of short size (<5) do exact matching
  if (grepl("[[:digit:]]", d[i, "d"], ignore.case=TRUE) == TRUE || str_count(d[i, "d"], "[[:alpha:]]") < 5){
    Dist$dist <- stringdist(d[i, "d"], d$d, method="lv", maxDist=0.000001) # maxDist as fraction to force exact matching
  # otherwise do approximate matching
  } else  {
    Dist$dist <- stringdist(d[i, "d"], d$d, method="lv", maxDist=3)
  }
  # subset similar strings (with edit distance <3)
  subDist <- subset(Dist, dist < 3 )
  # add to original data.frame d
  d[i, "sim"] <- paste(as.character(unlist(subDist$string)), collapse=", ")
}

ループを使用する代わりに、プロシージャをベクトル化することは可能ですか? 文字列の非常に大きなベクトルがあるためstringdistmatrix、メモリの制限により、ベクトル全体を使用して距離行列を計算することはできません。ループは大きなデータに対しては正常に機能しますが、非常に低速です。

4

2 に答える 2

1

stringdistマトリックス内のすべての距離を計算するためのバージョンがあるため、このようなものが改善されると思います.100回の繰り返しラインを含めて実行すると、コンピューターで約4倍速くなります:

d <- c("herb", "market", "merchandise", "fun", "casket93", "old", "herbb", "basket", "bottle", "plastic", "baskket", "markket", "pasword", "plastik", "oldg", "mahagony", "mahaagoni", "sim23", "asket", "trump" )
#d <- rep(d, each=100) #make it a bit longer for timing

d <-as.data.frame(d)
M <- nrow(d)
Dist <- data.frame(matrix(nrow=M, ncol=2))
colnames(Dist) <- c("string" ,"dist")
Dist$string <- d$d
d$sim <- character(length=M)

require(stringr)
require(stringdist)

ind_short <- grepl("[[:digit:]]", d[i, "d"], ignore.case=TRUE) == TRUE | str_count(d$d, "[[:alpha:]]") < 5

short <- stringdistmatrix(d$d[ind_short], d$d, method="lv", maxDist=0.000001)
long <- stringdistmatrix(d$d[!ind_short], d$d, method="lv", maxDist=3)

d$sim[ind_short] <- apply(short,1,function(x)paste(as.character(unlist(d$d[x<3])), collapse=", "))
d$sim[!ind_short] <- apply(long,1,function(x)paste(as.character(unlist(d$d[x<3])), collapse=", "))

基本的な戦略は、短いコンポーネントと長いコンポーネントに分割し、stringdist の行列形式を使用してから、貼り付けを使用してこれらを折りたたんで、適切な場所に割り当てることです。d$sim

stringdistmatrix()編集して追加:一度にマトリックス全体を操作できないというコメントに照らして、マトリックスで機能するようにchunk_lengthを選択してみてくださいchunk_length*M。もちろん、1 に設定すると、元のベクトル化されていない形式に戻ります。

chunk_length <- 100
ind_short <- grepl("[[:digit:]]", d[i, "d"], ignore.case=TRUE) == TRUE | str_count(d$d, "[[:alpha:]]") < 5
d$iter <- rep(1:M,each=chunk_length,length.out=M)

for (i in unique(d$iter))
{
  in_iter <- (d$iter == i)
  short <- stringdistmatrix(d$d[in_iter & ind_short], d$d, method="lv", maxDist=0.000001)
  long <- stringdistmatrix(d$d[in_iter & !ind_short], d$d, method="lv", maxDist=3)

  if(sum(in_iter & ind_short)==1) short <- t(short)
  if(sum(in_iter & !ind_short)==1) long <- t(long)

  if(sum(in_iter & ind_short)>0) d$sim[in_iter & ind_short] <- apply(short,1,function(x)paste(as.character(unlist(d$d[x<3])), collapse=", "))
  if(sum(in_iter & !ind_short)>0) d$sim[in_iter & !ind_short] <- apply(long,1,function(x)paste(as.character(unlist(d$d[x<3])), collapse=", "))
}
于 2014-05-01T12:57:45.860 に答える
0

それは本当に答えではありませんがagrep、このプロジェクトであなたに役立つかもしれないことに言及するのは良いかもしれないと思いました. 部分的なパターン マッチングを行います。 

> d <- c("herb", "market", "merchandise", "fun", "casket93", 
         "old", "herbb", "basket", "bottle", "plastic", "baskket",
         "markket", "pasword", "plastik", "oldg", "mahagony", 
         "mahaagoni", "sim23", "asket", "trump" )
> agr <- sapply(d, function(x) agrep(x, d, value = TRUE))
> head(agr)
$herb
[1] "herb"  "herbb"

$market
[1] "market"  "markket"

$merchandise
[1] "merchandise"

$fun
[1] "fun"

$casket93
[1] "casket93"

$old
[1] "old"     "pasword" "oldg"
于 2014-05-01T13:57:10.637 に答える