in reply to Re^3: Challenge: N Jugs Problem
in thread Challenge: N Jugs Problem
I'd be interested to see that.
#!/usr/bin/perl use 5.010; use strict; use warnings; my $MINIMIZE_WATER = 1; my $X = 0; my $Y = 1; my $Z = 2; my $Water = 3; my $Move = 4; my $Previous = 5; my $MoveCount = 6; my @trans = ('S -> X', 'S -> Y', 'X -> Y', 'X -> Z', 'Y -> X', 'Y -> Z +', 'Z -> X', 'Z -> Y', 'X -> S', 'Y -> S'); my ($Target, @LIMITS) = @ARGV; $LIMITS[$Z] //= ~0; package State; sub new { my $class = shift; bless [@_], $class; } sub pour { my $self = shift; my ($from, $to) = @_; if ($self->[$from] + $self->[$to] <= $LIMITS[$to]) { $self->[$to] += $self->[$from]; $self->[$from] = 0; } else { $self->[$from] -= $LIMITS[$to] - $self->[$to]; $self->[$to] = $LIMITS[$to] } } sub fill { my $self = shift; my $to = shift; $self->[$Water] += $LIMITS[$to] - $self->[$to]; $self->[$to] = $LIMITS[$to]; } sub empty { my $self = shift; my $from = shift; $self->[$from] = 0; } sub trans { my $self = shift; my $trans = shift; my $New = State->new (@$self); $New->[$Move] = $trans; $New->[$Previous] = $self; $New->[$MoveCount] = $self->[$MoveCount] + 1; given ($trans) { when ('S -> X') {$New->fill($X)} when ('S -> Y') {$New->fill($Y)} when ('X -> Y') {$New->pour($X, $Y)} when ('X -> Z') {$New->pour($X, $Z)} when ('Y -> X') {$New->pour($Y, $X)} when ('Y -> Z') {$New->pour($Y, $Z)} when ('Z -> X') {$New->pour($Z, $X)} when ('Z -> Y') {$New->pour($Z, $Y)} when ('X -> S') {$New->empty($X)} when ('Y -> S') {$New->empty($Y)} default {die $trans} } $New; } sub id { my $self = shift; join ",", @$self[$X,$Y,$Z] } sub print { my $self = shift; return unless $self->[$Move]; $self->[$Previous]->print; printf "%2d. %s (X = %2d, Y = %2d, Z = %2d; Water = %2d)\n", @$self[$MoveCount, $Move, $X, $Y, $Z, $Water]; } package main; foreach my $MINIMIZE_WATER (0, 1) { my @QUEUE; my %SEEN; my $start = State->new(0, 0, 0, 0, undef, undef, 0); $SEEN{$start->id}++; push @QUEUE, $start; LOOP: while (1) { my $state = shift @QUEUE; foreach my $trans (@trans) { my $new = $state->trans($trans); next if $SEEN{$new->id}++; if ($new->[$Z] == $Target) { $new->print; last LOOP; } push @QUEUE, $new; if ($MINIMIZE_WATER) { @QUEUE = sort {$a->[$Water] <=> $b->[$Water] || $a->[$MoveCount] <=> $b->[$MoveCount]} +@QUEUE; } } } say "----"; } __END__
|
|---|