public
Created

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.

  • Download Gist
circle.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
#!/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);
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.