Find equivalence class of graphs from a matrix of coordinates

Question

let me explain: My data is a 5x5 grid of points (so n=25). Now say I want to choose J points. I can work out all possible combination combo using the function combn. But this is a very large matrix, and with what I want to achieve at the end, I can actually define a equivalence class by rotation (90, 180, 270 degree) and reflection. So for example, p1 is equivalent to p2,p3,p4,p5...,p8

data<-expand.grid(1:5,1:5)  
J=5   # for example  
combo<-combn(25,J)  
 # rotation symmetry  
p1=c(1,6,15,20,25)  
p2=c(3,4,5,21,22)  
p3=c(1,6,11,20,25)  
p4=c(4,5,21,22,23)  
 # reflection symmetry  
p5=c(5,10,11,16,21)  
p6=c(1,2,23,24,25)  
p7=c(5,10,15,16,21)  
p8=c(1,2,3,24,25)
 # to help you visualize
par(mfrow=c(4,2))
equiv<-rbind(p1,p2,p3,p4,p5,p6,p7,p8)
fn<-function(x){
p.col=rep(1,25);p.col[x]=2
plot(expand.grid(1:5,1:5),col=p.col,asp=1)}
apply(equiv,1,fn)

After this, I can simply eliminate the equivalent rows, so that my combo is a much smaller matrix. So basically, I am looking for a script that ultimately gives me the compact version of combo.

Any help is appreciated. Thanks.

edit: I haven't tried anything yet. I was hoping there will be some R package for graph theory/combinatorics that does this.

Answer 1

For each combination, you can enumerate the other elements of the equivalence class, compute some numeric quantity that identifies them (say, an MD5 checksum), and only keep the combination if it has the smallest value.

# Enumerate the transformations (the dihedral group of order 8)
k <- 5
d1 <- expand.grid( 1:k, 1:k ) 
d2 <- expand.grid( k:1, 1:k ) 
d3 <- expand.grid( 1:k, k:1 ) 
d4 <- expand.grid( k:1, k:1 )
o1 <- order(d1[,1], d1[,2])
o2 <- order(d2[,1], d2[,2])
o3 <- order(d3[,1], d3[,2])
o4 <- order(d4[,1], d4[,2])
o5 <- order(d1[,2], d1[,1])
o6 <- order(d2[,2], d2[,1])
o7 <- order(d3[,2], d3[,1])
o8 <- order(d4[,2], d4[,1])
g1 <- function(p) o1[p]
g2 <- function(p) o2[p]
g3 <- function(p) o3[p]
g4 <- function(p) o4[p]
g5 <- function(p) o5[p]
g6 <- function(p) o6[p]
g7 <- function(p) o7[p]
g8 <- function(p) o8[p]
transformations <- list(g1,g2,g3,g4,g5,g6,g7,g8)

# Check that we have all the transformations
op <- par(mfrow=c(3,3), las=2, mar=c(1,1,1,1))
for( f in transformations ) { 
  plot( d1 )
  lines( d1[f(1:10),] )
}
par(op)

# Function to decide whether to keep a value
library(digest)
keep <- function(p, d) {
  q0 <- digest( d[ sort(p), , drop=FALSE] )
  q <- sapply( transformations, function(f) digest( d[ sort(f(p)), , drop=FALSE ] ) )
  q0 == sort(q)[1]
}

# Apply the function on each column    
i <- apply(combo, 2, keep, d=d1)  # Long...
length(i) / sum(i)   # Around 8 (not exactly, because some of those combinations are symmetric)
result <- combo[,i] 

In your example, we only keep one of the 8 elements:

apply( equiv, 1, keep, d=d1 )
#    p1    p2    p3    p4    p5    p6    p7    p8 
# FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE