web-dev-qa-db-fra.com

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
)

 enter image description here

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
)

 enter image description here

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.

8
Werner

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.

6
Julius Vainora

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
2
Andrew Gustar

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
0
Werner