2016-05-13 23 views
6

Tôi có một ma trận, ví dụ .:có điều kiện tính toán ma trận kề

set.seed(1) 
m = matrix(rep(NA,100), nrow=10) 
m[sample(1:100,10)] = 1 
m 
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] NA NA NA NA NA NA NA NA NA NA 
[2,] NA NA NA NA NA NA 1 NA NA NA 
[3,] NA NA NA NA NA NA NA NA NA NA 
[4,] NA NA NA NA NA NA NA NA NA NA 
[5,] NA NA NA NA NA NA NA NA NA NA 
[6,] 1 NA NA NA NA NA NA NA 1 NA 
[7,] NA NA 1 1 NA 1 NA NA NA  1 
[8,] NA NA NA NA NA 1 NA NA NA NA 
[9,] NA NA NA NA NA NA NA NA 1 NA 
[10,] NA 1 NA NA NA NA NA NA NA NA 

Tôi muốn chuyển đổi tất cả các giá trị NA mà là bên cạnh (liền kề) đến một giá trị không phải là NA không. Có cách nào ma trận swishy để đạt được điều này, mà không có một số thuật toán loop-khôn ngoan và col-khôn ngoan looping khôn ngoan?


NB. Tôi đã làm lại ví dụ để ít mơ hồ hơn. Tôi cần tất cả các giá trị NA ở trên, bên dưới, bên trái và bên phải của giá trị không phải NA để trở thành số không!

+0

liền kề ở cả hai bên hoặc cả hai bên? – nrussell

+0

Có, mọi giá trị NA liền kề với giá trị phi NA :) – geotheory

+0

[tương tự] (http://stackoverflow.com/questions/29105175/find-neighbouring-elements-of-a-matrix-in-r) – rawr

Trả lời

1
m[is.na(m) & !(cbind(is.na(m[,-1L]),T) & cbind(T,is.na(m[,-ncol(m)])) & rbind(is.na(m[-1L,]),T) & rbind(T,is.na(m[-nrow(m),])))] <- 0; 
m; 
##  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
## [1,] NA NA NA NA NA NA 0 NA NA NA 
## [2,] NA NA NA NA NA 0 1 0 NA NA 
## [3,] NA NA NA NA NA NA 0 NA NA NA 
## [4,] NA NA NA NA NA NA NA NA NA NA 
## [5,] 0 NA NA NA NA NA NA NA 0 NA 
## [6,] 1 0 0 0 NA 0 NA 0 1  0 
## [7,] 0 0 1 1 0 1 0 NA 0  1 
## [8,] NA NA 0 0 0 1 0 NA 0  0 
## [9,] NA 0 NA NA NA 0 NA 0 1  0 
## [10,] 0 1 0 NA NA NA NA NA 0 NA 

Các giải pháp hoạt động như sau.

Chúng tôi xây dựng ma trận chỉ mục hợp lý với TRUE trong đó phần tử là NA AND liền kề (ở trên, bên dưới, bên trái hoặc bên phải) ít nhất một phần tử không phải NA. Sau đó, chúng tôi có thể ghi số m bằng ma trận chỉ mục logic và chỉ định giá trị thay thế mong muốn.

LHS của kết hợp logic rất dễ dàng; nó chỉ đơn giản là is.na(m).

RHS của kết hợp logic là phần khó nhất. Chúng ta cần phải thực hiện 4 bài kiểm tra, một cho mỗi hướng của sự kề nhau. Thuật toán chung là:

1: Chỉ mục tắt chỉ số số ít của hướng kề kề không liền kề với bất kỳ chỉ mục nào khác liên quan đến hướng kề nhau đó. Ví dụ: đối với "hướng đúng", chúng tôi lập chỉ mục khỏi cột ngoài cùng bên trái, vì nó không nằm ở bên phải của bất kỳ chỉ mục nào khác. Nói cách khác, không có cột nào có cột ngoài cùng bên trái bên phải, vì vậy chúng ta có thể bỏ qua nó (và phải loại bỏ nó) cho tính toán "hướng đúng".

2: Kiểm tra submatrix cho NA bằng cách sử dụng is.na().

3: Sau đó chúng tôi phải ràng buộc (cbind() cho hướng kề ngang, rbind() cho dọc) TRUE trên phía đối diện (có nghĩa là, đối diện của chỉ số đó đã được gỡ bỏ ở bước 1) của submatrix logic kết quả . Điều này có hiệu quả khiến chỉ mục cuối cùng theo hướng kề nhau tới luôn luôn có một (giả) NA theo hướng kề nhau của nó, vì vậy nó sẽ không bao giờ được thay thế do hướng kề nhau đó.

4: Logical AND 4 thử nghiệm. Kết quả sẽ là ma trận hợp lý với TRUE cho các phần tử có NA trong mỗi ô liền kề.

5: Phủ nhận kết quả của bước 4. Thao tác này sẽ tạo ma trận lôgic với TRUE cho các thành phần có ít nhất một không NA trong bất kỳ ô liền kề nào.


Lưu ý rằng có một cách khác để thực hiện việc này, có lẽ hơi trực quan hơn.Chúng tôi có thể viết mỗi trong 4 bài kiểm tra để kiểm tra không phải NA, trái với NA, và sau đó hợp lý HOẶC chúng lại với nhau. Điều này cũng sẽ yêu cầu ràng buộc FALSE thay vì TRUE cho chỉ mục cuối cùng. Nó sẽ trông như thế này:

m[is.na(m) & (cbind(!is.na(m[,-1L]),F) | cbind(F,!is.na(m[,-ncol(m)])) | rbind(!is.na(m[-1L,]),F) | rbind(F,!is.na(m[-nrow(m),])))] <- 0; 
m; 
##  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
## [1,] NA NA NA NA NA NA 0 NA NA NA 
## [2,] NA NA NA NA NA 0 1 0 NA NA 
## [3,] NA NA NA NA NA NA 0 NA NA NA 
## [4,] NA NA NA NA NA NA NA NA NA NA 
## [5,] 0 NA NA NA NA NA NA NA 0 NA 
## [6,] 1 0 0 0 NA 0 NA 0 1  0 
## [7,] 0 0 1 1 0 1 0 NA 0  1 
## [8,] NA NA 0 0 0 1 0 NA 0  0 
## [9,] NA 0 NA NA NA 0 NA 0 1  0 
## [10,] 0 1 0 NA NA NA NA NA 0 NA 

Cách tiếp cận đầu tiên là thích hợp hơn vì nó chỉ yêu cầu một từ khóa đơn, trong khi cách tiếp cận thứ hai yêu cầu 4 từ chối.


Benchmarking

library(raster); 
library(microbenchmark); 

bgoldst1 <- function(m) { m[is.na(m) & !(cbind(is.na(m[,-1L]),T) & cbind(T,is.na(m[,-ncol(m)])) & rbind(is.na(m[-1L,]),T) & rbind(T,is.na(m[-nrow(m),])))] <- 0; m; }; 
bgoldst2 <- function(m) { m[is.na(m) & (cbind(!is.na(m[,-1L]),F) | cbind(F,!is.na(m[,-ncol(m)])) | rbind(!is.na(m[-1L,]),F) | rbind(F,!is.na(m[-nrow(m),])))] <- 0; m; }; 
geotheory <- function(m) { r <- raster(m,crs='+init=epsg:27700'); extent(r) <- extent(1,ncol(m),1,nrow(m)); b <- as.matrix(buffer(r,1)); m[is.na(m) & !is.na(b)] <- 0; m; }; 

set.seed(1L); m <- matrix(rep(NA,100),nrow=10L); m[sample(1:100,10L)] <- 1; 

expected <- bgoldst1(m); 
identical(expected,bgoldst2(m)); 
## [1] TRUE 
identical(expected,geotheory(m)); 
## [1] TRUE 

microbenchmark(bgoldst1(m),bgoldst2(m),geotheory(m)); 
## Unit: microseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst1(m) 89.380 96.0085 110.0142 107.9825 119.1015 197.149 100 
## bgoldst2(m) 87.242 97.5055 111.4725 107.3410 121.2410 176.194 100 
## geotheory(m) 5010.376 5519.7095 6017.3685 5824.4115 6289.9115 9013.201 100 

set.seed(1L); NR <- 100L; NC <- 100L; probNA <- 0.9; m <- matrix(sample(c(1,NA),NR*NC,T,c(1-probNA,probNA)),NR); 

expected <- bgoldst1(m); 
identical(expected,bgoldst2(m)); 
## [1] TRUE 
identical(expected,geotheory(m)); 
## [1] TRUE 

microbenchmark(bgoldst1(m),bgoldst2(m),geotheory(m)); 
## Unit: milliseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst1(m) 6.815069 7.053484 7.265562 7.100954 7.220269 8.930236 100 
## bgoldst2(m) 6.920270 7.071018 7.381712 7.127683 7.217275 16.034825 100 
## geotheory(m) 56.505277 57.989872 66.803291 58.494288 59.451588 571.142534 100 
+1

Điều này nhắc tôi về một dòng từ Frankenstein: "" Ngày đáng ghét khi tôi nhận cuộc sống! " Tôi kêu lên đau đớn. 'Người tạo được chấp nhận! Tại sao bạn lại tạo thành một con quái vật ghê gớm tới nỗi thậm chí bạn đã chuyển từ tôi thành ghê tởm? – geotheory

0

Phương pháp khác:

require(raster) 
r = raster(m, crs="+init=epsg:27700") 
extent(r) = extent(1, ncol(m), 1, nrow(m)) 
b = as.matrix(buffer(r, 1)) 
m[ is.na(m) & !is.na(b) ] = 0 
m 
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] NA NA NA NA NA NA 0 NA NA NA 
[2,] NA NA NA NA NA 0 1 0 NA NA 
[3,] NA NA NA NA NA NA 0 NA NA NA 
[4,] NA NA NA NA NA NA NA NA NA NA 
[5,] 0 NA NA NA NA NA NA NA 0 NA 
[6,] 1 0 0 0 NA 0 NA 0 1  0 
[7,] 0 0 1 1 0 1 0 NA 0  1 
[8,] NA NA 0 0 0 1 0 NA 0  0 
[9,] NA 0 NA NA NA 0 NA 0 1  0 
[10,] 0 1 0 NA NA NA NA NA 0 NA 
Các vấn đề liên quan