R计算数据帧或数组中相邻相同值的数量

时间:2014-02-03 20:48:58

标签: r dataframe geospatial data.table

我有一个来自流底的分类基质大小的数据集。由于我收集数据的方式,我可以在空间上将它们排列成一个矩阵,在那里它们与邻居的关系得以保留(即左边,前面等)。一个例子如下:

     P.1 P.2 P.3 P.4 P.5
T 1    G   C   C   P   C
T 2    P   C   B   G   C
T 3   SI  SI   C   B   C
T 4   SI  BR  BR  SI  SI
T 5   BR  CL  BR  BR   B
T 6   BR  BR  BR  BR   C

其中P(n)是从左到右穿过河流的横断面上的实际点测量,并且T(n)给出从上游到下游的横断面。如您所见,某些基板类型(特别是基岩,“BR”,在此样本中)具有比其他类型更大的相邻贴片。这在生态学上是有意义的,可能不仅仅是样本中BR的百分比。

我的问题是:是否有一种简单的方法来计算彼此相邻的相同类型的基板测量数量?请注意,相邻的角也被认为是相邻的。

编辑以下非常有用的评论:

示例输出将是每种补丁类型的列表,以及每个补丁中的测量数量。它可能看起来像这样:

$BR  
[1] 9  

$B  
[1] 1 1  

$C  
[1] 4 3 1  

$P  
[1] 1 1  

$G  
[1] 1 1  

$SI  
[1] 3 2  

1 个答案:

答案 0 :(得分:3)

一个有趣的小问题。我附上一个解决方案,它应该适用于任何因素矩阵。它使用的是foreachdata.table软件包,因此您可能需要安装这些软件包。

首先堆叠数据并将每个位置映射到一个值。然后,它遍历原始矩阵,对邻居进行贪婪的自递归,但首先从堆叠矩阵中删除自身(避免多次计数)。

我不喜欢这个解决方案中的一些for循环,但考虑到与堆叠框架交互的加速,我没有看到一个简单的方法,没有完全重新工作。一个更好的实现可以在并行线程(可能是补丁类型而不是位置)中使用像synchronicity之类的包在堆叠数据周围放置互斥锁(任何人?)。

dcast包中的

reshape2也是创建堆叠框架的好选择。

对于这个矩阵:

> d
    P-1 P-2 P-3 P-4 P-5 P-6
T-1   G   P  SI  SI  BR  BR
T-2   C   C  SI  BR  CL  BR
T-3   C   B   C  BR  BR  BR
T-4   P   G   B  SI  BR  BR
T-5   C   C   C  SI   B   C

它给出了以下结果(看起来像你要求的那样):

> patchesList
$G
[1] 1 1
$C
[1] 4 3 1
$P
[1] 1 1
$B
[1] 2 1
$SI
[1] 3 2
$BR
[1] 9
$CL
[1] 1

数据设置代码:

rm(list=ls())
d = strsplit("G   C   C   P   C P   C   B   G   C SI  SI   C   B   C SI  BR  BR  SI  SI BR  CL  BR  BR   B BR  BR  BR  BR   C"," ")[[1]]
d=d[-which(d=="")]
d=data.frame(matrix(d,nrow=5),stringsAsFactors=F)
rownames(d) = paste("T",1:5,sep="-")
colnames(d) = paste("P",1:6,sep="-")
levs = unique(unlist(d))

堆叠原始数据(包含位置信息):

idxsFrame = expand.grid(1:nrow(d),1:ncol(d))
colnames(idxsFrame) = c("ri","cj")
idxsFrame$value = apply(idxsFrame,1,function(x) { d[x[["ri"]],x[["cj"]]] } )
require(data.table)
idxsFrame = data.table(idxsFrame)

设置输出列表:

patchesList = vector(mode="list",length=length(levs))
names(patchesList) = levs 
require(foreach)

执行扫描的自递归函数:

scanSurroundTiles = function(tile) 
{  
  surroundTiles = idxsFrame[ri>=(tile$ri-1) & ri <=(tile$ri+1) & cj>=(tile$cj-1) & cj<=(tile$cj+1),,drop=F]
  baseMatches = surroundTiles[which(surroundTiles$value == tile$value),,drop=F]  
  if(nrow(baseMatches) < 1) 
    return(tile)
  else
  {
    # not possible to do an apply(matches,1,scanSurroundTiles) because of overlap and self-recursiveness on deeper levels
    newMatches <- foreach(mc = 1:nrow(baseMatches), .combine=rbind) %do% # mc = 2; 
    {
      inIdxs = which(idxsFrame$ri==baseMatches$ri[mc] & idxsFrame$cj==baseMatches$cj[mc])
      if(length(inIdxs)>0)
      { assign("idxsFrame",idxsFrame[-inIdxs,,drop=F],globalenv()) 
        return(scanSurroundTiles(baseMatches[mc,,drop=F]))      
      } else
      { return(NULL) } # could have been removed from previous foreach 
    }
    return(rbind(tile,newMatches))
  }
}

主循环:

for(i in 1:nrow(d))  
{
  for(j in 1:ncol(d)) 
  { 
    sourceTile = idxsFrame[ri==i & cj==j,,drop=F]
    if(nrow(sourceTile) > 0)
    {
      idxsFrame <- idxsFrame[-which(idxsFrame$ri==sourceTile$ri & idxsFrame$cj==sourceTile$cj),,drop=F]
      thisPatch = scanSurroundTiles(sourceTile)
# if you want to do some calc by patch (mean, sd) this is the place to do it by adding other info beyond the type in the stacked frame
      patchesList[[thisPatch$value[1]]] = c(patchesList[[thisPatch$value[1]]],nrow(thisPatch))      
    }  
  }
}