d20 puzzle from reddit

#!/usr/bin/perl

# http://www.reddit.com/r/math/comments/1j86p4/d20_perfect_layout/
# asks whether there is a 20-sided die such that for every face f, the value
# on face f and the values of all three faces adjacent to f add up to 42.
# (42 is what you might reasonably hope for, since the average value of a face
# taking values 1, 2, ..., 19, 20 is 10.5, and we're adding 4 faces) 
# This script prints out an octave expression for M^{-1} v where M is the adjacency
# matrix of the faces of an icosahedron, and v is a column vector of 20 copies of 42.

# Sadly, the resulting matrix is nonsingular and yields the answer that the only
# satisfying labelling is all faces getting the value of exactly 10.5.

# To build the adjacency matrix, we divide the icosahedron into four layers:

#   p  /|\
#      ---
# q/r |/\/|
#      ---
#   s  \|/

my @matrix;
my %findex;

sub edge {
  my ($from, $to) = @_;
  my ($a, $b) = ($findex{$from}, $findex{$to});
  $matrix[$a][$b] = 1;
  $matrix[$b][$a] = 1;
}

for $layer ("p".."s") {
  for $f (0..4) {
    push @faces, "$layer$f";
    $findex{"$layer$f"} = $#faces;
  }
}

for (0..$#faces) {
  push @matrix, [("0") x @faces];
}

for $f (0..4) {
  my $prev = ($f + 4) % 5;
  my $next = ($f + 1) % 5;
  my $op2 = ($f + 2) % 5;
  my $op3 = ($f + 3) % 5;

  edge("p$f", "q$f");
  edge("p$f", "p$next");

  edge("q$f", "r$op2");
  edge("q$f", "r$op3");

  edge("r$f", "s$f");
  edge("s$f", "s$next");

  for $layer ("p".."s") {
    edge("$layer$f", "$layer$f");
  }
}

print "(inv([\n";
for my $x (0..$#faces) {
  print join(", ", @{$matrix[$x]});
  $x != $#faces and print " ;\n";
}
$vec = join(" ; ", ((42) x 20));
print "\n]) * [ $vec ])\n";

# # debugging visualization of matrix
# for my $x (0..$#faces) {
#   print $faces[$x], "   ";
#   for my $y (0..$#faces) {
#     print $matrix[$x][$y] ? "1 " : "  ";
#   }
#   print "\n";
# }

__END__

Output of the script is:

(inv([
1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ;
1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ;
0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ;
0, 0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ;
1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ;
1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0 ;
0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0 ;
0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0 ;
0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 ;
0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0 ;
0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0 ;
0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0 ;
0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0 ;
0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0 ;
0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1 ;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1 ;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 0 ;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0 ;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1 ;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1
]) * [ 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ; 42 ])