Skip to content

Instantly share code, notes, and snippets.

@masak
Created March 24, 2012 23:31
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save masak/2189078 to your computer and use it in GitHub Desktop.
Save masak/2189078 to your computer and use it in GitHub Desktop.
Generating hex puzzle models for the DLX solver
sub MAIN(Int $smallwidth, Int $height, Str :$exclude = '') {
$exclude ~~ /^ [[<[a..z]><[1..9]>] ** ',']? $/
or die "Can't understand exclude format, should be e.g. 'a1,b2,d4'";
my @excluded = $exclude.comb(/\w*/);
sub even { $^n %% 2 }
# The algebra in the below subs is of the type "it works, OK?"
sub falling_diag($row, $column) {
my $groove
= chr(ord('a') + $smallwidth - $column - 1 + ($row+1) div 2);
my $digit = $row + 1;
if ($row+1) div 2 > $column {
$digit -= (($row+1) div 2 - $column) * 2 - 1;
}
return $groove ~ $digit;
}
sub horizontal($row, $column) {
my $groove_offset = ord('a') + $smallwidth + $height div 2;
my $groove = chr($groove_offset + $row);
my $digit = $column + 1;
return $groove ~ $digit;
}
sub rising_diag($row, $column) {
my $groove_offset = ord('a') + $smallwidth + $height div 2 + $height;
my $groove = chr($groove_offset + $column + $row div 2);
my $digit = $height - $row;
if $groove lt chr($groove_offset + ($height-1) div 2) {
if even $height {
$digit -= (($height-$row+1) div 2 - $column - 1) * 2;
}
else {
$digit -= (($height-$row) div 2 - $column) * 2 - 1;
}
}
return $groove ~ $digit;
}
my $bigwidth = $smallwidth + 1;
for &falling_diag, &horizontal, &rising_diag -> &namer {
for ^$height -> $row {
my $width = even($row) ?? $smallwidth !! $bigwidth;
my @places = gather for ^$width -> $column {
my $name = &namer($row, $column);
if $name eq any @excluded {
$name = "XX";
}
take $name;
}
my $prefix = even($row) ?? "# " !! "# ";
say $prefix, @places.join(" ");
}
say "";
}
for ^$height -> $row {
for ^(even($row) ?? $smallwidth !! $bigwidth) -> $column {
my @coordinates
= (.($row, $column)
for &falling_diag, &horizontal, &rising_diag);
next if all(@coordinates) eq any(@excluded);
my $coordinates = @coordinates.join(",");
print $coordinates, "; ";
}
}
say "";
my %coords;
for &falling_diag, &horizontal, &rising_diag -> &namer {
for ^$height -> $row {
for ^(even($row) ?? $smallwidth !! $bigwidth) -> $column {
my $coord = &namer($row, $column);
%coords{$coord} = 1;
}
}
}
for ^$height -> $row {
for ^(even($row) ?? $smallwidth !! $bigwidth) -> $column {
next if
all(&falling_diag, &horizontal, &rising_diag)($row, $column)
eq any @excluded;
print &horizontal($row, $column), "; ";
}
}
my $groove = 'a';
repeat while %coords.exists( ++$groove ~ '1') {
my $groove_length
= (1..*).first({ !%coords.exists( $groove ~ $_ ) }) - 1;
for 1 .. $groove_length-1 {
next if any("$groove$_", $groove ~ ($_+1)) eq any(@excluded);
print $groove ~ $_ ~ ($_+1), "; ";
}
}
$groove = 'a';
repeat while %coords.exists( ++$groove ~ '1') {
my $groove_length
= (1..*).first({ !%coords.exists( $groove ~ $_ ) }) - 1;
for 1 .. $groove_length-2 {
next if any("$groove$_", $groove ~ ($_+1), $groove ~ ($_+2))
eq any(@excluded);
print $groove ~ $_ ~ ($_+1) ~ ($_+2), "; ";
}
}
say "";
}
$ perl6 generate-coords-pieces 5 7
# e1 d1 c1 b1 a1
# f1 e2 d2 c2 b2 a2
# f2 e3 d3 c3 b3
# g1 f3 e4 d4 c4 b4
# g2 f4 e5 d5 c5
# h1 g3 f5 e6 d6 c6
# h2 g4 f6 e7 d7
# i1 i2 i3 i4 i5
# j1 j2 j3 j4 j5 j6
# k1 k2 k3 k4 k5
# l1 l2 l3 l4 l5 l6
# m1 m2 m3 m4 m5
# n1 n2 n3 n4 n5 n6
# o1 o2 o3 o4 o5
# p2 q4 r6 s7 t7
# p1 q3 r5 s6 t6 u6
# q2 r4 s5 t5 u5
# q1 r3 s4 t4 u4 v4
# r2 s3 t3 u3 v3
# r1 s2 t2 u2 v2 w2
# s1 t1 u1 v1 w1
e1,i1,p2; d1,i2,q4; c1,i3,r6; b1,i4,s7; a1,i5,t7; f1,j1,p1; e2,j2,q3; d2,j3,r5;
c2,j4,s6; b2,j5,t6; a2,j6,u6; f2,k1,q2; e3,k2,r4; d3,k3,s5; c3,k4,t5; b3,k5,u5;
g1,l1,q1; f3,l2,r3; e4,l3,s4; d4,l4,t4; c4,l5,u4; b4,l6,v4; g2,m1,r2; f4,m2,s3;
e5,m3,t3; d5,m4,u3; c5,m5,v3; h1,n1,r1; g3,n2,s2; f5,n3,t2; e6,n4,u2; d6,n5,v2;
c6,n6,w2; h2,o1,s1; g4,o2,t1; f6,o3,u1; e7,o4,v1; d7,o5,w1;
i1; i2; i3; i4; i5; j1; j2; j3; j4; j5; j6; k1; k2; k3; k4; k5; l1; l2; l3; l4;
l5; l6; m1; m2; m3; m4; m5; n1; n2; n3; n4; n5; n6; o1; o2; o3; o4; o5; a12; b12;
b23; b34; c12; c23; c34; c45; c56; d12; d23; d34; d45; d56; d67; e12; e23; e34;
e45; e56; e67; f12; f23; f34; f45; f56; g12; g23; g34; h12; i12; i23; i34; i45;
j12; j23; j34; j45; j56; k12; k23; k34; k45; l12; l23; l34; l45; l56; m12; m23;
m34; m45; n12; n23; n34; n45; n56; o12; o23; o34; o45; p12; q12; q23; q34; r12;
r23; r34; r45; r56; s12; s23; s34; s45; s56; s67; t12; t23; t34; t45; t56; t67;
u12; u23; u34; u45; u56; v12; v23; v34; w12; b123; b234; c123; c234; c345; c456;
d123; d234; d345; d456; d567; e123; e234; e345; e456; e567; f123; f234; f345;
f456; g123; g234; i123; i234; i345; j123; j234; j345; j456; k123; k234; k345;
l123; l234; l345; l456; m123; m234; m345; n123; n234; n345; n456; o123; o234;
o345; q123; q234; r123; r234; r345; r456; s123; s234; s345; s456; s567; t123;
t234; t345; t456; t567; u123; u234; u345; u456; v123; v234;
$ perl6 generate-coords-pieces --exclude=g1,f3,l1,l2,q1,r3 5 7
# e1 d1 c1 b1 a1
# f1 e2 d2 c2 b2 a2
# f2 e3 d3 c3 b3
# XX XX e4 d4 c4 b4
# g2 f4 e5 d5 c5
# h1 g3 f5 e6 d6 c6
# h2 g4 f6 e7 d7
# i1 i2 i3 i4 i5
# j1 j2 j3 j4 j5 j6
# k1 k2 k3 k4 k5
# XX XX l3 l4 l5 l6
# m1 m2 m3 m4 m5
# n1 n2 n3 n4 n5 n6
# o1 o2 o3 o4 o5
# p2 q4 r6 s7 t7
# p1 q3 r5 s6 t6 u6
# q2 r4 s5 t5 u5
# XX XX s4 t4 u4 v4
# r2 s3 t3 u3 v3
# r1 s2 t2 u2 v2 w2
# s1 t1 u1 v1 w1
e1,i1,p2; d1,i2,q4; c1,i3,r6; b1,i4,s7; a1,i5,t7; f1,j1,p1; e2,j2,q3; d2,j3,r5;
c2,j4,s6; b2,j5,t6; a2,j6,u6; f2,k1,q2; e3,k2,r4; d3,k3,s5; c3,k4,t5; b3,k5,u5;
e4,l3,s4; d4,l4,t4; c4,l5,u4; b4,l6,v4; g2,m1,r2; f4,m2,s3; e5,m3,t3; d5,m4,u3;
c5,m5,v3; h1,n1,r1; g3,n2,s2; f5,n3,t2; e6,n4,u2; d6,n5,v2; c6,n6,w2; h2,o1,s1;
g4,o2,t1; f6,o3,u1; e7,o4,v1; d7,o5,w1;
i1; i2; i3; i4; i5; j1; j2; j3; j4; j5; j6; k1; k2; k3; k4; k5; l3; l4; l5; l6;
m1; m2; m3; m4; m5; n1; n2; n3; n4; n5; n6; o1; o2; o3; o4; o5; a12; b12; b23;
b34; c12; c23; c34; c45; c56; d12; d23; d34; d45; d56; d67; e12; e23; e34; e45;
e56; e67; f12; f45; f56; g23; g34; h12; i12; i23; i34; i45; j12; j23; j34; j45;
j56; k12; k23; k34; k45; l34; l45; l56; m12; m23; m34; m45; n12; n23; n34; n45;
n56; o12; o23; o34; o45; p12; q23; q34; r12; r45; r56; s12; s23; s34; s45; s56;
s67; t12; t23; t34; t45; t56; t67; u12; u23; u34; u45; u56; v12; v23; v34; w12;
b123; b234; c123; c234; c345; c456; d123; d234; d345; d456; d567; e123; e234;
e345; e456; e567; f456; g234; i123; i234; i345; j123; j234; j345; j456; k123;
k234; k345; l345; l456; m123; m234; m345; n123; n234; n345; n456; o123; o234;
o345; q234; r456; s123; s234; s345; s456; s567; t123; t234; t345; t456; t567;
u123; u234; u345; u456; v123; v234;
$ perl6 generate-coords-pieces \
--exclude=g1,f3,e4,d4,c4,b4,l1,l2,l3,l4,l5,l6,q1,r3,s4,t4,u4,v4 5 7
# e1 d1 c1 b1 a1
# f1 e2 d2 c2 b2 a2
# f2 e3 d3 c3 b3
# XX XX XX XX XX XX
# g2 f4 e5 d5 c5
# h1 g3 f5 e6 d6 c6
# h2 g4 f6 e7 d7
# i1 i2 i3 i4 i5
# j1 j2 j3 j4 j5 j6
# k1 k2 k3 k4 k5
# XX XX XX XX XX XX
# m1 m2 m3 m4 m5
# n1 n2 n3 n4 n5 n6
# o1 o2 o3 o4 o5
# p2 q4 r6 s7 t7
# p1 q3 r5 s6 t6 u6
# q2 r4 s5 t5 u5
# XX XX XX XX XX XX
# r2 s3 t3 u3 v3
# r1 s2 t2 u2 v2 w2
# s1 t1 u1 v1 w1
e1,i1,p2; d1,i2,q4; c1,i3,r6; b1,i4,s7; a1,i5,t7; f1,j1,p1; e2,j2,q3; d2,j3,r5;
c2,j4,s6; b2,j5,t6; a2,j6,u6; f2,k1,q2; e3,k2,r4; d3,k3,s5; c3,k4,t5; b3,k5,u5;
g2,m1,r2; f4,m2,s3; e5,m3,t3; d5,m4,u3; c5,m5,v3; h1,n1,r1; g3,n2,s2; f5,n3,t2;
e6,n4,u2; d6,n5,v2; c6,n6,w2; h2,o1,s1; g4,o2,t1; f6,o3,u1; e7,o4,v1; d7,o5,w1;
i1; i2; i3; i4; i5; j1; j2; j3; j4; j5; j6; k1; k2; k3; k4; k5; m1; m2; m3; m4;
m5; n1; n2; n3; n4; n5; n6; o1; o2; o3; o4; o5; a12; b12; b23; c12; c23; c56; d12;
d23; d56; d67; e12; e23; e56; e67; f12; f45; f56; g23; g34; h12; i12; i23; i34;
i45; j12; j23; j34; j45; j56; k12; k23; k34; k45; m12; m23; m34; m45; n12; n23;
n34; n45; n56; o12; o23; o34; o45; p12; q23; q34; r12; r45; r56; s12; s23; s56;
s67; t12; t23; t56; t67; u12; u23; u56; v12; v23; w12; b123; c123; d123; d567;
e123; e567; f456; g234; i123; i234; i345; j123; j234; j345; j456; k123; k234;
k345; m123; m234; m345; n123; n234; n345; n456; o123; o234; o345; q234; r456;
s123; s567; t123; t567; u123; v123;
$ perl6 generate-coords-pieces 5 3
# e1 d1 c1 b1 a1
# f1 e2 d2 c2 b2 a2
# f2 e3 d3 c3 b3
# g1 g2 g3 g4 g5
# h1 h2 h3 h4 h5 h6
# i1 i2 i3 i4 i5
# j2 k3 l3 m3 n3
# j1 k2 l2 m2 n2 o2
# k1 l1 m1 n1 o1
e1,g1,j2; d1,g2,k3; c1,g3,l3; b1,g4,m3; a1,g5,n3; f1,h1,j1; e2,h2,k2; d2,h3,l2;
c2,h4,m2; b2,h5,n2; a2,h6,o2; f2,i1,k1; e3,i2,l1; d3,i3,m1; c3,i4,n1; b3,i5,o1;
g1; g2; g3; g4; g5; h1; h2; h3; h4; h5; h6; i1; i2; i3; i4; i5; a12; b12; b23;
c12; c23; d12; d23; e12; e23; f12; g12; g23; g34; g45; h12; h23; h34; h45; h56;
i12; i23; i34; i45; j12; k12; k23; l12; l23; m12; m23; n12; n23; o12; b123; c123;
d123; e123; g123; g234; g345; h123; h234; h345; h456; i123; i234; i345; k123;
l123; m123; n123;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment