4

特定の特定の要素をゼロにしたいマトリックスがあります。

たとえば、私の行列が次のようになっているとします。

m <- matrix(1:100, ncol=10)

次に、保持する要素を示す 2 つのベクトルがあります。

m.from <- c(2, 5, 4, 4, 6, 3, 1, 4, 2, 5)
m.to   <- c(7, 9, 6, 8, 9, 5, 6, 8, 4, 8)

したがって、たとえば、行 1 の要素 3:6 を保持し、要素 1:2 と 7:10 を 0 に設定します。2 行目では、6:8 を保持し、残りをゼロにします。

今、私は簡単に行うことができます:

for (line in 1:nrow(m))
    {
    m[line, 1:m.from[line]] <- 0
    m[line, m.to[line]:ncol(m)] <- 0
    }

正しい結果が得られます。

ただし、私の特定のケースでは、この種のループを非常に長く使用する〜15000 x 3000 マトリックスで操作しています。

このコードを高速化するにはどうすればよいですか? を使用してapplyいますが、m.from と m.to の正しいインデックスにアクセスするにはどうすればよいですか?

4

4 に答える 4

8

単純なマトリックス指向のソリューションを次に示します。

m[col(m) <= m.from] <- 0
m[col(m) >= m.to] <- 0
m
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0   21   31   41   51    0    0    0     0
 [2,]    0    0    0    0    0   52   62   72    0     0
 [3,]    0    0    0    0   43    0    0    0    0     0
 [4,]    0    0    0    0   44   54   64    0    0     0
 [5,]    0    0    0    0    0    0   65   75    0     0
 [6,]    0    0    0   36    0    0    0    0    0     0
 [7,]    0   17   27   37   47    0    0    0    0     0
 [8,]    0    0    0    0   48   58   68    0    0     0
 [9,]    0    0   29    0    0    0    0    0    0     0
[10,]    0    0    0    0    0   60   70    0    0     0

(これでも R ゴルフ賞を受賞できると思います。)私のエントリーは次のとおりです。

m[col(m)<=m.from|col(m)>= m.to]<-0 
于 2012-09-20T22:38:27.493 に答える
4

最良の解決策は、置き換えるすべてのインデックスを事前に計算してから、それらを 1 回の代入操作で置き換えることです。

R は行列を列優先順で格納するため、行列の転置バージョンで置換される要素のシーケンスについて考える方が簡単だと思います。それは私が以下で使用したものです。ただし、 の 2 つの呼び出しt()がコストがかかりすぎる場合は、転置されていない行列のインデックスを計算する賢い方法を見つけられると確信しています。おそらく、行と列のインデックスを含む 2 列の行列を使用します。

## Your example
m <- matrix(1:100, ncol=10)
m.from <- c(2, 5, 4, 4, 6, 3, 1, 4, 2, 5)
m.to   <- c(7, 9, 6, 8, 9, 5, 6, 8, 4, 8)

## Let's work with a transposed version of your matrix
tm <- t(m)

## Calculate indices of cells to be replaced
i <- (seq_len(ncol(tm)) - 1) * nrow(tm)
m.to   <- c(1, m.to + i)
m.from <- c(m.from + i, length(m))
ii <- unlist(mapply(seq, from = m.to, to = m.from))

## Perform replacement and transpose back results
tm[ii] <- 0
m <- t(tm)
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#  [1,]    0    0   21   31   41   51    0    0    0     0
#  [2,]    0    0    0    0    0   52   62   72    0     0
#  [3,]    0    0    0    0   43    0    0    0    0     0
#  [4,]    0    0    0    0   44   54   64    0    0     0
#  [5,]    0    0    0    0    0    0   65   75    0     0
#  [6,]    0    0    0   36    0    0    0    0    0     0
#  [7,]    0   17   27   37   47    0    0    0    0     0
#  [8,]    0    0    0    0   48   58   68    0    0     0
#  [9,]    0    0   29    0    0    0    0    0    0     0
# [10,]    0    0    0    0    0   60   70    0    0     0
于 2012-09-20T16:18:38.220 に答える
2

sapplyバージョン。

m <- matrix(1:100, ncol=10)
m.from <- c(2, 5, 4, 4, 6, 3, 1, 4, 2, 5)
m.to   <- c(7, 9, 6, 8, 9, 5, 6, 8, 4, 8)

t(sapply(1:nrow(m), function(i) replace(m[i,], c(1:m.from[i], m.to[i]:ncol(m)), 0 )))   



     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0   21   31   41   51    0    0    0     0
 [2,]    0    0    0    0    0   52   62   72    0     0
 [3,]    0    0    0    0   43    0    0    0    0     0
 [4,]    0    0    0    0   44   54   64    0    0     0
 [5,]    0    0    0    0    0    0   65   75    0     0
 [6,]    0    0    0   36    0    0    0    0    0     0
 [7,]    0   17   27   37   47    0    0    0    0     0
 [8,]    0    0    0    0   48   58   68    0    0     0
 [9,]    0    0   29    0    0    0    0    0    0     0
[10,]    0    0    0    0    0   60   70    0    0     0

経過時間はまだテストされていません

于 2012-09-20T17:39:09.787 に答える
1

このオプションは、置き換えられる要素をインデックス化する 2 列の行列を構築し、行列の転置を必要としないため、速度的には打ち負かすのは難しいはずです。

## Your data
m <- matrix(1:100, ncol=10)
m.from <- c(2, 5, 4, 4, 6, 3, 1, 4, 2, 5)
m.to   <- c(7, 9, 6, 8, 9, 5, 6, 8, 4, 8)

## Construct a two column matrix with row (ii) and column (jj) indices
## of cells to be replaced
ii <- rep.int(1:ncol(m), times = (m.from + (ncol(m) - m.to + 1)))
jj <- mapply(seq, from = m.from + 1, to = m.to - 1)
jj <- unlist(sapply(jj, function(X) setdiff(1:10,X)))
ij <- cbind(ii, jj)

## Replace cells
m[ij] <- 0
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#  [1,]    0    0   21   31   41   51    0    0    0     0
#  [2,]    0    0    0    0    0   52   62   72    0     0
#  [3,]    0    0    0    0   43    0    0    0    0     0
#  [4,]    0    0    0    0   44   54   64    0    0     0
#  [5,]    0    0    0    0    0    0   65   75    0     0
#  [6,]    0    0    0   36    0    0    0    0    0     0
#  [7,]    0   17   27   37   47    0    0    0    0     0
#  [8,]    0    0    0    0   48   58   68    0    0     0
#  [9,]    0    0   29    0    0    0    0    0    0     0
# [10,]    0    0    0    0    0   60   70    0    0     0
于 2012-09-20T20:51:52.697 に答える