I have code that tries to eliminate iterations by climbing back up the tree if $waste=$bestwaste more than ten times in a row. I am afraid that I could miss out on a solution, but I did not know where else to turn. If anyone has any ideas or opinions, would you please let me know. Thanks ya'll.
use strict;
use warnings;
use Data::Dumper;
open ( OHA, ">c:/printoutKNAP1.txt" ) or die ("could not open file. &!
+" );
# $lite[0][0] = x value
# $lite[0][1] = y value
# $lite[0][2] = (used?) 0 = not used, 1 = used
# $lite[0][3] = x location in grid (lower left corner)
# $lite[0][4] = y location in grid (lower left corner)
# $lite[0][5] = (rotated?) 0 = not rotated, 1 = rotated
my @lite = (
# [qw/2 5 0 999 999 0/],
# [qw/4 3 0 999 999 0/],
# [qw/3 4 0 999 999 0/],
# [qw/1 4 0 999 999 0/],
# [qw/2 5 0 999 999 0/],
# [qw/4 3 0 999 999 0/],
# [qw/3 4 0 999 999 0/],
# [qw/1 4 0 999 999 0/],
# [qw/4 1 0 999 999 0/],
[qw/1 1 0 999 999 0/],
# [qw/1 1 0 999 999 0/],
# [qw/1 1 0 999 999 0/],
# [qw/1 1 0 999 999 0/],
[qw/1 1 0 999 999 0/]
);
my $waste = 0; # waste after rectangles are placed
my $end = 0; # if you reached last node, end = 1
my $bestwaste = 99999; # best waste so far, so init to a large #
my $beingused = 0; # number of the lite currently being used
my $maxX = 36; # the x value for the glass size
my $maxY = 35; # the y value for the glass size
my $count1 = 0; # keep count of iterations *not needed
my @final; # info for the optimal solution
my $countout = 0; # number of times waste=bestwaste
my $samething = 0; # number of iterations to backtrack
sub Knap {
# ****************************
# Initialization
my $count = $count1;
$count = $count + 1;
$count1 = $count1 + 1;
print "count $count\n";
my $bigx = $_[0]; # large rectangle x value
my $bigy = $_[1]; # large rectangle y value
my $locx = $_[2]; # lower left corner x value
my $locy = $_[3]; # lower left corner y value
my $start = 0;
my $notused = $_[4]; # current area not being used
my @list;
my @recursion;
my $listnum = 0;
# **********************************
# just used for my tracking
print OHA "-------------------------------\n";
print OHA "[$count]bigx [$bigx] bigy [$bigy] locx [$locx] locy [$loc
+y] start [$start] notused[$notused]\n";
# *********************************
# This section creates a list of possible rectangles
# that can fit into the larger rectangle.
#
for my $i ( 0..$#lite ) {
if ( $lite[$i][2] == 0 ) {
if ( ( $lite[$i][0] <= $bigx ) && ( $lite[$i][1] <= $bigy ) ) {
$list[$listnum][0] = $i;
$list[$listnum][1] = 0;
$list[$listnum][2] = 0;
$listnum = $listnum + 1;
} # if ($lite[$i][0]<=$bigx0 && ...
if ( ( $lite[$i][1] <= $bigx ) && ( $lite[$i][0] <= $bigy ) ) {
$list[$listnum][0] = $i;
$list[$listnum][1] = 0;
$list[$listnum][2] = 1;
$listnum = $listnum + 1;
} # if ($lite[$i][1]<=$bigx) && ...
} # if ($lite[$i][2]==0)
} # for my $i (0..$#lite)
# *****************************************
# for my $jj (0..$#list) {
# print OHA "[$count]list0 [$list[$jj][0]] list1 [$list[$jj][1]] li
+st2 [$list[$jj][2]]\n";
# } # for my $jj (0..$#list)
# **************************************
# This is where the loop begins. It inserts the first
# rectangle and then runs KNAP with the left over
# rectangles
for my $j ( 0..$#list ) {
print OHA "[$count]INSIDE ($j..$#list) \$ list\n";
if ( $list[$j][2] == 1 ) {
my $temp = $lite[$list[$j][0]][0];
$lite[$list[$j][0]][0] = $lite[$list[$j][0]][1];
$lite[$list[$j][0]][1] = $temp;
$lite[$list[$j][0]][5] = 1;
} # if ($list[$j][2]==1)
$lite[$list[$j][0]][2] = 1;
$lite[$list[$j][0]][3] = $locx;
$lite[$list[$j][0]][4] = $locy;
$beingused = $list[$j][0];
print OHA "[$count]BEINGUSED RIGHT NOW [$beingused] END [$end]\n";
# *********************************************************
# This figures the sizes of the new rectangles
my $newx = $bigx - $lite[$list[$j][0]][0];
my $newy = $bigy - $lite[$list[$j][0]][1];
# **********************************************************
# This section determins if we have reached an end node
# either there are no more rectangles left to fit, or
# there are no more rectangles that fit. If either of
# these are true, $end = 1 and another KNAP is not called
if ( ( $newx == 0 ) && ( $newy == 0 ) && ( $end == 0 ) ) {
$end = 1;
} # if ($newx==0) && ($newy==0) && ($end==0)
if ( ( $newx != 0 ) && ( $newy != 0 ) && ( $end == 0 ) ) {
$end = 1;
for my $kk ( 0..$#lite ) {
if ( $lite[$kk][2] == 0 ) {
if ( ( ( $lite[$kk][0] <= $bigx ) && ( $lite[$kk][1] <= $new
+y ) )
|| ( ( $lite[$kk][0] <= $newx ) && ( $lite[$kk][1] <= $lit
+e[$list[$j][0]][1] ) )
|| ( ( $lite[$kk][0] <= $lite[$list[$j][0]][0] ) && ( $lit
+e[$kk][1] <= $newy ) )
|| ( ( $lite[$kk][0] <= $newx ) && ( $lite[$kk][1] <= $big
+y ) )
|| ( ( $lite[$kk][1] <= $bigx ) && ( $lite[$kk][0] <= $new
+y ) )
|| ( ( $lite[$kk][1] <= $newx ) && ( $lite[$kk][0] <= $lit
+e[$list[$j][0]][1] ) )
|| ( ( $lite[$kk][1] <= $lite[$list[$j][0]][0] ) && ( $lit
+e[$kk][0] <= $newy ) )
|| ( ( $lite[$kk][1] <= $newx ) && ( $lite[$kk][0] <= $big
+y ) ) ) {
$end = 0;
} # if ($lite[$kk][0]<=$newx) && ...
} # if ($lite[$kk][2]==0)
} # for my $kk (0..$#lite)
} # if ($newx!=0) && ($newy!=0) && ($end==0)
if ( ( $newx == 0 ) && ( $newy != 0) && ( $end == 0 ) ) {
$end = 1;
for my $st ( 0..$#lite ) {
if ( $lite[$st][2] == 0 ) {
if ( ( ( $lite[$st][0] <= $lite[$list[$j][0]][0] ) && ( $lit
+e[$st][1] <= $newy ) ) || ( ( $lite[$st][1] <= $lite[$list[$j][0]][0]
+ ) && ( $lite[$st][0] <= $newy ) ) ) {
$end = 0;
} # if ($lite[$st][0]<=$lite[$list[$j][0]][0]) && ...
} # if ($lite[$st][2]==0)
} # for my $st (0..$#lite)
} # if ($newx==0) && ($end==0)
if ( ( $newx != 0 ) && ( $newy == 0 ) && ( $end == 0 ) ) {
$end = 1;
for my $su ( 0..$#lite ) {
if ( $lite[$su][2] == 0 ) {
if ( ( ( $lite[$su][0] <= $newx ) && ( $lite[$su][1] <= $lit
+e[$list[$j][0]][1] ) ) || ( ( $lite[$su][1] <= $newx ) && ( $lite[$su
+][0] <= $lite[$list[$j][0]][1] ) ) ) {
$end = 0;
} # if ($lite[$su][0]<=$newx) && ($lite[$su][1]...
} # if ($lite[$su][2]==0)
} # for my $su (0..$#list)
} # if ($newy==0) && ($end==0)
# ***************************************************************
# if $end = 1, then the waste is tabulated and sent back
print OHA "[$count] OOOOOOOOOOOOOOOOO end[$end]\n";
if ( $end == 1 ) {
$waste = ( $bigx*$bigy - $lite[$list[$j][0]][0]*$lite[$list[$j]
+[0]][1] ) + $notused;
# if ( $#list == 1 ) {
# print OHA "[$count]END OF NODE listlistlistlist = 2\n";
# $endrot = 2;
# }
# if ( $#list == 0 ) {
# if ($list[0][2] == 1) {
# print OHA "[$count]END OF NODE listlistlist = 1 & rot = 1\n
+";
# $endrot = 1;
# }
# if ($list[0][2] == 0) {
# print OHA "[$count]END OF NODE listlistlist = 1 & rot = 0\n
+";
# $endrot = 0;
# }
# }
&Waste( $waste, $bestwaste, $count, $beingused );
$end = 1;
} # if ($end==1)
# ***********************************************************
# This section invokes KNAP on the proper rectangle
# If ($newx != 0) and ($newy != 0) and ($end != 1)
# there are 2 options with two different rectangles each so
# there are 4 possible rectangles to try, and thus
# KNAP is called 4 different times
print OHA "[$count]99999999 newx[$newx] newy[$newy] end[$end]\n";
# ***************************************************************
# Special condition, if one of the new rectangles maxed out in the
# x-direction, the new rectangle would not have any value for x.
# Thus there is a special condition if $newx = 0. It only has one
# rectangle, so &Knap is only called once.
if ( ( $newx == 0 ) && ( $newy != 0 ) && ( $end != 1 ) ) {
print OHA "***{$count]******Inside newx == 0****newy[$newy]\n";
&Knap( $lite[$list[$j][0]][0], $newy, $locx, $locy + $lite[$list
+[$j][0]][1], $notused + $newx * $bigy );
print OHA "[$count]done with NEWX=0 NEWY!=0 third start [$start]
+ count [$count]\n";
print OHA "[$count]waste after NEWX=0 NewY!=0 [$waste] end [$end
+]\n";
$end = 0;
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
} # if ($newx==0) && ($newy!=0) && ($end!=1)
# ***************************************************************
# Special condition, if one of the new rectangles maxed out in the
# y-direction, the new rectangle would not have any value for x.
# Thus there is a special condition if $newy = 0. It only has one
# rectangle, so &Knap is only called once.
if ( ( $newx != 0 ) && ( $newy == 0 ) && ( $end != 1 ) ) {
print OHA "***[$count]******Inside newy == 0****************newx
+[$newx]\n";
&Knap( $newx, $lite[$list[$j][0]][1], $locx + $lite[$list[$j][0]
+][0], $locy, $notused + $bigx * $newy );
print OHA "[$count]done with NEWX!=0 NEWY=0 start [$start] count
+ [$count]\n";
print OHA "[$count]waste after NEWX!=0 NEWY=0 [$waste] end [$end
+]\n";
$end = 0;
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
} # if ($newx!=0) && ($newy==0) && ($end!=1)
# ***************************************************************
# This is the main loop, each time a rectangle is placed and the
# smaller rectangle does not max out the larger x or y values
# $bigx != $lite[$list[$j][0]][0] and bigy != $lite[$list[$j][0]][1]
# then this section is entered where there are two options with
# two rectangles each that must be checked, so &Knap is called four
# times
if ( ( $newx != 0 ) && ( $newy != 0 ) && ( $end != 1 ) ) {
print OHA "[$count]NOTUSED [$notused]\n";
&Knap( $bigx, $newy, $locx, $locy + $lite[$list[$j][0]][1], $not
+used + $newx * $lite[$list[$j][0]][1] );
print OHA "[$count]done with 1st start [$start] count [$count]\n
+";
print OHA "[$count]waste after 1 [$waste] end [$end]\n";
$end = 0;
for my $rt ( 0..$#list ) {
print OHA "[$count]**list0 $list[$rt][0] list1 [$list[$rt][1]]
+ list2 [$list[$rt][2]]\n";
} # for my $rt(0..$#list)
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
&Knap( $newx, $lite[$list[$j][0]][1], $locx + $lite[$list[$j][0]
+][0], $locy, $notused + $bigx * $newy );
print OHA "[$count]done with second start [$start] count [$count
+]\n";
print OHA "[$count]waste after 2 [$waste] end [$end]\n";
$end = 0;
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
&Knap( $lite[$list[$j][0]][0], $newy, $locx, $locy + $lite[$list
+[$j][0]][1], $notused + $newx * $bigy );
print OHA "[$count]done with third start [$start] count [$count]
+\n";
print OHA "[$count]waste after 3 [$waste] end [$end]\n";
$end = 0;
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
&Knap( $newx, $bigy, $locx + $lite[$list[$j][0]][0], $locy, $not
+used + $lite[$list[$j][0]][0] * $newy );
print OHA "[$count]done with fourth start [$start] count [$count
+]\n";
print OHA "[$count]waste after 4 [$waste] end [$end]\n";
$end = 0;
# *********************************************************
# if $waste=$bestwaste more than 10 times, we will skip
# a couple of iterations
if ( $samething != 0 ) {
$samething = $samething - 1;
print OHA "[$count]&&&&&&&&&&&&&&&&&&&&&SKIPPED\n";
goto OUTY;
} # if ($samething != 0)
} # if ($newx!=0) && ($newy!=0) && ($end!=1)
for my $tt (0..$#lite) {
print OHA "WHERE LITES ARE Lite[$tt] USED [$lite[$tt][2]] END**[
+$end]\n";
} # for my $tt (0..$#lite)
$lite[$list[$j][0]][2] = 0;
$lite[$list[$j][0]][3] = 999;
$lite[$list[$j][0]][4] = 999;
# for my $jj4 (0..$#final) {
# print OHA "0 [$final[$jj4][0]] 1 [$final[$jj4][1]] 2 [$final[$j
+j4][2]] 3 "
# "[$final[$jj4][3]] 4 [$final[$jj4][4]] 5 [$final[$jj4][5]]\n";
# }
} # for my $j (0..$#list)
OUTY: print OHA "[$count] samething[$samething]END OF LIST ---------
+--------------\n";
} # sub Knap
sub Waste {
my $wasteW = $_[0]; # total waste left for this solution
my $bestwasteW = $_[1]; # best waste so far
my $countW = $_[2]; # which iteration the loop is on, *not neede
+d
my $beingusedW = $_[3]; # which lite is currently being used
print OHA "[$countW]INSIDE WASTE ^waste[$wasteW]^^best[$bestwasteW]\
+n";
print OHA "[$countW]Inside waste countout[$countout] same[$samething
+]\n";
# *************************************************************
# Determines whether this solutions' waste is better than the
# best solutions' waste so far. If so, @final will get these
# values for location and which lites were used and if they
# were rotated
if ( $wasteW == $bestwaste ) {
$countout = $countout + 1;
} # if ($wasteW==$bestwasteW)
if ( $countout == 10 ) {
$samething = 2;
$countout = 0;
goto OUTY;
} # if ($countout==10)
if ( $wasteW < $bestwasteW ) {
$bestwaste = $wasteW;
$countout = 0;
@final = map [ @$_ ], @lite;
my $ratio = ( $maxX * $maxY - $bestwaste ) / ( $maxX * $maxY );
# *******************************************************
# if a percentage of glass used exceeds 93%, that's good
# enough, so keep what we have
print OHA " RATIO [$ratio]\n";
if ( $ratio > .93 ) {
# $endofall = 1;
print "RATIO > 93% \n";
goto OUT;
} # if ($ratio>.93)
for my $n ( 0..$#final ) {
print OHA "[$countW]bestx 4th $final[$n][3] besty $final[$n][4]
+** \n";
} # for my $n (0..$#final)
print OHA "[$countW]done with \n";
} # if ($wasteW<$bestwasteW)
$waste = 0;
print OHA "[$countW]beingused [$beingusedW]\n";
$lite[$beingusedW][2] = 0;
$end = 0;
for my $j11 (0..$#lite) {
print OHA "0 [$lite[$j11][0]] 1 [$lite[$j11][1]] 2 [$lite[$j11][2]
+] 3 [$lite[$j11][3]] ",
"4 [$lite[$j11][4]] 5 [$lite[$j11][5]]\n";
}
} # sub Waste
&Knap($maxX,$maxY,0,0,0);
OUT: for my $jj1 (0..$#final) {
print "0 [$final[$jj1][0]] 1 [$final[$jj1][1]] 2 [$final[$jj1][2]] 3
+ [$final[$jj1][3]] 4 [$final[$jj1][4]]\n";
}
for my $j2 ( 0..$#final ) {
if ( ( $final[$j2][3] != 999 ) && ( $final[$j2][4] != 999 ) ) {
$final[$j2][2] = 1;
}
}
print "\n\n";
for my $j1 (0..$#final) {
print "0 [$final[$j1][0]] 1 [$final[$j1][1]] 2 [$final[$j1][2]] 3 [$
+final[$j1][3]] 4 [$final[$j1][4]] 5 [$final[$j1][5]]\n";
}
print "\n\n";
for my $j3 (0..$#lite) {
print "0 [$lite[$j3][0]] 1 [$lite[$j3][1]] 2 [$lite[$j3][2]] 3 [$lit
+e[$j3][3]] 4 [$lite[$j3][4]] 5 [$lite[$j3][5]]\n";
}
