Instantly share code, notes, and snippets.

# mjdominus/circle.pl Created Jan 18, 2013

Search for permutations of objects in a circle for which any pair of objects is at a different minimal distance along the circle than originally; see http://math.stackexchange.com/questions/281094.
 #!/usr/bin/perl my \$M = shift() || 15; # A node has [ N, [1, ... ] ] # where N is the max of the [ 1, ... ] sub children { my (\$node) = @_; my (\$N, \$circ) = @\$node; my @children; return if \$N == \$M;; for my \$i (0 .. \$M-1) { next if defined \$circ->[\$i]; my @new_circ = @\$circ; \$new_circ[\$i] = \$N+1; my \$newnode = [\$N+1, \@new_circ]; push @children, \$newnode if okay(\$i, \$newnode); } return grep okay(\$_), @children; } sub okay { my (\$j, \$node) = @_; my (\$N, \$circ) = @\$node; my \$v = \$circ->[\$j]; for my \$i (0 .. \$M-1) { next unless defined \$circ->[\$i]; my \$d = minus(\$j, \$i); my \$dd = minus(\$v, \$circ->[\$i]); return if \$d != 0 && \$dd == \$d; } return 1; } sub root { return [1, [1]]; } sub minus { my (\$p, \$q) = @_; my \$d1 = abs(\$p-\$q); my \$d2 = \$M - \$d1; return \$d1 < \$d2 ? \$d1 : \$d2; } my @queue = root(); \$| = 1; while (my \$node = shift @queue) { my (\$N, \$circ) = @\$node; print STDERR "| " x \$N, "@\$circ\n" if \$N % 5 == 0; if (\$N == \$M) { my \$circ = \$node->[1]; print "@\$circ\n"; } unshift @queue, children(\$node); }