Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Challenge: N Jugs Problem

by kyle (Abbot)
on Apr 14, 2009 at 21:05 UTC ( #757492=note: print w/ replies, xml ) Need Help??


in reply to Challenge: N Jugs Problem

  • 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;


Comment on Re: Challenge: N Jugs Problem
Select or Download Code
Re^2: Challenge: N Jugs Problem
by JavaFan (Canon) on Apr 14, 2009 at 21:48 UTC
    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.
    I think you are wrong. I wrote my own solution (which I won't post, as several have now been posted) and found that for jugs with sizes 3 and 7, and target 11, there's a solution that requires 5 moves (fill Y, pour Y in X, pour Y in Z, fill Y, pour Y in Z), but that uses 14 water. There's a solution that requires just 11 water, but that requires 6 moves (fill Y, pour Y in X, pour Y in Z, pour X in Y, fill Y, pour Y in Z).

    Of course, my program may be wrong, and I might have missed a 5 move solution that uses just 11 water.

        That's 5 steps (fill Y, pour Y in Z are two separate steps), and in total 14 water is used (filling Y twice). Essentially, it's doing the same as the solution I provided: fill Y twice to collect 14, subtract the content of X making 11.

        How many steps do you see?

        According to the OP's definition, there are 6 steps in your program.

        • S → Y (fill Y from supply)
        • Y → Z (pour Y into Z)
        • S → Y (fill Y from supply)
        • Y → Z (pour Y into Z)
        • Z → X (fill X from Z)
        • X → S (pour X into supply)

        The last step is useless, though.

        And how much water is consumed?

        Consumed is ambiguous. The OP asked to minimize how much water is needed. Your program requires 14 units of water (2*Y).

      My solution agrees with your findings:

      $ perl min_steps.pl 3 7 11 5 steps: S->Y Y->Z Z->X S->Y Y->Z $ perl min_supply.pl 3 7 11 Required supply: 11 6 steps: S->Y Y->Z Z->X X->S S->Y Y->Z

      I wrote my own solution (which I won't post, as several have now been posted) ...

      I'd be interested to see that.

      I did some more work on mine, and I got to where I thought it should find a minimum water solution, but it ran overnight without finishing.

        I initially had an infinite loop as well. It turned out that my program was investigating the following path:

        • X → S (pour X into supply)
        • S → X (fill X from supply)
        • X → S (pour X into supply)
        • S → X (fill X from supply)
        • X → S (pour X into supply)
        • S → X (fill X from supply)
        • ...

        The necessary step to proceed would have increased the necessary supply, but the program was busy investigating options that didn't increase the necessary supply. I ended up using a "seen" hash to avoid states I had already explored.

        Even using a brute force approach, the program should find the solution instantly (at least for the values previously discussed in this thread) unless there is no answer. My program checks for that condition as follows:

        $target % Math::Numbers->new($sz_X, $sz_Y)->gcd() == 0 or die("No solution\n");
        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__

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://757492]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (12)
As of 2014-09-22 19:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (198 votes), past polls