3

Rで次の問題があります（マルコフ連鎖の場合）。一意の整数ベクトル（状態）の行を持つ状態空間行列Sがあるとします。この行列からベクトルsが与えられ、このベクトルに対応する行のインデックスを決定したいと思います。いくつかの解決策があります：

  1. 次のように使用するソリューションall.equal：

    which(apply(S,1,function(x){ isTRUE(all.equal(s,x)) }) )

  2. ベクトルを一意の文字列にマップし、次の文字列で識別します。

    statecodes <- apply(S,1,function(x) paste(x,collapse=" ") ) 
check.equal <- function(s) {
    z <- which(statecodes == paste(s, collapse=" "))
    return(z)
}
check.equal(s)

最初の（しばしば提案される）解決策は実にひどいものです。長さ4の16,000個のベクトルの状態空間ではすでに2.16秒かかります。2番目のソリューションははるかに高速で、同じ状態空間で0〜0.01秒かかります。ただし、ベクトルの長さが長くなると、速度はますます遅くなります。私の文字列の方法は合理的だと思いますが、もっと良いものがあるはずです。そのような比較を行うためのより迅速な方法は何でしょうか？

完全を期すために、私の問題の状態空間は次のように生成できます。ベクトルにN個の要素があり、Iがベクトルの各要素が達成できる最大値（たとえば、10）を表す場合、次の式で与えられます。

I <- rep(10,N)
S <- as.matrix(expand.grid( lapply(1:N, function(i) { 0:I[i]}) ) )

可能な限り迅速に比較するために、状態の完全性をどのように活用できますか？

4

2 に答える 2

3

これを行う 1 つの方法は、探しているベクトルがwhich(colSums(abs(t(S)-V))==0)どこにあるかです。V

于 2012-06-25T10:19:57.927 に答える
2

各州の整数値を取得する簡単な方法の 1 つは、値を整数にキャストし、各列に右底を掛けることです。

私のバージョンは次のとおりですmakecheck2。使用しているバージョンpasteはmakecheck2です。paste使用するバージョンも変更して、match複数の値を同時にチェックできるようにしました。どちらのバージョンも、一致を取得するために使用される関数を返すようになりました。

私のバージョンのセットアップはより高速です。0.065 秒対 1.552 秒。

N <- 5
I <- rep(10,N)
S <- as.matrix(expand.grid( lapply(1:N, function(i) { 0:I[i]}) ) )
system.time(f1 <- makecheck1(S))
#   user  system elapsed 
#  1.547   0.000   1.552 
system.time(f2 <- makecheck2(S))
#   user  system elapsed 
#  0.063   0.000   0.065

ここでは、1 ～ 10000 の値でテストして確認します。このpasteバージョンは、値が小さいほど高速です。私のバージョンは、大きな値の方が高速です。

> set.seed(5)
> k <- lapply(0:4, function(idx) sample(1:nrow(S), 10^idx))
> s <- lapply(k, function(idx) S[idx,])
> t1 <- sapply(s, function(x) unname(system.time(for(i in 1:100) f1(x))[1]))
> t2 <- sapply(s, function(x) unname(system.time(for(i in 1:100) f2(x))[1]))
> data.frame(n=10^(0:4), time1=t1, time2=t2)
      n time1 time2
1     1 0.761 1.512
2    10 0.772 1.523
3   100 0.857 1.552
4  1000 1.592 1.547
5 10000 9.651 1.848

両方のバージョンのコードは次のとおりです。

makecheck2 <- function(m) {
  codes <- vector("list", length=ncol(m))
  top <- vector("integer", length=ncol(m)+1)
  top[1L] <- 1L
  for(idx in 1:ncol(m)) {
    codes[[idx]] <- unique(m[,idx])
    top[idx+1L] <- top[idx]*length(codes[[idx]])
  }
  getcode <- function(x) {
    out <- 0L
    for(idx in 1:length(codes)) {
      out <- out + top[idx]*match(x[,idx], codes[[idx]])
    }
    out
  }
  key <- getcode(m)
  f <- function(x) {
    if(!is.matrix(x)) {
      x <- matrix(x, ncol=length(codes))
    }
    match(getcode(x), key)
  }
  rm(m) # perhaps there's a better way to remove these from the closure???
  rm(idx)
  f
}

makecheck1 <- function(m) {
  n <- ncol(m)
  statecodes <- apply(m,1,function(x) paste(x,collapse=" ") )
  rm(m)
  function(x) {
    if(!is.matrix(x)) {
      x <- matrix(x, ncol=n)
    }
    x <- apply(x, 1, paste, collapse=" ")
    match(x, statecodes)
  }
}
于 2012-06-25T15:57:09.107 に答える