in reply to Re^3: Algorithm to reduce the weight of a collection of bags

in thread Algorithm to reduce the weight of a collection of bags

This is the truncation (or weight-reduction) algorithm as it now stands.

Note that, having brought the four highest weights down to 16 but still needing to trim one more character, it took it from the bag that was originally the lightest of the four (#0), thus never violating the original ranking.#!/usr/bin/env perl use v5.36; # implies warnings no warnings q/experimental::for_list/; no warnings q/experimental::builtin/; use builtin qw/indexed/; use List::Util qw/sum/; my $target_weight = shift // die 'need target_weight'; my @weights = ( 20, 3, 25, 10, 3, 24, 25 ); say "Before:\n" . display( \@weights, $target_weight ); shrink( \@weights, $target_weight ); say "After:\n" . display( \@weights, $target_weight ); die if sum(@weights) != $target_weight; sub shrink ( $bags, $target_weight ) { my $curr_weight = sum @$bags; return if ( $curr_weight <= $target_weight ); # no shrink req'd my @refs = sort { ${$b} <=> ${$a} } map \$_, @$bags; BAG: for my ($i, $ref) ( indexed @refs ) { my $next_wt = $i < $#refs ? ${$refs[$i+1]} : 0; my $drop = $$ref - $next_wt; my $lowered_weight = $curr_weight - $drop * ( $i + 1 ); if ( $lowered_weight >= $target_weight ) { for ( 0 .. $i ) { ${$refs[ $_ ]} -= $drop; } $curr_weight = $lowered_weight; } else { use integer; my $target_loss = $curr_weight - $target_weight; my $div = $target_loss / ( 1 + $i ); my $rem = $target_loss % ( 1 + $i ); for ( reverse 0 .. $i ) { ${$refs[ $_ ]} -= $div + ( $rem-- > 0 ? 1 : 0 ); } last BAG; } } } sub display ($aref, $target) { my $r = ''; for my ( $i, $wt ) ( indexed @$aref ) { $r .= sprintf " %2s: {%s} (%d)\n", "#$i", ( '=' x $wt ), $wt; } $r .= sprintf "Weight %d, target=%d\n", sum(@$aref), $target; return $r; }

Plugging this into my simple-minded CSV columnizer gave me exactly what I wanted. It remains to be seen if I'll ever want to apply more sophisticated, data-aware methods of narrowing. :-)$ shrink 79 Before: #0: {====================} (20) #1: {===} (3) #2: {=========================} (25) #3: {==========} (10) #4: {===} (3) #5: {========================} (24) #6: {=========================} (25) Weight 110, target=79 After: #0: {===============} (15) #1: {===} (3) #2: {================} (16) #3: {==========} (10) #4: {===} (3) #5: {================} (16) #6: {================} (16) Weight 79, target=79

In Section
Seekers of Perl Wisdom

Comment onRe^4: Algorithm to reduce the weight of a collection of bagsSelectorDownloadCode