link records in r with least number of steps - r

Question

I have a dataset with 2 columns like below.
INBOUND OUTBOUND
a1 a2
a1 a3
a1 a6
a2 a50
a4 a63
a8 a9
a10 a11
a50 a51
I wanted to give a similar id to those which are interlinked
Ex: a1 is linked to a2 , a2 is linked to a50, a50 to a51... So I would want to create a variable "id" and give same id to all these records.
I am right now doing a merge operation and marking these records. But since this is not an exhaustive search, I am able to mark only a1 --> a2, and a2 --> a50 with the same id.
So I am assuming there should be a better way to do this in one shot.
Help needed on this. Thanks
#
> dat <- read.csv("C:\\Users\\abc\\Documents\\Book1.csv", stringsAsFactors=FALSE, header = TRUE, sep = ",")
> dat
INBOUND OUTBOUND
1 a1 a2
2 a1 a3
3 a1 a6
4 a2 a50
5 a4 a63
6 a8 a9
7 a10 a11
8 a50 a51
> g <- graph.data.frame(dat)
> clusters(g)
$membership
[1]
1 2 3 4 5 6 1 1 1 2 3 4 5 6
$csize
[1]
4 2 2 2 2 2
$no
[1]
6
The clusters(g)$membership i got is this
1 2 3 4 5 6 1 1 1 2 3 4 5 6
And the one you got for the same data is
1 1 2 3 4 1 1 1 2 3 4 1

Answer 1

Edit: I added a much simpler answer using igraph below
Coincidentally, I happened to have a similar problem this week. I ended up using an algorithm from Numerical Recipes (section 8.6 on page 345) (the code in this edition contains some errors, by the way). However, the algorithm itself it is written in c++, so I hope you have the tools installed to compile this.
The code is given below. Using the function equivalence on you dataset:
> relations <- "INBOUND OUTBOUND
+ a1 a2
+ a1 a3
+ a1 a6
+ a2 a50
+ a4 a63
+ a8 a9
+ a10 a11
+ a50 a51"
> relations <- read.table(textConnection(relations), stringsAsFactors=FALSE, header=TRUE)
>
> source("equivalence.R")
> objects <- unique(c(relations[[1]], relations[[2]]))
> groups <- equivalence(objects, relations)
>
> data.frame(objects, groups)
objects groups
1 a1 12
2 a2 12
3 a4 9
4 a8 10
5 a10 11
6 a50 12
7 a3 12
8 a6 12
9 a63 9
10 a9 10
11 a11 11
12 a51 12
equivalence.cpp
The c++ file with the algorithm
#include <R.h>
#include <Rinternals.h>
#include <string>
extern "C" {
SEXP equivalence(SEXP ra, SEXP rb, SEXP rn) {
try {
if (LENGTH(ra) != LENGTH(rb))
throw std::string("Lengths of a and be do not match.");
int* a = INTEGER(ra);
int* b = INTEGER(rb);
int m = LENGTH(ra);
int n = INTEGER(rn)[0];
SEXP classes = PROTECT(allocVector(INTSXP, n));
int* cls = INTEGER(classes);
//Initialize each element its own class.
for (int k = 0; k < n; k++) cls[k] = k;
//For each piece of input information...
for (int l = 0; l < m; l++) {
//Track first element up to its ancestor.
int j = a[l];
while (cls[j] != j) j = cls[j];
//Track second element up to its ancestor.
int k = b[l];
while (cls[k] != k) k = cls[k];
//If they are not already related, make them so.
if (j != k) {
cls[j] = k;
}
}
//Final sweep up to highest ancestors.
for (int j = 0; j < n; j++) {
while (cls[j] != cls[cls[j]]) cls[j] = cls[cls[j]];
}
UNPROTECT(1);
return classes;
} catch(const std::string& e) {
error(e.c_str());
return R_NilValue;
} catch (...) {
error("Uncaught exception.");
return R_NilValue;
}
}
equivalence.R
The code that loads the shared library (change extension from .so to .dll if you are working under windows)
dyn.load("equivalence.so")
equivalence <- function(x, rules) {
tmp <- unique(x)
tmp <- tmp[!is.na(tmp)]
a <- match(rules[[1]], tmp)
b <- match(rules[[2]], tmp)
sel <- !is.na(a) & !is.na(b)
if (any(!sel)) {
warning("Not all values in rules are present in x.")
a <- a[sel]
b <- b[sel]
}
res <- .Call("equivalence", as.integer(a)-1L, as.integer(b)-1L,
as.integer(length(tmp)));
res[match(x, tmp)] + 1L
}
Using igraph
You can also use igraph, which is much simpler (should have thought of that before). The groups can be obtained using the clusters function and the corresponding nodes/vertices can be obtained using the V function:
> library(igraph)
> g <- graph.data.frame(relations)
> cl <- clusters(g)
> data.frame(object = V(g)$name, groups = cl$membership)
object groups
1 a1 1
2 a2 1
3 a4 2
4 a8 3
5 a10 4
6 a50 1
7 a3 1
8 a6 1
9 a63 2
10 a9 3
11 a11 4
12 a51 1