good chemistry is complicated,and a little bit messy -LW PerlMonks

### Re: Puzzle: need a more general algorithm

by fglock (Vicar)
 on Jul 09, 2002 at 12:10 UTC ( #180456=note: print w/replies, xml ) Need Help??

in reply to Puzzle: need a more general algorithm

I think this code is usable:

```use strict;

my @height     = qw/ 10 15 25 30 10 13 /;
my \$columns = 3;

my @Best = ();
my \$Min_height = 1E9;
&check_columns ( [ 0 .. \$#height ] );

print "best result: \n";
# print join(" ", map { join('#', @\$_) } @Best), "\n";
foreach my \$y (0..\$Table_height) {
foreach my \$x (0..\$columns) {
my \$data = \${\$Best[\$x]}[\$y];
print defined \$data ? \$data : " ";
print "   ";
}
print "\n";
}

# check column height combinations
sub check_columns {
my \$pcat = shift;
foreach my \$p (0 .. \$#{@\$pcat} - 1) {
my @result = ( [ @\$pcat[0 .. \$p] ], [ @\$pcat[\$p + 1 .. \$#{@\$pc
+at}] ], @_);
if (\$#result == \$columns) {

# @result is an array of arrays
# print join(" ", map { join('#', @\$_) } @result), "\n";

my \$max_height = 0;
foreach my \$j (@result) {
my \$height = 0;
# foreach my \$i (@\$j) { print "\$i:\$height[\$i] "; }; pr
+int "\n";
foreach my \$i (@\$j) { \$height += \$height[\$i] };
\$max_height = \$height if \$height > \$max_height;
}
# print "max_height: \$max_height\n";

if (\$max_height < \$Min_height) {
\$Min_height = \$max_height;
@Best = @result;
}

}
else {
check_columns(@result);
}
}
}

It prints:

```best result:
0   2   3   4
1           5

You can un-comment the print lines to check how it works.

@Best is an array-of-arrays.

Update: show table.

Replies are listed 'Best First'.
Re: Re: Puzzle: need a more general algorithm
by fglock (Vicar) on Jul 09, 2002 at 13:47 UTC

By the way, \$columns = 2 gives:

```best result:
0   3   4
1       5
2

\$columns = 4 gives:

```best result:
0   1   2   3   4
5

Create A New User
Node Status?
node history
Node Type: note [id://180456]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2018-04-21 00:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (81 votes). Check out past polls.

Notices?