如何根據請求標識和先前的請求標識訂購R數據框？

Question

我有一個R數據幀，它看起來像：

 
User |request_id |previous_request_id 
------------------------------------- 
A |9   |5 
A |3   |1 
A |5   |NA 
A |1   |9 
B |2   |8 
B |8   |7 
B |7   |NA 
B |4   |2 

每一行對應於特定的用戶做出的請求。每一行都有一個用戶ID，一個請求ID和他們先前請求的ID。在沒有先前的請求的情況下，previous_request_id字段是NA。

對於我想通過使用以前的請求ID訂購每個請求的每個用戶，具有：

• 順序爲1，如果該previous_request_id是NA
• 順序爲2，如果previous_request_id等於具有1
• 順序爲3，如果previous_request_id等於REQUEST_ID具有2
• 等

的順序的順序一個REQUEST_ID

上述規則的結果應用到第一臺應該是這樣的：

 
User |request_id |previous_request_id |Order 
--------------------------------------------- 
A |9   |5     |2 
A |3   |1     |4 
A |5   |NA     |1 
A |1   |9     |3 
B |2   |8     |3 
B |8   |7     |2 
B |7   |NA     |1 
B |4   |2     |4 

有沒有一種辦法R內做到這一點？我相信一個圖形數據庫包可能是這樣做的，但到目前爲止，我還沒有能夠在我的研究中找到任何東西（以Neo4j的Cypher語言爲中心）。

任何幫助在這裏將不勝感激！

Answer 1

可能有很多更有效的方法來做到這一點，但這裏是我如何使用循環和遞歸。

str <- "User |request_id |previous_request_id 
A |9   |5 
A |3   |1 
A |5   |NA 
A |1   |9 
B |2   |8 
B |8   |7 
B |7   |NA 
B |4   |2" 

tab <- read.table(textConnection(str), sep="|", header=TRUE) 
tab$order <- NA 

getOrder <- function(id){ 
    i <- which(tab$request_id == id) 
    if(is.na(tab$previous_request_id[i])){ 
     tab$order[i] <<- 1 
    } else { 
     tab$order[i] <<- getOrder(tab$previous_request_id[i]) + 1 
    } 
} 

for(i in 1:nrow(tab)){ 
    if(is.na(tab$order[i])){ 
     if(is.na(tab$previous_request_id[i])){ 
      tab$order[i] <- 1 
     } else { 
      tab$order[i] <- getOrder(tab$previous_request_id[i]) + 1 
     } 
    } 
} 

輸出：

User request_id previous_request_id order 
1 A    9     5  2 
2 A    3     1  4 
3 A    5     NA  1 
4 A    1     9  3 
5 B    2     8  3 
6 B    8     7  2 
7 B    7     NA  1 
8 B    4     2  4 

Answer 2

有很多方法可以做到這一點，但這裏是我想出了...

df <- read.delim(text="User|request_id|previous_request_id 
A|9|5 
A|3|1 
A|5|NA 
A|1|9 
B|2|8 
B|8|7 
B|7|NA 
B|4|2", sep="|") 

df$order <- rep(NA, nrow(df)) 
df$order[is.na(df$previous_request_id)] <- 1 
df$order[df$order[match(df$previous_request_id, df$request_id)] == 1] <- 2 
df$order[df$order[match(df$previous_request_id, df$request_id)] == 2] <- 3 
df$order[df$order[match(df$previous_request_id, df$request_id)] == 3] <- 4 

但是請注意，我們都在重複着相同的代碼（幾乎）一遍又一遍。我們可以創建一個循環來縮短碼了一點......

max_user_len <- max(table(df$User)) 
df$order <- rep(NA, nrow(df)) 
df$order[is.na(df$previous_request_id)] <- 1 
sapply(1:max_user_len, function(x)df$order[df$order[match(df$previous_request_id, df$request_id)] == x] <<- x+1) 
> df$order 
[1] 2 4 1 3 3 2 1 4 

Answer 3

隨着igraph可以這樣做計算從第一個請求的最短路徑。這可能是工作：

require(igraph) 
df[]<-lapply(df,as.character) 
unlist(
    lapply(split(df,df$User), 
     function(x) { 
     graphtmp<-graph.edgelist(na.omit(as.matrix(x[,3:2]))) 
     path<-as.vector(shortest.paths(graphtmp,x$request_id[is.na(x$previous_request_id)],x$request_id)) 
     path+1 
     }),use.names=F) 
#[1] 2 4 1 3 3 2 1 4 

Answer 4

不知道如何與此相比，其他的解決方案，因爲它利用了一個循環，但數據表和plyr行動都應有助於加速一些遞歸部分組成：

## DATA UPLOAD 

df <- read.delim(text="User|request_id|previous_request_id 
A|9|5 
A|3|1 
A|5|NA 
A|1|9 
B|2|8 
B|8|7 
B|7|NA 
B|4|2", sep="|") 

## PACKAGE LOAD 

require(data.table) 
require(plyr) 

## GET DATA INTO RIGHT FORMAT 

df <- data.table(df) 
df[, User := as.character(User)] 
df[, request_id := as.character(request_id)] 
df[, previous_request_id := as.character(previous_request_id)] 

## THE ACTUAL PROCESS 

# Create vector of user ids 

user.list <- unique(df$User) 

# Setkey to speed up filtering 

setkey(df,User) 

get_order <- function(user,df) { 

    # Consider only one user at a time 

    s.df <- df[user] 

    # Create an empty ordering column 

    s.df$ord <- as.numeric(NA) 

    # Redefine NA as 0 

    s.df[is.na(previous_request_id) == TRUE,]$previous_request_id <- "0" 

    # Set seed to 0 

    seed <- "0" 

    # Setkey to speed up filtering 

    setkey(s.df,previous_request_id) 

    for (i in 1:NROW(s.df)) { 

    # Filter by seed and define ord as i 

    s.df[seed]$ord <- i 

    # Define new seed based on filtered request_id 

    seed <- s.df[seed]$request_id} 

    return(s.df)} 

# Loop through user vector and rbindlist to rebind the output 

rebuilt <- rbindlist(llply(.data = user.list, .fun = function(x) {get_order(x,df)}))