Найти класс эквивалентности графов из матрицы координат

Question

Позвольте мне объяснить: мой data сетка точек 5х5 (поэтому n=25). Теперь скажите, что я хочу выбрать J очков. Я могу выработать все возможные комбинации combo используя функцию combn, Но это очень большая матрица, и с помощью того, чего я хочу достичь в конце, я могу фактически определить класс эквивалентности путем поворота (90, 180, 270 градусов) и отражения. Так, например, p1 эквивалентно 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)

После этого я могу просто удалить эквивалентные строки, чтобы мой combo это гораздо меньшая матрица. В общем, я ищу сценарий, который в конечном итоге дает мне компактную версию combo,

Любая помощь приветствуется. Благодарю.

редактировать: я еще ничего не пробовал Я надеялся, что будет некоторый пакет R для теории графов / комбинаторики, который сделает это.

Answer 1

Для каждой комбинации вы можете перечислить другие элементы класса эквивалентности, вычислить некоторую числовую величину, которая их идентифицирует (скажем, контрольную сумму MD5), и сохранить комбинацию, только если она имеет наименьшее значение.

# 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] 

В вашем примере мы оставляем только один из 8 элементов:

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