I have a data frame with bilateral relations between countries:
C1 C2
US FR
FR US
US DE
DE US
US RU
US FI
RU FI
FI RU
The links are directional and some of them are missing (e.g. I have US>RU but not RU>US). I would like to identify all unique pairs; to have something like this:
C1 C2 PairID
US FR 1
FR US 1
US DE 2
DE US 2
US RU -
US FI -
RU FI 3
FI RU 3
Any suggestions?
Here is one option assuming you also want to count relations that are not bidirectional like US>RU
:
library(dplyr)
df %>%
mutate(relation = paste(pmin(C1, C2), pmax(C1, C2), sep = "-"), #define the relation no matter the direction
PairID = cumsum(c(1, head(relation, -1) != tail(relation, -1)))) %>%
select(-relation)
# output
C1 C2 PairID
1 US FR 1
2 FR US 1
3 US DE 2
4 DE US 2
5 US RU 3
6 US FI 4
7 RU FI 5
8 FI RU 5
# Data: df
structure(list(C1 = c("US", "FR", "US", "DE", "US", "US", "RU",
"FI"), C2 = c("FR", "US", "DE", "US", "RU", "FI", "FI", "RU")), .Names = c("C1",
"C2"), class = "data.frame", row.names = c(NA, -8L))
We can create a string identifier that captures a given pair of countries independent of their ordering:
library( tidyverse )
# Original data
X <- data_frame(C1 = c("US", "FR", "US", "DE", "US", "US", "RU", "FI"),
C2 = c("FR", "US", "DE", "US", "RU", "FI", "FI", "RU"))
# Creates an order-independent string ID for each entry
Y <- X %>% mutate( S = map2_chr( C1, C2, ~str_flatten(sort(c(.x,.y))) ) )
# # A tibble: 8 x 3
# C1 C2 S
# <chr> <chr> <chr>
# 1 US FR FRUS
# 2 FR US FRUS
# 3 US DE DEUS
# 4 DE US DEUS
# 5 US RU RUUS
# ...
We can then use these string identifiers to find pairs of countries that occur in both directions (e.g., US > FR
and FR > US
). These pairs will have two matching string IDs.
# Identify string IDs with both orderings and assign an integer ID to each
Z <- Y %>% group_by(S) %>% filter( n() == 2 ) %>% ungroup %>% # Keep groups of size 2
select(S) %>% distinct %>% mutate( PairID = 1:n() ) # Annotate unique values
# # A tibble: 3 x 2
# S PairID
# <chr> <int>
# 1 FRUS 1
# 2 DEUS 2
# 3 FIRU 3
All that's left to do is join the new string ID -> integer ID map against the original data, and replace NAs with "-"
:
left_join( Y, Z ) %>% select(-S) %>% mutate_at( "PairID", replace_na, "-")
# # A tibble: 8 x 3
# C1 C2 PairID
# <chr> <chr> <chr>
# 1 US FR 1
# 2 FR US 1
# 3 US DE 2
# 4 DE US 2
# 5 US RU -
# 6 US FI -
# 7 RU FI 3
# 8 FI RU 3
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With