Question

我有一个包含NA和numeric值（Fig 1）的矩阵。包含数字的单元格被涂成蓝色。我想提取数字单元格相互连接的子矩阵，即这些单元格在相邻单元格中具有值。

所需的子矩阵在Fig 1中用彩色边框表示。

输出将包含9个子矩阵，其中两个示例在Fig 2中显示。有可能这样做吗？谢谢。

图1上的矩阵

time <- c(1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51)
    id1 <- c (NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA)
    id2 <- c(NA,-23.08,-23.08,-23.08,NA,NA,NA,NA,NA,-23.08,NA,NA,NA,NA,-23.08,-23.08,-20.63,-18.03,NA,-16.67,-16.67,-18.03,NA,NA,NA,NA)
    id3 <- c(-24.62,NA,NA,NA,NA,-35.71,-28.57,NA,NA,NA,-23.08,-23.08,-23.08,-23.08,NA,NA,NA,NA,-18.33,NA,NA,NA,NA,NA,-21.67,-23.33)
    id4 <- c(NA,NA,NA,-4,-32.86,NA,NA,-26.23,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,-6,-6,-2,-23.33,-23.33,NA,NA)
    id5 <- c(NA,NA,NA,NA,NA,NA,NA,NA,-23.81,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA)
    id6 <- c(NA,NA,NA,-10,NA,NA,NA,NA,NA,NA,NA,-10,-10,NA,-4,NA,NA,-10,NA,-10,-10,NA,-10,-10,-10,-10)
    id7 <- c(-10,-10,-10,NA,NA,-6.25,NA,NA,NA,NA,-10,NA,NA,-10,NA,-10,NA,NA,-10,NA,NA,-14,NA,NA,NA,NA)
    id8 <- c (NA,NA,NA,NA,NA,NA,-10,-10,-10,NA,NA,NA,NA,NA,-6.25,NA,-10,NA,NA,NA,NA,NA,NA,NA,NA,NA)
    id9 <- c (NA,NA,-6.67,NA,-18,-6.67,NA,NA,NA,-12,-2.22,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA)
    id10 <- c(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA)
    id11 <- c(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,-2.22,-4.44,-8.51,-12.24,-8.51,-4.26,NA,NA,NA,NA,NA,NA,NA,NA,NA)
     df <- data.frame(time, id1, id2, id3, id4, id5, id6, id7, id8, id9, id10, id11)

Answer 1

这是一种方法，不短：）。

library(tidyverse)
library(igraph)

# get all non missing cells and their coordinates 
non_missing <- df %>%
  select(-time) %>%
  setNames(seq_along(.)) %>%
  rowid_to_column("Y") %>%
  gather(X,val,-Y,convert = TRUE) %>%
  na.omit %>%
  select(-val)

# get the pairs of connected cells
pairs <-non_missing %>%
  merge(.,.,by=NULL) %>%
  filter(pmax(abs(.[[1]]-.[[3]]),abs(.[[2]]-.[[4]])) <=1) %>%
  unite(a,1,2) %>%
  unite(b,2,3) 

# use network analysis get clusters
cluster_membership <- 
  graph_from_data_frame(pairs) %>% 
  clusters %>% 
  pluck(membership)

# use these clusters to extract sub tables
cluster_dfs <-
  cluster_membership %>%
  tibble(xy = names(.), id = .) %>%
  separate(xy,c('x','y'),convert = TRUE) %>%
  group_by(id) %>%
  summarize(min_x = min(x), max_x = max(x),
            min_y = min(y), max_y = max(y)) %>%
  select(-1) %>%
  pmap(~df[-1][..1:..2, ..3:..4])

输出：

# [[1]]
#      id2    id3
# 1     NA -24.62
# 2 -23.08     NA
# 3 -23.08     NA
# 4 -23.08     NA
# 
# [[2]]
#       id2    id3    id4
# 10 -23.08     NA     NA
# 11     NA -23.08     NA
# 12     NA -23.08     NA
# 13     NA -23.08     NA
# 14     NA -23.08     NA
# 15 -23.08     NA     NA
# 16 -23.08     NA     NA
# 17 -20.63     NA     NA
# 18 -18.03     NA     NA
# 19     NA -18.33     NA
# 20 -16.67     NA  -6.00
# 21 -16.67     NA  -6.00
# 22 -18.03     NA  -2.00
# 23     NA     NA -23.33
# 24     NA     NA -23.33
# 25     NA -21.67     NA
# 26     NA -23.33     NA
# 
# [[3]]
#      id3    id4    id5
# 4     NA  -4.00     NA
# 5     NA -32.86     NA
# 6 -35.71     NA     NA
# 7 -28.57     NA     NA
# 8     NA -26.23     NA
# 9     NA     NA -23.81
# 
# [[4]]
#   id6 id7
# 1  NA -10
# 2  NA -10
# 3  NA -10
# 4 -10  NA
# 
# [[5]]
#    id6 id7    id8
# 11  NA -10     NA
# 12 -10  NA     NA
# 13 -10  NA     NA
# 14  NA -10     NA
# 15  -4  NA  -6.25
# 16  NA -10     NA
# 17  NA  NA -10.00
# 
# [[6]]
#    id6 id7
# 18 -10  NA
# 19  NA -10
# 20 -10  NA
# 21 -10  NA
# 22  NA -14
# 23 -10  NA
# 24 -10  NA
# 25 -10  NA
# 26 -10  NA
# 
# [[7]]
#       id7 id8    id9
# 5      NA  NA -18.00
# 6   -6.25  NA  -6.67
# 7      NA -10     NA
# 8      NA -10     NA
# 9      NA -10     NA
# 10     NA  NA -12.00
# 11 -10.00  NA  -2.22
# 
# [[8]]
# [1] -6.67
# 
# [[9]]
# [1]  -2.22  -4.44  -8.51 -12.24  -8.51  -4.26
#

Answer 2

将数据转换为raster，然后使用clump *对连接的单元的群集进行分组。

library(raster)
r <- raster(as.matrix(df[ , -1]))
rc <- clump(r)

其余的基本上只是“摆弄”索引以按组提取正确的值：

ix <- which(!is.na(df[ , -1]), arr.ind = TRUE)
d2 <- data.frame(ix[order(ix[ , "row"]), ],
                 g = rc@data@values[!is.na(rc@data@values)])

by(d2, d2$g, function(x){
  df[min(x$row):max(x$row) , c(1, min(x$col):max(x$col) + 1)]
})

# d2$g: 1   
#   time    id2    id3
# 1    1     NA -24.62
# 2    3 -23.08     NA
# 3    5 -23.08     NA
# 4    7 -23.08     NA
# ---------------------- 
#   d2$g: 2
#   time id6 id7
# 1    1  NA -10
# 2    3  NA -10
# 3    5  NA -10
# 4    7 -10  NA
# ----------------------
# [snip]
# d2$g: 9
#    time id6 id7
# 18   35 -10  NA
# 19   37  NA -10
# 20   39 -10  NA
# 21   41 -10  NA
# 22   43  NA -14
# 23   45 -10  NA
# 24   47 -10  NA
# 25   49 -10  NA
# 26   51 -10  NA

*请注意，clump函数要求igraph包可用。

聚集的可视化：

plot(rc)

提取具有连接值的子矩阵

2 个答案: