r - 提取具有连接值的子矩阵

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
#