使用dplyr对随机事务列表进行排序

Wer*_*ner 8 sorting r dplyr

假设以下一组原始交易:

library(tidyverse)

original_transactions <- data.frame(
  row = 1:6,
  start = 0,
  change = runif(6, min = -10, max = 10) %>% round(2),
  end = 0
) %>% mutate(
  temp = cumsum(change),
  end = 100 + temp, # End balance
  start = end - change # Start balance
) %>% select(
  -temp
)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

它显示了一个(按时间顺序)交易顺序,起始余额为100.00美元,期末余额为95.65美元,有六笔交易/变更.

现在假设您收到了这个混乱的版本

transactions <- original_transactions %>% sample_n(
  6
) %>% mutate(
  row = row_number() # Original sequence is unknown
)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

如何对R中的序列进行逆向工程?也就是说,要获得transactions匹配的排序顺序original_transactions?理想情况下,我想使用dplyr一系列管道%>%并避免循环.

假设开始/结束余额将是唯一的,并且通常,交易数量可以变化.

Jul*_*ora 6

首先,让我们

original_transactions
#   row  start change    end
# 1   1 100.00   2.33 102.33
# 2   2 102.33  -6.52  95.81
# 3   3  95.81  -4.20  91.61
# 4   4  91.61  -3.56  88.05
# 5   5  88.05   7.92  95.97
# 6   6  95.97   3.61  99.58

transactions
#   row  start change    end
# 1   1 100.00   2.33 102.33
# 2   2  91.61  -3.56  88.05
# 3   3  95.81  -4.20  91.61
# 4   4 102.33  -6.52  95.81
# 5   5  88.05   7.92  95.97
# 6   6  95.97   3.61  99.58
Run Code Online (Sandbox Code Playgroud)

diffs <- outer(transactions$start, transactions$start, `-`)
matches <- abs(sweep(diffs, 2, transactions$change, `-`)) < 1e-3
Run Code Online (Sandbox Code Playgroud)

我想计算diffs是整个解决方案中计算成本最高的部分.你的diffs所有可能存在差异.然后比较这些与列在我们知道对行应该一起去.如果没有关于数字精度的问题,我们可以使用该函数并快速完成.但是,在这种情况下,我们有以下两种选择.starttransactionschangematchestransactionsmatch


首先,我们可以使用igraph.

library(igraph)
(g <- graph_from_adjacency_matrix(t(matches) * 1))
# IGRAPH 45d33f0 D--- 6 5 -- 
# + edges from 45d33f0:
# [1] 1->4 2->5 3->2 4->3 5->6
Run Code Online (Sandbox Code Playgroud)

也就是说,我们有一个隐藏的路径图:1-> 4-> 3-> 2-> 5-> 6我们要恢复.它由顶点的最长路径给出,该路径没有入边(即1):

transactions[as.vector(tail(all_simple_paths(g, from = which(rowSums(matches) == 0)), 1)[[1]]), ]
#   row  start change    end
# 1   1 100.00   2.33 102.33
# 4   4 102.33  -6.52  95.81
# 3   3  95.81  -4.20  91.61
# 2   2  91.61  -3.56  88.05
# 5   5  88.05   7.92  95.97
# 6   6  95.97   3.61  99.58
Run Code Online (Sandbox Code Playgroud)

另一种选择是递归的.

fun <- function(x, path = x) {
  if(length(xNew <- which(matches[, x])) > 0)
    fun(xNew, c(path, xNew))
  else path
}
transactions[fun(which(rowSums(matches) == 0)), ]
#   row  start change    end
# 1   1 100.00   2.33 102.33
# 4   4 102.33  -6.52  95.81
# 3   3  95.81  -4.20  91.61
# 2   2  91.61  -3.56  88.05
# 5   5  88.05   7.92  95.97
# 6   6  95.97   3.61  99.58
Run Code Online (Sandbox Code Playgroud)

它使用与先前方法相同的唯一最长路径图构思.


没有明确的循环......当然你可以用一些东西重写%>%,但它不会像你想要的那样漂亮; 这不是真正传统的数据转换任务,dplyr而是最好的.