消除data.frame中的行

Question

我有这个例子data.frame:

df <- data.frame(id=c("a","a,b,c","d,e","d","h","e","i","b","c"), start=c(100,100,400,400,800,500,900,200,300), end=c(150,350,550,450,850,550,950,250,350), level = c(1,5,2,3,6,4,2,1,1))

> df
     id start end level
1     a   100 150     1
2 a,b,c   100 350     5
3   d,e   400 550     2
4     d   400 450     3
5     h   800 850     6
6     e   500 550     4
7     i   900 950     2
8     b   200 250     1
9     c   300 350     1

其中每一行是一个线性区间.如此示例所示,某些行是合并的间隔(第2行和第3行).

我想要做的是,每个合并的间隔要么消除所有单独的部分,df如果df$level合并的间隔大于其所有部分的部分,或者df$level合并的间隔小于其至少一个部分消除合并的间隔.

因此,对于此示例,输出应为:

> res.df
     id start end level
1 a,b,c   100 350     5
2     d   400 450     3
3     h   800 850     6
4     e   500 550     4
5     i   900 950     2

Answer 1

方法1(ID值)

因此,如果我们可以假设所有"合并"组的ID名称都是以逗号分隔的各个组的列表,那么我们可以仅查看ID并忽略开始/结束信息来解决此问题.这是一种这样的方法

首先,通过使用逗号查找ID来查找所有"合并"组

groups<-Filter(function(x) length(x)>1, 
    setNames(strsplit(as.character(df$id),","),df$id))

现在,对于每个组,确定谁具有更高级别,合并组或其中一个组.然后返回要删除的行的索引作为负数

drops<-unlist(lapply(names(groups), function(g) {
    mi<-which(df$id==g)
    ii<-which(df$id %in% groups[[g]])
    if(df[mi, "level"] > max(df[ii, "level"])) {
        return(-ii)
    } else {
        return(-mi)
    }
}))

最后,从data.frame中删除它们

df[drops,]

#      id start end level
# 2 a,b,c   100 350     5
# 4     d   400 450     3
# 5     h   800 850     6
# 6     e   500 550     4
# 7     i   900 950     2

方法2(开始/结束图)

我还想尝试一种忽略(非常有用)合并ID名称的方法,只看一下开始/结束位置.我可能走错了方向,但这导致我将其视为网络/图形类型问题,因此我使用了igraph库.

我创建了一个图形,其中每个顶点代表一个开始/结束位置.因此每个边缘代表一个范围.我使用了样本数据集中的所有范围并填充了任何缺失的范围以使图形连接.我将这些数据合并在一起以创建边缘列表.对于每个边缘,我记得原始数据集中的"level"和"id"值.这是执行此操作的代码

library(igraph)

poslist<-sort(unique(c(df$start, df$end)))
seq.el<-embed(rev(poslist),2)
class(seq.el)<-"character"
colnames(seq.el)<-c("start","end")

el<-rbind(df[,c("start","end","level", "id")],data.frame(seq.el, level=0, id=""))
el<-el[!duplicated(el[,1:2]),]

gg<-graph.data.frame(el)

这会创建一个看起来像的图表

因此,基本上我们希望通过采用具有最大"级别"值的边的路径来消除图中的循环.不幸的是,因为这不是一个正常的路径加权方案,我没有找到一个简单的方法来使用默认算法(也许我错过了它).所以我不得不编写自己的图横向函数.它并不像我希望的那样漂亮,但它确实如此.

findPath <- function(gg, fromv, tov) {
    if ((missing(tov) && length(incident(gg, fromv, "in"))>1) || 
        (!missing(tov) && V(gg)[fromv]==V(gg)[tov])) {
        return (list(level=0, path=numeric()))
    }
    es <- E(gg)[from(fromv)]
    if (length(es)>1) {
        pp <- lapply(get.edges(gg, es)[,2], function(v) {
            edg <- E(gg)[fromv %--% v]
            lvl <- edg$level
            nxt <- findPaths(gg,v)
            return (list(level=max(lvl, nxt$level), path=c(edg,nxt$path)))
        })
        lvl <- sapply(pp, `[[`, "level")
        take <- pp[[which.max(lvl)]]
        nxt <- findPaths(gg, get.edges(gg, tail(take$path,1))[,2], tov)
        return (list(level=max(take$level, nxt$level), path=c(take$path, nxt$path)))
    } else  {
        lvl <- E(gg)[es]$level
        nv <- get.edges(gg,es)[,2]
        nxt <- findPaths(gg, nv, tov)
        return (list(level=max(lvl, nxt$level), path=c(es, nxt$path)))
    }
}

这将在两个节点之间找到满足具有最大级别的属性的路径,当呈现分支时.我们用这个数据集来调用它

rr <- findPaths(gg, "100","950")$path

这将找到最终路径.由于原始dfdata.frame 中的每一行都由一个边表示,我们只需要从路径中提取与最终路径对应的边.这实际上给了我们一条看起来像的路径

红色路径是选定的路径.然后我可以df用

df[df$id %in% na.omit(E(gg)[rr]$id), ]

#      id start end level
# 2 a,b,c   100 350     5
# 4     d   400 450     3
# 5     h   800 850     6
# 6     e   500 550     4
# 7     i   900 950     2

方法3(重叠矩阵)

他是看待开始/停止位置的另一种方式.我创建了一个matix,其中列对应于data.frame行中的范围,矩阵的行对应于位置.如果范围与位置重叠,则矩阵中的每个值都为真.这里我使用了between.R辅助函数

#find unique positions and create overlap matrix
un<-sort(unique(unlist(df[,2:3])))    
cc<-sapply(1:nrow(df), function(i) between(un, df$start[i], df$end[i]))

#partition into non-overlapping sections
groups<-cumsum(c(F,rowSums(cc[-1,]& cc[-nrow(cc),])==0))

#find the IDs to keep from each section
keeps<-lapply(split.data.frame(cc, groups), function(m) {
    lengths <- colSums(m)
    mx <- which.max(lengths)
    gx <- setdiff(which(lengths>0), mx)
    if(length(gx)>0) {
        if(df$level[mx] > max(df$level[gx])) {
            mx
        } else {
            gx
        }
    } else {
        mx
    }
})

这将给出每个组保留的ID列表,我们可以获得最终的data.set

df[unlist(keeps),]

方法4(打开/关闭列表)

我有最后一种方法.这个可能是最具扩展性的.我们基本上融化了头寸并跟踪开盘和结束事件以识别这些团体.然后我们拆分并查看每组中最长的是否具有最高级别.最终我们会返回ID.此方法使用所有标准基本函数.

#create open/close listing
dd<-rbind(
    cbind(df[,c(1,4)],pos=df[,2], evt=1),
    cbind(df[,c(1,4)],pos=df[,3], evt=-1)
)

#annotate with useful info
dd<-dd[order(dd$pos, -dd$evt),]
dd$open <- cumsum(dd$evt)
dd$group <- cumsum(c(0,head(dd$open,-1)==0))
dd$width <- ave(dd$pos, dd$id, FUN=function(x) diff(range(x)))

#slim down
dd <- subset(dd, evt==1,select=c("id","level","width","group"))

#process each group
ids<-unlist(lapply(split(dd, dd$group), function(x) {
    if(nrow(x)==1) return(x$id)
    mw<-which.max(x$width)
    ml<-which.max(x$level)
    if(mw==ml) {
        return(x$id[mw])
    } else {
        return(x$id[-mw])
    }
}))

最后是子集

df[df$id %in% ids, ]

到现在为止,我想你知道这会带来什么

摘要

因此,如果您的真实数据与样本数据具有相同类型的ID,那么显然方法1是更好,更直接的选择.我仍然希望有一种简化方法2的方法,我只是缺少它.我没有对这些方法的效率或性能进行任何测试.我猜测方法4可能是最有效的,因为它应该线性扩展.