假设以下原始交易集:
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
)
它显示了一个按时间顺序排列的交易序列,起始余额为$ 100.00,结束余额为$ 95.65,其中有六笔交易/更改。
现在假设您收到的是混杂的版本
transactions <- original_transactions %>% sample_n(
6
) %>% mutate(
row = row_number() # Original sequence is unknown
)
如何对R中的序列进行逆向工程?也就是说,要获得transactions
的排序顺序以匹配original_transactions
的排序顺序吗?理想情况下,我想使用dplyr
和一系列管道%>%
来避免循环。
假定期初/期末余额是唯一的,并且一般而言,交易数量可以变化。
答案 0 :(得分: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
和
diffs <- outer(transactions$start, transactions$start, `-`)
matches <- abs(sweep(diffs, 2, transactions$change, `-`)) < 1e-3
我想计算diffs
是整个解决方案中计算量最大的部分。 diffs
与start
中的transactions
之间存在所有可能的差异。然后将它们与change
中的matches
列进行比较,我们知道transactions
的哪几对行应该在一起。如果数字精度没有问题,我们可以使用match
函数并快速完成。但是,在这种情况下,我们有以下两个选项。
首先,我们可以使用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
也就是说,我们有一个隐藏的路径图: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
另一个选项是递归的。
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
它使用与以前的方法相同的唯一最长路径图思想。
没有显式循环...当然,您可以用%>%
重写所有内容,但它不会像您想要的那样漂亮;这并不是dplyr
最好的传统数据转换任务。
答案 1 :(得分:2)
这是使用tidyverse
管道的一种方式。它匹配start
和end
图形(使用字符以避免浮点问题),然后使用purrr::accumulate
构造链,并使用slice
重新排列行... < / p>
library(tidyverse)
orig <- transactions %>%
mutate(ind = match(as.character(start), as.character(end))) %>% #indicator variable
slice(accumulate(1:n(), #do it (no of rows) times
~match(., ind), #work along chain of matches
.init = NA)) %>% #start with the one with no matching end value
select(-ind) #remove ind variable
transactions
row start change end
1 1 111.34 9.12 120.46
2 2 100.00 -0.18 99.82
3 3 125.29 -9.09 116.20
4 4 99.82 8.33 108.15
5 5 120.46 4.83 125.29
6 6 108.15 3.19 111.34
orig
row start change end
1 2 100.00 -0.18 99.82
2 4 99.82 8.33 108.15
3 6 108.15 3.19 111.34
4 1 111.34 9.12 120.46
5 5 120.46 4.83 125.29
6 3 125.29 -9.09 116.20
答案 2 :(得分:0)
下面的最小示例提供了sort_transactions
-一种递归函数,该递归函数使用一系列联接顺序标识成对的期初余额和期末余额。
library(dplyr)
set.seed(123456) # For reproducibility with runif()
# A set of original transactions
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,
start = end - change
) %>% select(
-temp
)
# Jumble original_transactions
transactions <- original_transactions %>% sample_n(
6
) %>% mutate(
row = row_number()
)
sort_transactions <- function(input_df) {
if (nrow(input_df) < 2) {
return (input_df)
} else { # nrow(input_df) >= 2
return (
input_df %>% anti_join(
input_df,
by = c(
'start' = 'end'
)
) %>% bind_rows(
sort_transactions(
input_df %>% semi_join(
input_df,
by = c(
'start' = 'end'
)
) %>% semi_join(
input_df,
by = c(
'end' = 'start'
)
)
),
input_df %>% anti_join(
input_df,
by = c(
'end' = 'start'
)
)
)
)
}
}
用法(需要conversion of numeric columns to character for comparison):
transactions %>% mutate(
start = start %>% as.character(),
end = end %>% as.character()
) %>% sort_transactions() %>% mutate(
start = start %>% as.numeric(),
end = end %>% as.numeric()
)
# row start change end
# 2 100.00 5.96 105.96
# 5 105.96 5.07 111.03
# 6 111.03 -2.17 108.86
# 1 108.86 -3.17 105.69
# 4 105.69 -2.77 102.92
# 3 102.92 -6.03 96.89