消除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$level大於其所有部分的df$level ，或者如果合並間隔的df$level較小，則每個合並間隔要么從df消除所有單個部分至少其中一個部分消除了合並間隔。

因此，對於此示例，輸出應為：

> 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

這將找到最終路徑。 由於原始df data.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可能是最有效的，因為它應該線性擴展。

Answer 2

我會采取程序方法; 基本上，按級別降序排序，並為每條記錄刪除以后具有匹配ID的記錄。

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), stringsAsFactors=FALSE)

#sort
ids <- df[order(df$level, decreasing=TRUE), "id"]

#split
ids <- sapply(df$id, strsplit, ",")

i <- 1

while( i < length(ids)) {
  current <- ids[[i]]

  j <- i + 1
  while(j <= length(ids)) {
    if(any(ids[[j]] %in% current)) 
      ids[[j]] <- NULL
    else 
      j <- j + 1
  }
  i <- i + 1
}

最后，只保留剩下的ID：

R> ids <- data.frame(id=names(ids), stringsAsFactors=FALSE)

R> merge(ids, df, sort=FALSE)
     id start end level
1     h   800 850     6
2 a,b,c   100 350     5
3     e   500 550     4
4     d   400 450     3
5     i   900 950     2

這個循環很難看，因為R只有for-each循環，並且還注意到stringsAsFactors=FALSE是分割id所必需的。 刪除中間元素可能對性能有害，但這將取決於R用於列表（鏈接與數組）的底層實現。