使用dplyr对随机交易列表进行排序

时间:2018-12-20 05:36:43

标签: r sorting 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
)

enter image description here

它显示了一个按时间顺序排列的交易序列,起始余额为$ 100.00,结束余额为$ 95.65,其中有六笔交易/更改。

现在假设您收到的是混杂的版本

transactions <- original_transactions %>% sample_n(
  6
) %>% mutate(
  row = row_number() # Original sequence is unknown
)

enter image description here

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

假定期初/期末余额是唯一的,并且一般而言,交易数量可以变化。

3 个答案:

答案 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是整个解决方案中计算量最大的部分。 diffsstart中的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管道的一种方式。它匹配startend图形(使用字符以避免浮点问题),然后使用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