Tri d'une liste de transactions aléatoires à l'aide de dplyr
Supposons le jeu suivant de transactions d'origine:
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
)
Il présente une séquence (chronologique) de transactions avec un solde de départ de 100,00 USD et un solde final de 95,65 USD, avec six transactions/modifications.
Supposons maintenant que vous recevez une version brouillée de cette
transactions <- original_transactions %>% sample_n(
6
) %>% mutate(
row = row_number() # Original sequence is unknown
)
Comment puis-je désosser la séquence dans R? Autrement dit, pour que l'ordre de tri de transactions corresponde à celui de original_transactions? Idéalement, j'aimerais utiliser dplyr et une séquence de tubes %>% pour éviter les boucles.
Supposons que les soldes de début et de fin seront uniques et que, en général, le nombre de transactions peut varier.
Tout d'abord, laissez
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
et
diffs <- outer(transactions$start, transactions$start, `-`)
matches <- abs(sweep(diffs, 2, transactions$change, `-`)) < 1e-3
Je suppose que l'informatique diffs est la partie la plus coûteuse en calcul de l'ensemble de la solution. diffs a toutes les différences possibles entre start et transactions. Ensuite, en comparant ceux avec la colonne change dans matches, nous savons quelles paires de lignes de transactions doivent aller ensemble. S'il n'y avait pas de problème de précision numérique, nous pourrions alors utiliser la fonction match et le faire rapidement. Dans ce cas, cependant, nous avons les options suivantes: deux options .
Premièrement, nous pouvons utiliser 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
C'est-à-dire que nous avons un graphique de chemin caché: 1-> 4-> 3-> 2-> 5-> 6 que nous voulons récupérer. Il est donné par le plus long chemin du sommet qui n'a pas de fronts entrants (qui est 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
Une autre option est récursive.
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
Il utilise la même idée unique de graphe de chemin le plus long que l'approche précédente.
Pas de boucles explicites ... Et bien sûr, vous pouvez tout réécrire avec %>%, mais ce ne sera pas aussi joli que vous le voudriez; ce n'est pas vraiment une tâche de transformation de données traditionnelle où dplyr est la meilleure solution.
Voici un moyen d'utiliser un pipeline tidyverse. Il correspond aux chiffres start et end (en utilisant des caractères pour éviter les problèmes de virgule flottante), puis utilise purrr::accumulate pour construire la chaîne et slice pour réorganiser les lignes ...
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
L'exemple minimal suivant fournit sort_transactions - une fonction récursive qui identifie séquentiellement des paires de soldes de début et de fin à l'aide d'une série de jointures.
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'
)
)
)
)
}
}
Utilisation (nécessite conversion des colonnes numériques en caractères pour comparaison ):
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