R:匹配两列以重建观测顺序(标记 - 重新捕获历史)

时间:2012-01-12 17:57:39

标签: r matching

我遇到的问题类似于我在这里发布的问题:

Comparing two columns: logical- is value from column 1 also in column 2?

但是,数据的格式略有不同。一般数据结构是在3天内拍摄的一列照片中的列表,以及与第1列中的照片匹配的另一列照片。其他信息是照片拍摄的当天,以便每天的个人是相互排斥 - 每个特定个人每天只有一张照片(即“A”在下面的例子中永远不会与“B”相匹配,因为它们都是从第1天开始的。)

photo <- c('A','B','C','D','E','F','G','H','I','J','K','K','L')
day <- c(1,1,1,1,2,2,2,3,3,3,3,3,3)
matching_photo <- c(NA,NA,NA,NA,NA,'A','B','E',NA,NA,'F','A','C')
DF <- data.frame(photo,day,matching_photo)

我正在寻找的数据输出是:

serial.no <- c(1,2,3,4,5,6)
individuals <- c('A,F,K','B,G','C,L','D','E,H','I')
histories <- c('111','110','101','100','011','001')
finalDF <- data.frame(individuals,histories)

其中包括用于识别个人的序列号(按照我的方式编写,因此只从1开始的顺序系列开始),与列中每个人对应的照片列表以及历史记录。历史记录遵循二进制格式,如果您在第1天观察,而不是直到第3天,您的历史将是“101”。但如果你只是在第二天被观察到,你的历史将是“010”。

我对这个特定数据集遇到的一个问题(与上面链接的问题相比)是,如果连续3天看到一个人,则照片栏中有该个人有两条记录(“ K“在上面的例子中”,匹配前两天的照片(“A”和“F”)。我感谢您提供的任何帮助。谢谢!

1 个答案:

答案 0 :(得分:1)

这里棘手的部分是找到那些属于同一个人的照片组。如果照片A中的动物与照片G中的动物匹配,并且照片L与照片G匹配,则需要一种算法,将所有照片A,G和L识别为链接。

这是网络分析中的一个经典问题,所以我转向igraph包,它自称为“网络分析和可视化”的包。它包含一个函数clusters(),它将从“邻接矩阵”中取出链接的集群,这些矩阵编码节点之间的连接,如下所示:

 [1,] 1 . . . . . . . . . . .
 [2,] . 1 . . . . . . . . . .
 [3,] . . 1 . . . . . . . . .
 [4,] . . . 1 . . . . . . . .
 [5,] . . . . 1 . . . . . . .
 [6,] 1 . . . . 1 . . . . . .
 [7,] . 1 . . . . 1 . . . . .
 [8,] . . . . 1 . . 1 . . . .
 [9,] . . . . . . . . 1 . . .
[10,] . . . . . . . . . 1 . .
[11,] 1 . . . . 1 . . . . 1 .
[12,] . . 1 . . . . . . . . 1

上面的矩阵是数据的邻接矩阵。 12行和12列代表12张照片,A-L。具有相同动物的照片标有1个。其他单元格用点而不是0标记,因为这实际上是一种特殊的表示,专为稀疏矩阵设计,由Matrix包提供。 (如果您拥有庞大的数据集,我选择了该表示:nlarge照片将生成一个带有nlarge^2单元格的矩阵,这可能会淹没您计算机的内存。)

在下面的代码中,第一个块构建邻接矩阵,第二个块为每个动物拉出照片集群,第三个块以你要求的形式将结果重新组合在一起。

library(Matrix)
library(igraph)

# Construct an adjacency matrix, in which pairs of photos of the same  
# individual are encoded with 1's
photos <- as.character(unique(DF$photo))
n <- length(photos)
pairs <- subset(DF, !is.na(matching_photo), 
                select = c("photo", "matching_photo"))
pairs[] <- lapply(pairs, FUN=function(X) match(X, photos))
M <- 1 * with(pairs, sparseMatrix(i = c(seq_len(n), photo), 
                                  j = c(seq_len(n), matching_photo)))

# Extract vectors of photos of the same individual
(clust <- clusters(graph.adjacency(adjmatrix=M)))
# $membership
#  [1] 0 1 2 3 4 0 1 4 5 6 0 2
# $csize
# [1] 3 2 2 1 2 1 1
# $no
# [1] 7

# Process results of clustering to construct output data.frame
DF2 <- cbind(individual = clust$membership, 
             subset(DF, !duplicated(photo), select=c("photo", "day")))
grps <- tapply(DF2$photo, DF2$individual, paste, collapse=",")
days <- tapply(DF2$day, DF2$individual, 
               FUN=function(X) paste((1 * unique(DF$day) %in% X), collapse=""))
data.frame(individual = as.numeric(names(grps)), photos = grps, days=days)
#   individual photos days
# 0          0  A,F,K  111
# 1          1    B,G  110
# 2          2    C,L  101
# 3          3      D  100
# 4          4    E,H  011
# 5          5      I  001
# 6          6      J  001