Сортировка списка случайных транзакций с использованием dplyr

Question

Предположим следующий набор исходных транзакций:

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 и последовательность конвейеров %>% и избегать циклов.

Предположим, что начальные / конечные сальдо будут уникальными и, как правило, количество транзакцийможет варьироваться.

Answer 1

Вот способ использования tidyverse конвейера.Он сопоставляет цифры start и end (используя символ, чтобы избежать проблем с плавающей запятой), затем использует purrr::accumulate для построения цепочки и slice для изменения порядка строк ...

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

Answer 2

Следующий минимальный пример предоставляет 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'
          )
        )
      )
    )
  }

}

Использование (требуется преобразование числовых столбцов всимвол для сравнения ):

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

Answer 3

Во-первых, пусть

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

Itиспользует ту же уникальную идею самого длинного графа путей, что и в предыдущем подходе.

---

Нет явных циклов ... И, конечно, вы можете переписать все с помощью %>%, но это будет не так красиво, как выхочу;на самом деле это не традиционная задача преобразования данных, где dplyr лучше всего.