;; Example Problems ;
;; From: ;
;; Genetic algorithms for cutting stock problems: with and without contiguity ;
;; by Hinterding R, Khan L. ;
;; ;
;; http://vuir.vu.edu.au/25789/1/TECHNICALREPORT40_compressed.pdf ;
;; ;
'(("Problem 1a. Stock length 14 (20 items) \n"
(3 4 5 6 7 8 9 10)
(5 2 1 2 4 2 1 3)
14)
("Problem 2a (50 items) \n"
(3 4 5 6 7 8 9 10)
(4 8 5 7 8 5 5 8)
15)
("Problem 3a. Stock length 25 (60 items) \n"
(3 4 5 6 7 8 9 10)
(6 12 6 5 15 6 4 6)
25)
("Problem 4a. Stock length 25 (60 items) \n"
(5 6 7 8 9 10 11 12)
(7 12 15 7 4 6 8 1)
25)
("Problem 5a. Stock length 4300 (126 items) \n"
(2350 2250 2200 2100 2050 2000 1950 1900 1850 1700 1650 1350 1300 1250 1200 1150 1100 1050)
(2 4 4 15 6 11 6 15 13 5 2 9 3 6 10 4 8 3)
4300))
prob6a
'(("Problem 6a. Stock length 86 (200 items) \n"
(21 23 24 25 26 27 28 29 31 33 34 35 37 38 41 42 44 47)
(10 14 10 7 14 4 13 9 5 10 13 10 11 15 12 15 15 13)
86))
prob7a
'(("Problem 7a. Stock length 120 (200 items) \n"
(22 26 27 28 29 30 31 32 34 36 37 38 39 46 47 48 52 53 54 56 58 60 63 64)
(6 3 14 12 9 15 11 10 11 13 4 3 6 14 7 3 14 9 7 3 5 14 4 3)
120))
prob8a
'(("Problem 8a. Stock length 120 (400 items) \n"
(22 23 24 26 27 28 29 30 31 36 39 41 42 48 49 50 51 54 55 56 59 60 66 67)
(12 8 27 15 25 7 10 22 5 16 19 21 26 16 12 26 20 25 9 17 22 14 17 9)
120))
prob9a
'(("Problem 9a. Stock length 120 (400 items) \n"
(21 22 24 25 27 29 30 31 32 33 34 35 38 39 42 44 45 46 47 48 49 50 51 52 53 54 55 56 57 59 60 61 63 65 66 67)
(13 15 7 5 9 9 3 15 18 17 4 17 20 9 4 19 9 12 15 3 20 14 15 6 4 7 5 19 19 6 3 7 20 5 10 17)
120))
prob10a
'(("Problem 10a. Stock length 120 (600 items) \n"
(21 22 23 24 25 27 28 29 30 31 33 35 36 39 40 41 42 43 44 45 46 47 48 50 51 54 56 57 58 61 62 63 64 65 66 67)
(13 19 24 20 23 24 15 5 24 16 12 24 16 4 20 24 6 14 21 20 24 2 11 26 23 25 8 16 10 14 6 19 18 11 27 16)
120))
)
;; EP-Cut by ymg ;
;; ;
;; A New Evolutionary Approach to Cutting Stock Problems ;
;; With and Without Contiguity ;
;; By: Ko-Hsin Liang, Xin Yao, Charles Newton, David Hoffman ;
;; https://www.cs.bham.ac.uk/~xin/papers/COR_LiangYaoNewtonHoffman.pdf ;
;; ;
;; Contiguity is not implemented yet in the following ;
;; ;
(defun c:EP
-Cut
(/ a b bc c cost d gmul graf i k l ls mn mu mx n n3ps ngen opp
popu popuc prob probc s st stid stidc stoc sz ti tit tsiz vexg w win)
; Notes that variables bsol, bcost, bstoc, sol, costc and stocc ;
; are not declared so that we can inspect other solutions. ;
; Sample problems also will need to bet to nil manually ;
(setq mu
75 ; Size of Population ; tsiz 10 ; Tournament Size (Number of Opponents) ;
gmul 20 ; Multiplier for Nunber of Generation to Run ;
n3ps 2 ; Number of 3PS Repetitions to Creates Offspring ;
)
)
(setq popu
(list (longlst l d
)); Adding Ordered List eq. to FFD-binpack ; n
(length (car popu
)) ; Nomber of Items to Cut ; ngen (* gmul n) ; Number of Generations to Run ;
vexg (/ ngen 1.6) ; Vertical Exageration for Graph ;
)
)
; popu, Population ;
; stoc, Population Decoded by First Fit Binpack ;
; stid, Indices to popu to End of a Cut Stock ;
; cost, Relative Cost of Each Individual ;
; prob, Probability of Selecting a Given Stock for Mutations ;
k 0
)
bstoc stoc
bcost cost
)
; Each Idividual in Population is Mutated by 3 Point Swap (3PS) ;
s
(roulette
(nth i prob
)) b (randrng mn mx)
s
(roulette
(nth i prob
)) c (randrng mn mx)
ind (swapnth a b ind)
ind (swapnth a c ind)
)
)
)
)
)
; Conduct Comparisons Over the Union of Parents and Offspring ;
; Tournament Size is Defined at Beginning of Proram ;
)
)
)
; Choose the Solution With Most Win for New Generation ;
(setq popu
nil stoc
nil stid
nil cost
nil prob
nil) )
)
)
)
(setq bc b bstoc stocc bcost costc
) )
)
)
; Order of the last 150 solutions in stocc ;
; Here I am sorting all bins of the best solutions and outputting ;
(printres
(strcat "EP-Cut - " tit
) l d ls
(distinct# bsol
))
; Output the graph of Generations vs Cost for Debugging and Finding Best ;
; way to stop the algorithm. ;
) ; Go to Next Problem ;
)
;; longlst ;
;; Expand a list of length and quantity to a ;
;; Sorted long list with repeating items ;
;; ;
(defun longlst
(l d
/ i j ll
) )
)
;; FF-binpack by ymg ;
;; First Fit ;
;; Arguments: l List of items to put in bins ;
;; c Capacity of a bin ;
;; ;
(defun FF
-binpack
(l c
/ i b tb
) w (- w i)
)
)
)
)
;; Random number generator, #s(eed) remains Global. ;
)
;; Random in range i j (Integer Range) ;
(defun randrng
(i j
) (+ i
(fix (* (rand
) (- j i
-1)))))
;; roulette by ymg ;
;; ;
;; Roulette-Wheel Selection Via Stochastic Acceptance ;
;; by Adam Lipowski and Dorota Lipowska ;
;; http://arxiv.org/pdf/1109.3627v2.pdf ;
;; ;
;; Argument: l List of Probabilities. (No need to normalize) ;
;; Returns : Index in List of Chosen Item According to Probabilities. ;
;; ;
(defun roulette
(l
/ k m n
) k
)
;; For Debugging Check Frquency of Returns of Roulette's Function ;
(defun checkroulette
(/ l p r c0 c1 c2 c3 c4
) (setq l '
((0.4 0.0 0.3 1.2 0.1) ; Raw Probabilities ; (0.2 0 0.15 0.6 0.05)) ; Same Probailities Normalized to 1 ;
r nil
)
(setq c0
0 c1
0 c2
0 c3
0 c4
0) )
)
; Should return close to (2000 0 1500 6000 500) ;
)
)
;; relcost by ymg ;
;; ;
;; Calculates Relative Cost of Solution ;
;; From: Genetic Algorithms for Cutting Stock Problems: ;
;; With and Without Contiguity. ;
;; By Robert Hinterding & Lutfar Khan ;
;; http://vuir.vu.edu.au/25789/1/TECHNICALREPORT40_compressed.pdf ;
;; ;
;; ls is defined in main program ;
)
)
l
)
)
)
)
;; swapnth by ymg ;
;; ;
;; Given Two Indices, n1 and n2 and a List l. ;
;; Returns the List with the Item Position Swapped ;
;; ;
(defun swapnth
(n1 n2 l
/ a d tmp
) )
)
; shuffle (Original idea by highflyingbird) ;
; Simplified the code ymg ;
(defun shuffle
(l
/ a d i n tmp
) i -1
)
n
(+ i
(fix (* (rand
) (- d i
)))) )
)
)
; This one by Irneb, list based. Actually quite fast, and even faster once ;
; we replace repetitive call to function length by variable i ;
; in the vl-sort-i lambda clauses. ;
(defun shuffle2
(l
/ p i
)
;; mk_lwp by Alan J Thompson ;
;; Argument: pl, A list of points (2d or 3d) ;
;; Create an LWPolyline at Elevation 0, on Current Layer. ;
;; Return: Polyline Object ;
;; ;
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(70 . 0)
)
)
)
)
)
;; distinct# by ymg (Derived from Distinct by Gile Chanteau ;
;; Returns a list of distinct Item and Quantity ((item qty)......) ;
;; Argument ;
;; l List ;
;; ;
;(defun distinct# (l)
; (if l
; (cons (cons (car l) (- (length l) (length (setq l (vl-remove (car l) l))))) (distinct# l))
; )
;)
; Modified to return ((qty (pattern) waste) (...) (...))
)
)
;; printres ;
;; ;
;; Crude Patterns and Statistic Output to the Text Screen. ;
;; ;
(defun printres
(tit l d ls p
/ a su w
) )
(princ (strcat "\nPercent Efficiency : " (rtos (* 100 ( / (- (* su
(float ls
)) w
) (* su ls
))) 2 4) " %")) )
