Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Boxes and pebbles exploration
class Conf {
has @.boxes where *.all >= 0;
method gist { "[$.boxes]" }
}
sub conf(@boxes) { Conf.new(:@boxes) }
sub n(Conf $c) { $c.boxes.elems }
sub REPL($line) {
say "> $line";
my $result = EVAL $line;
say $result if defined $result;
}
REPL 'n(conf [2, 0])';
sub but(@list, &act) { my @new = @list; &act(@new); @new }
sub add($c, $to, $count) { conf $c.boxes.&but(*.[$to] += $count) }
sub remove($c, $from, $count) { conf $c.boxes.&but(*.[$from] -= $count) }
sub move($c, $from, $to) { $c.&remove($from, 2).&add($to, 1) }
my $OPTIMIZATION_1 = False;
sub moves-from($c, $from) {
sub to_hostage($t) { $OPTIMIZATION_1 ?? $c.boxes[$t] == 0 !! True }
(move($c, $from, $_) if to_hostage($_) for ^n($c))
}
my $OPTIMIZATION_2 = False;
sub moves($c) {
sub lower_limit { $OPTIMIZATION_2 ?? 3 !! 2 }
(moves-from($c, $_) if $c.boxes[$_] >= lower_limit for ^n($c))
}
REPL 'moves(conf [2, 0])';
sub has-empty-box($c) { so any($c.boxes) == 0 }
REPL 'has-empty-box(conf [2, 2, 2, 0])';
REPL 'has-empty-box(conf [2, 2, 2, 1])';
sub is-solvable($c) { !has-empty-box($c) || so is-solvable any moves $c }
REPL 'is-solvable(conf [2, 0])';
REPL 'is-solvable(conf [3, 0])';
sub tree-search($c, $indent = 0) {
say "\x20" x 4 * $indent, $c;
for moves($c) {
tree-search($_, $indent + 1);
}
}
REPL 'tree-search(conf [4, 0, 0])';
sub add-pebble($c, $to) { conf $c.boxes.&but(*.[$to] += 1) }
sub add-pebble-anywhere($c) { (add-pebble($c, $_) for ^n($c)) }
REPL 'add-pebble-anywhere(conf [2, 0])';
sub is-answer($c) { !is-solvable($c) && so is-solvable all add-pebble-anywhere($c) }
REPL 'is-answer(conf [2, 0])';
REPL 'is-answer(conf [4, 0, 0])';
sub hostages($c) { +$c.boxes.grep(0) }
REPL 'hostages(conf [2, 0])';
REPL 'hostages(conf [3, 0, 0])';
sub heroes($c) { [+] ($c.boxes »-» 1) »div» 2 »max» 0 }
REPL 'heroes(conf [2, 0])';
REPL 'heroes(conf [3, 3, 0])';
$OPTIMIZATION_1 = True;
REPL 'tree-search(conf [4, 0, 0])';
$OPTIMIZATION_2 = True;
REPL 'tree-search(conf [4, 0, 0])';
sub one-more-hostage-than-heroes($c) { hostages($c) == heroes($c) + 1 }
REPL 'one-more-hostage-than-heroes(conf [2, 0])';
REPL 'one-more-hostage-than-heroes(conf [3, 1, 0])';
sub random-box { Bool.pick ?? 0 !! (1..5).pick }
sub random-conf {
my $n = (0..5).pick;
conf [random-box() xx $n];
}
sub quickcheck(&prop, $N = 1000) {
for ^$N {
print "." if $_ %% 20;
my $c = random-conf;
return "Counterexample: $c.gist()" unless &prop($c);
}
return "All $N cases passed.";
}
sub infix:«⇒»($premise, $conclusion) { !$premise || $conclusion }
sub if-answer-then-one-more-hostage($c) {
is-answer($c) ⇒ one-more-hostage-than-heroes($c);
}
REPL 'quickcheck &if-answer-then-one-more-hostage';
sub if-one-more-hostage-then-answer($c) {
one-more-hostage-than-heroes($c) ⇒ is-answer($c);
}
REPL 'quickcheck &if-one-more-hostage-then-answer';
sub all-hostages-or-everyday-heroes($c) { so $c.boxes.all %% 2 }
sub if-one-more-hostage-and-all-hostages-or-everyday-heroes-then-answer($c) {
(one-more-hostage-than-heroes($c)
&& all-hostages-or-everyday-heroes($c))
is-answer($c)
}
REPL 'quickcheck &if-one-more-hostage-and-all-hostages-or-everyday-heroes-then-answer';
sub one-more-hostage-and-all-hostages-or-everyday-heroes-means-answer($c) {
(one-more-hostage-than-heroes($c)
&& all-hostages-or-everyday-heroes($c))
== is-answer($c)
}
REPL 'quickcheck &one-more-hostage-and-all-hostages-or-everyday-heroes-means-answer';
sub pebbles-are-twice-boxes-minus-two-and-all-boxes-even-means-answer($c) {
([+]($c.boxes) == 2 * n($c) - 2 && so($c.boxes.all %% 2))
== is-answer($c)
}
REPL 'quickcheck &pebbles-are-twice-boxes-minus-two-and-all-boxes-even-means-answer';
sub partitions($n) {
uniq :as(*.Str), gather {
take [$n];
for 1..^$n -> $x {
take ([($x, .list).sort] for partitions($n - $x));
}
}
}
sub double(@list) { @list »*» 2 }
sub pad(@list, $size) { [@list, 0 xx ($size - @list.elems)] }
sub all-answers($n) { (.reverse.&double.&pad($n) for partitions($n - 1)) }
sub array-cmp(@xs, @ys) { [||] @xs Z<=> @ys }
for 1..* -> $n {
my @answers = all-answers($n).sort(&array-cmp);
say "{@answers.elems} answers of size $n:";
say " ", .&conf for @answers;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.