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来订购每个请求，并使用：

如果previous_request_id为NA
如果previous_request_id等于order_id且订单为1，则订单为2
如果previous_request_id等于request_id且订单为2，则订单为3
等

应用于第一个表的上述规则的结果应如下所示：

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

有很多方法可以做到这一点，但这就是我想出的......

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 2

可能有更多有效的方法可以做到这一点，但这是我如何仅使用循环和递归来实现它。

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 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

不确定这与其他解决方案的比较，因为它使用for循环，但datatable和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)}))

如何根据请求ID和先前的请求ID订购R数据框？

4 个答案: