Clarion 6.1: Bin Packing Algorithm to find out best use of material 2005-02-02 -- Michael Ware Newsgroups: comp.lang.clarion
> I'm looking for an algorithm or another solution to solve my following
> problem:
>
> I've got a queue with requested lengths:
> ....
> And I've got a queue with what is in stock:
>....
> Is there a known algorithm that does something similar to achieve this or
> can somebody help me in the right direction.
Nice exercise! I love questions like this, it gives me a chance to exercise
an area of my brain that doesn't usually get a good work out.
I spent my lunch break today playing with some code. The attached compiles,
but I don't have time to run it test it or debug it. For all I know it will
just drop into an endless loop and you will have to reboot. It could
definitely use some tuning and clean up. But it should be good enough to
give you an idea of one approach.
Assumptions I made were as follows:
1. You start with two Q's one for the requests and one for the stock on
hand.
2. In both Q's the Length field is unique. i.e. you will NOT have two
request records for the same length.
3. If ANY combination results in Zero waist for a particular stock it
should be used.
4. The queue sizes are reasonable (~10 to 500 records).
#s 1 & 2 are required for the code to work. #3 is a question for a
mathematician I can't answer. #4 is required for the code to process in a
reasonable amount of time.
-Mike
(p.s. if you do use this, you can pay me back by e-mailing me the changes
and cleanup you do to get it working.)
FindCuts PROCEDURE ! Declare Procedure
WAIST LONG
StockQ QUEUE,PRE(SQ)
L LONG
C LONG
END
RequestQ QUEUE,PRE(RQ)
L LONG
C LONG
END
CutsQ QUEUE,PRE(CQ)
STOCKL LONG
L1 LONG
C1 LONG
L2 LONG
C2 LONG
L3 LONG
C3 LONG
Waist LONG
END
FOUNDL1 LONG
FOUNDL2 LONG
FOUNDL3 LONG
FOUNDC1 LONG
FOUNDC2 LONG
FOUNDC3 LONG
CODE
! Process all stock longest to shortest
FREE(CUTSQ)
SORT(STOCKQ,-SQ:L)
DO ResetStockQ ! Clears cutQ, & Positions to first stock
LOOP
WAIST = SQ:L ! Initialize Waist to this stock lenth
! Find the best combo for this stock
! lenght.
DO FirstLength
IF ~FOUNDL1
! Either Found a combo with longer stock
! or no stock left that can fill a request
! or no requests left to fill
IF CQ:L1
DO AddCut ! Found a combo with longer stock
CYCLE ! ADD IT AND START OVER.
ELSE
BREAK
END
END
IF WAIST < CQ:Waist ! if a less waistfull
CQ:StockL = SQ:L ! combination was
CQ:Waist = WAIST ! found, move the
CQ:L1 = FOUNDL1 ! current values into
CQ:L2 = FOUNDL2 ! the CutQ
CQ:L3 = FOUNDL3
CQ:C1 = FOUNDC1
CQ:C2 = FOUNDC2
CQ:C3 = FOUNDC3
END
GET(StockQ,POINTER(StockQ)+1) ! Get the next stock size
! If we are out of stock to try or
! the last stock size we used had
! no waist, add the cut and start over
IF ERRORCODE() OR WAIST = 0 !
DO AddCut
END
END ! try the next stock size
! Best fit cut was found,
! this adds it to the cut Queue
! and reduces the Stock and
! request Queue counts accordingly
AddCut ROUTINE
ADD(CUTSQ) ! Add cut
SQ:L = CQ:StockL
GET(StockQ,SQ:L)
SQ:C -= 1 ! Reduce Stock
PUT(StockQ)
RQ:L = CQ:L1
GET(RequestQ,RQ:L)
RQ:C -= CQ:C1 ! Reduce requests
PUT(RequestQ)
IF CQ:L2
RQ:L = CQ:L2
GET(RequestQ,RQ:L)
RQ:C -= CQ:C2 ! Reduce requests
PUT(RequestQ)
END
IF CQ:L3
RQ:L = CQ:L3
GET(RequestQ,RQ:L)
RQ:C -= CQ:L3 ! Reduce requests
PUT(RequestQ)
END
DO ResetStockQ ! Clear cut queue
ResetStockQ ROUTINE
CQ:STOCKL =0
CQ:L1 =0
CQ:C1 =0
CQ:L2 =0
CQ:C2 =0
CQ:L3 =0
CQ:C3 =0
CQ:Waist =0
GET(StockQ,1) ! Position to first Stock
CQ:Waist = SQ:L ! Set Maximum Waist
FirstLength ROUTINE
DATA
StartW LONG
BestW1 LONG
TestL LONG
TestC LONG
MaxCnt LONG
HoldL2 LONG
HoldC2 LONG
HoldL3 LONG
HoldC3 LONG
CODE
FOUNDL1 = 0
FOUNDC1 = 0
FOUNDL2 = 0
FOUNDC2 = 0
FOUNDL3 = 0
FOUNDC3 = 0
StartW = WAIST
SORT(RequestQ,-RQ:L) ! Sort by requested length desc.
GET(REQUESTQ,1)
LOOP
MaxCnt = CHOOSE( INT(StartW/RQ:L)>RQ:C,RQ:C,INT(StartW/RQ:L))
IF MaxCnt >= 1 ! Request fits in this stock
TestL = RQ:L
LOOP TestC = MaxCnt TO 1 BY -1
IF TestL*TestC > WAIST THEN CYCLE.
WAIST = WAIST - (TestL*TestC)
DO SECONDLENGTH
IF WAIST < BestW1
BestW1 = WAIST
FOUNDL1 = Testl
FOUNDC2 = TestC
HoldL2 = FOUNDL2
HoldC2 = FOUNDC2
HoldL3 = FOUNDL3
HoldC3 = FOUNDC3
END
END
END
GET(REQUESTQ,POINTER(REQUESTQ)+1)
IF ERRORCODE() THEN BREAK.
END
FOUNDL2 = HoldL2
FOUNDC2 = HoldC2
FOUNDL3 = HoldL3
FOUNDC3 = HoldC3
WAIST = BestW1
SECONDLENGTH ROUTINE
DATA
StartQ LONG
StartW LONG
BestW2 LONG
TestL LONG
TestC LONG
MaxCnt LONG
HoldL3 LONG
HoldC3 LONG
CODE
StartQ = POINTER(RequestQ)
StartW = WAIST
BestW2 = WAIST
FOUNDL2 = 0
FOUNDC2 = 0
FOUNDL3 = 0
FOUNDC3 = 0
LOOP
IF BestW2 = 0 THEN BREAK.
GET(REQUESTQ,POINTER(REQUESTQ)+1)
IF ERRORCODE() THEN BREAK.
MaxCnt = CHOOSE( INT(StartW/RQ:L)>RQ:C,RQ:C,INT(StartW/RQ:L))
IF MaxCnt<1 THEN CYCLE. ! Length exceeds waist
TestL = RQ:L
LOOP TestC = MaxCnt TO 1 BY -1
IF (TestL*TestC) > WAIST THEN CYCLE.
WAIST = StartW - (TestL*TestC)
DO ThirdLENGTH
IF WAIST < BestW2
FOUNDL2 = TestL
FOUNDC2 = TestC
HoldL3 = FoundL3
HoldC3 = FoundC3
BestW2 = WAIST
IF BestW2=0 THEN BREAK.
END
END
END
WAIST = BestW2
FoundL3 = HoldL3
FoundC3 = HoldC3
GET(RequestQ,StartQ)
ThirdLENGTH ROUTINE
DATA
StartQ LONG
StartW LONG
BestW3 LONG
TestL LONG
TestC LONG
MaxCnt LONG
CODE
StartQ = POINTER(RequestQ)
StartW = WAIST
BestW3 = WAIST
FoundL3 = 0
FoundC3 = 0
LOOP
IF BestW3 = 0 THEN BREAK.
GET(REQUESTQ,POINTER(REQUESTQ)+1)
IF ERRORCODE() THEN BREAK.
MaxCnt = CHOOSE( INT(StartW/RQ:L)>RQ:C,RQ:C,INT(StartW/RQ:L))
IF MaxCnt < 1 THEN CYCLE. ! Length exceeds waist
TestL = RQ:L
LOOP TestC = MaxCnt TO 1 BY -1
WAIST = StartW - (TestL*TestC)
IF WAIST < BestW3 AND WAIST > 0
FoundL3 = TestL
FoundC3 = TestC
BestW3 = WAIST
IF BestW3=0 THEN BREAK.
END
END
END
WAIST = BestW3
GET(RequestQ,StartQ)
Printed November 23, 2024, 10:14 pm This article has been viewed/printed 35333 times. Google search has resulted in 40 hits on this article since January 25, 2004. |