Sorting a list of random transactions using dplyr

First, let

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

and

diffs <- outer(transactions$start, transactions$start, `-`)
matches <- abs(sweep(diffs, 2, transactions$change, `-`)) < 1e-3

I guess that computing diffs is the most computationally expensive part in the whole solution. diffs has all possible differences between start of your transactions. Then comparing those with the change column in matches we know which pairs of rows of transactions should go together. If there were no problems regarding numeric precision, we could then use the match function and be done quickly. In this case, however, we have the following two options.

First, we may use 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

That is, we have a hidden path graph: 1->4->3->2->5->6 which we want to recover. It is given by the longest path from the vertex which has no incoming edges (which is 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

Another option is recursive.

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 uses the same unique longest path graph idea as the previous approach.

No explicit loops... And of course you may rewrite everything with %>%, but it won't be as pretty as you want; this is not really a traditional data transformation task where dplyr is best.

Here is a way using a tidyverse pipeline. It matches start and end figures (using character to avoid floating point problems), then uses purrr::accumulate to construct the chain, and slice to reorder the rows...

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

The following minimal example provides sort_transactions - a recursive function that sequentially identifies pairs of starting and ending balances using a series of joins.

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'
          )
        )
      )
    )
  }

}

Usage (requires 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