- This is the same algorithm that JavaFan described (brute force).
- It tracks water usage, if you want to optimize a solution that way, but that's commented out right now. I suspect that the shortest path solution is always the least water used solution.
- Call it with a series of numbers on the command line. The first is the target number, and all subsequent numbers are jug capacities.
- It can handle any number of jugs.
- I wrote a jug object with Moose, mostly for fun.
- Formatting courtesy of Perl::Tidy because Yours::Truly wrote some long lines.
- I waste CPU and memory as if I'm writing in Perl or something.
#!/usr/bin/perl
use strict;
use warnings;
package Jug;
use Moose;
use List::Util qw( min );
has water => ( is => 'ro', isa => 'Int', default => 0, );
has capacity => ( is => 'ro', isa => 'Int', required => 1, );
sub clone {
my $self = shift;
return __PACKAGE__->new( water => $self->water,
capacity => $self->capacity );
}
sub fill {
my $self = shift;
my $used = $self->capacity - $self->water;
$self->{water} = $self->capacity;
return $used;
}
sub empty { shift->{water} = 0 }
sub _add {
my ( $self, $water ) = @_;
my $space = $self->capacity - $self->water;
my $used = min $space, $water;
$self->{water} += $used;
return $used;
}
sub add_from {
my ( $self, $other_jug ) = @_;
die 'bad jug' unless $other_jug->isa(__PACKAGE__);
$other_jug->{water} -= $self->_add( $other_jug->water );
return 0;
}
__PACKAGE__->meta->make_immutable;
package main;
use List::Util qw( first );
$ARGV[0]++;
my @paths = (
[
{
desc => 'starting state',
jugs => [ map { Jug->new( capacity => $_ ) } @ARGV ],
used => 0,
}
]
);
$paths[0][0]{target} = shift @{ $paths[0][0]{jugs} };
$paths[0][0]{strstate} = string_state( $paths[0][0] );
my %seen_states = ( $paths[0][0]{strstate} => 1 );
sub solution {
return first {
$_->[-1]->{target}->water == $_->[-1]->{target}->capacity - 1;
}
@paths;
}
while ( !solution() ) {
# @paths = sort { $a->[-1]->{used} <=> $b->[-1]->{used} } @paths;
my $p = shift @paths;
my $last_state = $p->[-1];
foreach my $next_state ( grep { !$seen_states{ $_->{strstate} }++
+}
next_states($last_state) ) {
push @paths, [ @{$p}, $next_state ];
}
}
my @solution = @{ solution() };
my $step = 0;
foreach my $state (@solution) {
my $strstate = $state->{strstate};
$strstate =~ s{\A(\d+)/\d+}{$1/T};
printf "%03d. [ %s ] %s\n", $step++, $strstate, $state->{desc};
}
printf "USED %d units in %d steps\n", $solution[-1]->{used}, $#solutio
+n;
exit;
sub string_state {
my $state = shift;
return join q{ }, map { $_->water . '/' . $_->capacity } $state->{
+target},
@{ $state->{jugs} };
}
sub new_state {
my ( $state, $desc ) = @_;
return {
jugs => [ map { $_->clone } @{ $state->{jugs} } ],
target => $state->{target}->clone,
used => $state->{used},
desc => $desc
};
}
sub next_states {
my $state = shift;
my @out;
foreach my $jug_index ( 0 .. $#{ $state->{jugs} } ) {
my $jug = $state->{jugs}->[$jug_index];
if ( $jug->water < $jug->capacity ) {
my $next = new_state( $state, "fill jug $jug_index" );
$next->{used} += $next->{jugs}->[$jug_index]->fill();
push @out, $next;
}
if ( $jug->water > 0 ) {
my $next;
foreach my $other_index ( 0 .. $#{ $state->{jugs} } ) {
next if $other_index == $jug_index;
$next = new_state( $state,
"pour jug $jug_index into jug $other_index" );
my $other = $next->{jugs}->[$other_index];
$other->add_from( $next->{jugs}->[$jug_index] );
push @out, $next;
}
$next = new_state( $state, "pour jug $jug_index into targe
+t" );
$next->{target}->add_from( $next->{jugs}->[$jug_index] );
push @out, $next;
$next = new_state( $state, "empty jug $jug_index" );
$next->{jugs}->[$jug_index]->empty();
push @out, $next;
}
}
$_->{strstate} = string_state($_) for @out;
return @out;
}
Update: After some work last night refactoring this into more objects and other fun stuff, it now can really find least water solutions, but it takes a really long time to do it.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
package Jug;
use Moose;
use List::Util qw( min );
has water => ( is => 'ro', isa => 'Int', default => 0, );
has capacity => ( is => 'ro', isa => 'Int', required => 1, );
sub clone {
my $self = shift;
return __PACKAGE__->new( water => $self->water,
capacity => $self->capacity );
}
sub fill {
my $self = shift;
die 'no way to fill infinite jug' if !$self->capacity;
my $used = $self->capacity - $self->water;
$self->{water} = $self->capacity;
return $used;
}
sub empty { shift->{water} = 0 }
sub _add {
my ( $self, $water ) = @_;
my $space = $self->capacity ? ( $self->capacity - $self->water ) :
+ $water;
my $used = min $space, $water;
$self->{water} += $used;
return $used;
}
sub add_from {
my ( $self, $other_jug ) = @_;
die 'bad jug' unless $other_jug->isa(__PACKAGE__);
$other_jug->{water} -= $self->_add( $other_jug->water );
return 0;
}
__PACKAGE__->meta->make_immutable;
package State;
use Moose;
has desc => ( is => 'ro', isa => 'Str', required => 1 )
+;
has jugs => ( is => 'ro', isa => 'ArrayRef[Object]', required => 1 )
+;
has target => ( is => 'ro', isa => 'Object', required => 1 )
+;
has used => ( is => 'ro', isa => 'Int', default => 0 )
+;
sub clone {
my $self = shift;
return $self->make_next( $self->desc );
}
sub make_next {
my ( $self, $desc ) = @_;
return __PACKAGE__->new(
target => $self->target->clone,
used => $self->used,
jugs => [ map { $_->clone } @{ $self->jugs } ],
desc => $desc
);
}
sub string {
my $self = shift;
return join q{ }, $self->target->water . '/T',
map { $_->water . '/' . $_->capacity } @{ $self->jugs };
}
sub next_states {
my $self = shift;
my @out;
foreach my $jug_index ( 0 .. $#{ $self->jugs } ) {
my $jug = $self->jugs->[$jug_index];
my $next;
if ( $jug->water < $jug->capacity ) {
$next = $self->make_next("fill jug $jug_index");
$next->{used} += $next->jugs->[$jug_index]->fill();
push @out, $next;
$next = $self->make_next("pour target into jug $jug_index"
+);
$next->jugs->[$jug_index]->add_from( $next->target );
push @out, $next;
}
if ( $jug->water > 0 ) {
foreach my $other_index ( 0 .. $#{ $self->{jugs} } ) {
next if $other_index == $jug_index;
$next = $self->make_next(
"pour jug $jug_index into jug $other_index");
my $other = $next->jugs->[$other_index];
$other->add_from( $next->jugs->[$jug_index] );
push @out, $next;
}
$next = $self->make_next("pour jug $jug_index into target"
+);
$next->{target}->add_from( $next->jugs->[$jug_index] );
push @out, $next;
# $next = $self->make_next( "empty jug $jug_ind
+ex" );
# $next->jugs->[$jug_index]->empty();
# push @out, $next;
}
}
return @out;
}
__PACKAGE__->meta->make_immutable;
package Path;
use Moose;
has states => ( is => 'ro', isa => 'ArrayRef[Object]', required => 1 )
+;
sub last_state { shift->states->[-1] }
sub used { shift->last_state->used() }
sub steps { scalar @{ shift->states } }
sub states_cloned {
map { $_->clone } @{ shift->states };
}
sub string {
join q{ }, map { $_->string } @{ shift->states };
}
sub has_loop {
my $self = shift;
my %seen;
foreach my $state ( @{ $self->states } ) {
return 1 if $seen{ $state->string }++;
}
return 0;
}
sub extend {
my $self = shift;
return grep { !$_->has_loop() }
map { __PACKAGE__->new( states => [ $self->states_cloned, $_ ]
+ ) }
$self->last_state->next_states();
}
__PACKAGE__->meta->make_immutable;
package main;
use List::Util qw( first );
my $least_water = 1;
my $target_water = shift @ARGV;
my %seen_paths;
my @paths;
{
my $target_jug = Jug->new( capacity => 0 );
my $start = State->new(
desc => 'starting state',
jugs => [ map { Jug->new( capacity => $_ ) } @ARGV ],
target => $target_jug
);
@paths = ( Path->new( states => [$start] ) );
}
sub solution {
# This sometimes causes a run time "Can't call last_state on undefine
+d value"
# but the equivalent code doesn't. What's up with that?
# return first { $_->last_state->target->water == $target_water }
+@paths;
foreach my $path (@paths) {
return $path if $path->last_state->target->water == $target_wa
+ter;
}
return 0;
}
while ( !solution() ) {
if (0) {
printf "paths: %d, steps %d\n", scalar @paths, $paths[0]->step
+s;
my @h;
$h[ $_->steps ]++ for @paths;
foreach my $n ( 0 .. $#h ) {
# printf "%d: %d\n", $n, $h[$n]||0;
}
}
@paths = sort { $a->used <=> $b->used || $a->steps <=> $b->steps }
+ @paths
if $least_water;
my $extend_from = shift @paths;
push @paths, grep { !$seen_paths{ $_->string }++ } $extend_from->e
+xtend();
}
my $solution_path = solution();
my $step = 0;
foreach my $state ( @{ $solution_path->states } ) {
printf "%03d. [ %s ] %s\n", $step++, $state->string, $state->desc;
}
printf "USED %d units in %d steps\n",
$solution_path->used, $solution_path->steps - 1;
exit;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|
|