;-------------------------------------------------------------------- ; RSC-REPOSITORY GET/97 ;-------------------------------------------------------------------- ; Copyright@1996 by F. Luis Neves ; ; Author(s): FLN (F. Luis Neves) ; Revisions: 24.Mar.96 Rev: 8 May, 1996 ; Rev: 5 Dec, 1996 ; Rev: 10 Dec, 1996 (variable size c.) ; Rev: 2 Apr, 1997 (partial populations) ; Rev: 3 Jan, 1998 (final revisions) ; Rev: 8 Jan, 1998 (RPrb and CPrb added) ; Rev: 9 Jan, 1998 (2p-crossover added) ; Rev: 10 Jan, 1998 (best survives added) ; Rev: 10 Jan, 1998 (unif-crossover added) ; Rev: 21 Jan, 1998 (decimal-list genes) ; ;-------------------------------------------------------------------- ; ; Comments: GEnetic algorithms Tool ; ; (a) Filiation: GET < FDEP ; (b) Interface: ; ----------- ; | | ; | | ; INIT ---> | | EMPTY:Bool ---> ; | | ; INS(A,B) ---> | GET | ; | | ; <--- SEL(A,I):B | | <--- REM(A) ; | | ; | | ; ----------- ; ; (c) State: S = A -> B ; (d) Model: ; ;-------------------------------------------------------------------- ; Note: If I = {1,2,...} then B = B1:... B2:... B_:...; #include int.cam TYPE ; PV = CS (Chromsize) x ; PS (Population Size) x ; SS (Segment Size) x (for binary representation only) ; PC (Probability-Crossover) x ; PU (Probability-UCrossover) x ; PM (Probability-Mutation) x ; VC (Variable Size Chrom.) x ; CT (Crossover type) x ; BS (Best survives) x ; GR (Gene Representation) x GR = 0 (binary), ; GR = 1 (decimal) ; GR = 2 (decimal-list) ; MV (Maximum Gene Value) for decimal representation only ; PP = ID (Individual) -> C (Chromossome) x F (Fitness) x S (Chrom.Size) ; x RP (Relative Probability) ; x CP (Cumulative Probability) G = I -> R; I = INT; R = B1:Gene-list B2:Fit B3:CSize B4:RProb B5:CProb; P = CS:CSize PS:PSize SS:SSize PC:PCVal PU:PUVal PM:PMVal VC:VSize CT:CType BS:BSurv GR:GRepr MV:MGVal; Fit = INT; Gene = INT | INT-list; RProb = INT; CProb = INT; CSize = INT; PSize = INT; SSize = INT; PCVal = INT; PUVal = INT; PMVal = INT; VSize = BOOL; CType = INT; BSurv = BOOL; GRepr = INT; MGVal = INT; ENDTYPE ;-------------------------------------------------------------------- ; Note: If I = {1,2,...} then SEL(a,1) = B1(S[a]); SEL(a,2) = B2(S[a]); ... FUNC gpINIT():Void STATE G <- []; FUNC gpINS(a:I,b:R):Void PRE a notin dom(G) STATE G <- G + [a->b]; FUNC gpREM(a:I):Void STATE G <- G \ {a}; FUNC gpSEL(a:I,i:INT):R PRE a in dom(G) RETURN if (i == 1 -> p1(G[a]), i == 2 -> p2(G[a]), i == 3 -> p3(G[a]), i == 4 -> p4(G[a]), i == 5 -> p5(G[a])); FUNC gpEMPTY(): Bool RETURN G == []; ;-------------------------------------------------------------------- ; Genetic Programming auxiliary functions FUNC perc(a:INT,b:INT):INT PRE b != 0 -> 0 RETURN if (a<32 -> ((a .* 1000)./b)./10, a<64 -> ((a .* 500)./b)./ 5, a<160 -> ((a .* 200)./b)./ 2, a<320 -> (a .* 100)./b, a<640 -> ((a .* 50)./b).* 2, a<1280 -> ((a .* 25)./b).* 4) otherwise ((a./b) .* 100); FUNC prob(i:INT,j:INT):BOOL RETURN rand(j) < i; FUNC rand2(i:INT,j:INT):INT RETURN rand(j .- i .+ 1) .+ i; FUNC rchoice(s:ANY-set):ANY PRE s != {} RETURN nth(rand(card(s)).+1,< x | x<-s >); rcprob(s) = let (tf = add-orio(0,{ p2(s[k]) | k <- dom(s) })) in _rcprob_(s,tf,0); _rcprob_(s,tf,cf) = if (s == []) then [] else let (x = choice(dom(s)), y = s[x], cx = p1(y), fx = p2(y), sx = p3(y), rfx = perc(fx,tf), cfx = cf .+ rfx) in [ x -> R(cx,fx,sx,rfx,cfx) ] + _rcprob_(s\{x},tf,cfx); ; ; One-point crossover for variable size chromosomes ; vcrossover(s,i) = if i > PS(GV) then [] else if (prob(PC(GV),100)) then _vcross_(s,i) + vcrossover(s,i.+2) else _ncross_(s,i) + vcrossover(s,i.+1); _vcross_(s,k) = let (x = rchoice(dom(s)), y = rchoice(dom(s)), sx = gpSEL(x,3), sy = gpSEL(y,3), cp = if sx < sy then rand(sx) else rand(sy), cx = gpSEL(x,1), cy = gpSEL(y,1), nx = < nth(i,cx) | i <- inseg(cp) > ^ < nth(i,cy) | i <- {j | j <- inseg(sy):gt(j,cp)} >, ny = < nth(i,cy) | i <- inseg(cp) > ^ < nth(i,cx) | i <- {j | j <- inseg(sx):gt(j,cp)} >, fx = gpSEL(x,2), fy = gpSEL(y,2), rfx = gpSEL(x,4), rfy = gpSEL(y,4), cfx = gpSEL(x,5), cfy = gpSEL(y,5)) in [ k -> R(nx,fx,sy,rfx,cfx), k.+1 -> R(ny,fy,sx,rfy,cfy) ]; ; ; To be replaced by the specific evaluation function... ; _evalf_(c) = if c == <> then 0 else intSUM(c); ;_evalf_(c) = if c == <> then 0 ; else let (h = head(c),t = tail(c)) ; in if (h == 1) then 1 .+ _evalf_(t) ; else _evalf_(t); ;_evalf_(c) = _eval2_(c,1); _eval2_(c,i) = if c == <> then 0 else let (h = hd(c), t = tl(c)) in div(h,i) .+ rem(h,i) .+ _eval2_(t,i.+1); ;-------------------------------------------------------------------- ; Genetic Programming main functions ; ; Default parameters ; GV <- P(10,10,1,25,60,10,false,1,true,1,37); FUNC gpSTART() STATE do(gpINIT(), if (GR(GV) == 0 -> _start0_(), GR(GV) == 1 -> _start1_(), GR(GV) == 2 -> _start2_())); _start0_() = if not(VC(GV)) then foreach(k,inseg(PS(GV)), let (b = R(< rem(rand(i),2) | i <- inseg(CS(GV)) >,0,0,0,0)) in gpINS(k,b)) else foreach(k,inseg(PS(GV)), let (r = rand(CS(GV)), b = R(< rem(rand(i),2) | i <- inseg(r) >,0,0,0,0)) in gpINS(k,b)); _start1_() = if not(VC(GV)) then foreach(k,inseg(PS(GV)), let (b = R(< rand(MV(GV)) | i <- inseg(CS(GV)) >,0,0,0,0)) in gpINS(k,b)) else foreach(k,inseg(PS(GV)), let (r = rand(CS(GV)), b = R(< rand(MV(GV)) | i <- inseg(r) >,0,r,0,0)) in gpINS(k,b)); _start2_() = if not(VC(GV)) then foreach(k,inseg(PS(GV)), let (b = R(< < rand(MV(GV)) | j <- inseg(SS(GV)) > | i <- inseg(CS(GV)) >,0,0,0,0)) in gpINS(k,b)) else foreach(k,inseg(PS(GV)), let (r = rand(CS(GV)), b = R(< < rand(MV(GV)) | j <- inseg(SS(GV)) > | i <- inseg(r) >,0,r,0,0)) in gpINS(k,b)); FUNC gpPSTART(s:INT-set) PRE GR(GV) == 1 || GR(GV) == 2 STATE progn(gpINIT(), if (GR(GV) == 1 -> _pstart1_(s), GR(GV) == 2 -> _pstart2_(s))); _pstart1_(s) = if not(VC(GV)) then foreach(k,inseg(PS(GV)), let (b = R(< rchoice(s) | i <- inseg(CS(GV)) >,0,0,0,0)) in gpINS(k,b)) else foreach(k,inseg(PS(GV)), let (r = rand(CS(GV)), b = R(< rchoice(s) | i <- inseg(r) >,0,r,0,0)) in gpINS(k,b)); _pstart2_(s) = if not(VC(GV)) then foreach(k,inseg(PS(GV)), let (b = R(< < rchoice(s) | j <- inseg(SS(GV)) > | i <- inseg(CS(GV)) >,0,0,0,0)) in gpINS(k,b)) else foreach(k,inseg(PS(GV)), let (r = rand(CS(GV)), b = R(< < rchoice(s) | j <- inseg(SS(GV)) > | i <- inseg(r) >,0,r,0,0)) in gpINS(k,b)); FUNC gpSELECT() STATE G <- let (t = intMAX({ p5(G[x]) | x <- dom(G) })) in if (BS(GV)) then let (b = gpBEST(), x = choice(dom(b))) in [ 1 -> b[x] ] + _roleta_(G,2,t) else _roleta_(G,1,t); _roleta_(s,n,t) = if n > PS(GV) then [] else _select_(s,n,rand(t)) + _roleta_(s,n.+1,t); _select_(s,i,p) = if (s == []) then [] else let (x = choice(dom(s)), y = s[x], cx = p1(y), fx = p2(y), sx = p3(y), rfx = p4(y), cfx = p5(y)) in if (p > cfx) then _select_(s\{x},i,p) else [ i -> R(cx,fx,sx,rfx,cfx) ]; FUNC gpCROSSOVER() STATE if (BS(GV)) then let (b = gpBEST(), x = choice(dom(b)), o = if (CT(GV) == 1 -> crossover1(G,2), CT(GV) == 2 -> crossover2(G,2), CT(GV) == 3 -> ucrossover(G,2)), p = if card(dom(o)) == PS(GV) then o \ { rchoice(dom(o)) } else o) in G <- [ 1 -> b[x] ] + p else let (o = if (CT(GV) == 1 -> crossover1(G,1), CT(GV) == 2 -> crossover2(G,1), CT(GV) == 3 -> ucrossover(G,1)), p = if card(dom(o)) == PS(GV) then o else o \ { rchoice(dom(o)) }) in G <- p; ; ; One-point crossover ; crossover1(s,i) = if i > PS(GV) then [] else if (prob(PC(GV),100)) then _cross1_(s,i) + crossover1(s,i.+2) else _ncross_(s,i) + crossover1(s,i.+1); _cross1_(s,k) = let (x = rchoice(dom(s)), y = rchoice(dom(s)), cs = CS(GV), cp = rand(cs), cx = gpSEL(x,1), cy = gpSEL(y,1), nx = < nth(i,cx) | i <- inseg(cp) > ^ < nth(i,cy) | i <- {k | k <- inseg(cs):gt(k,cp)} >, ny = < nth(i,cy) | i <- inseg(cp) > ^ < nth(i,cx) | i <- {k | k <- inseg(cs):gt(k,cp)} >, fx = gpSEL(x,2), fy = gpSEL(y,2), sx = gpSEL(x,3), sy = gpSEL(y,3), rfx = gpSEL(x,4), rfy = gpSEL(y,4), cfx = gpSEL(x,5), cfy = gpSEL(y,5)) in [ k -> R(nx,fx,sx,rfx,cfx), k.+1 -> R(ny,fy,sy,rfy,cfy) ]; _ncross_(s,k) = let (x = rchoice(dom(s))) in [ k -> s[x] ]; ; ; Two-point crossover ; crossover2(s,i) = if i > PS(GV) then [] else if (prob(PC(GV),100)) then _cross2_(s,i) + crossover2(s,i.+2) else _ncross_(s,i) + crossover2(s,i.+1); _cross2_(s,k) = let (x = rchoice(dom(s)), y = rchoice(dom(s)), cs = CS(GV), cp1 = rand(cs), cp2 = rand2(cp1,cs), ;p1 = princ("\ncp1=",cp1), ;p2 = princ("\ncp2=",cp2), cx = gpSEL(x,1), cy = gpSEL(y,1), nx = < nth(i,cx) | i <- inseg(cp1) > ^ < nth(i,cy) | i <- {k | k <- inseg(cp2):gt(k,cp1)}> ^ < nth(i,cx) | i <- {k | k <- inseg(cs):gt(k,cp2)} >, ny = < nth(i,cy) | i <- inseg(cp1) > ^ < nth(i,cx) | i <- {k | k <- inseg(cp2):gt(k,cp1)}> ^ < nth(i,cy) | i <- {k | k <- inseg(cs):gt(k,cp2)} >, fx = gpSEL(x,2), fy = gpSEL(y,2), sx = gpSEL(x,3), sy = gpSEL(y,3), rfx = gpSEL(x,4), rfy = gpSEL(y,4), cfx = gpSEL(x,5), cfy = gpSEL(y,5)) in [ k -> R(nx,fx,sx,rfx,cfx), k.+1 -> R(ny,fy,sy,rfy,cfy) ]; ; ; Uniform crossover ; ucrossover(s,i) = if i > PS(GV) then [] else if (prob(PC(GV),100)) then _ucross_(s,i) + ucrossover(s,i.+2) else _ncross_(s,i) + ucrossover(s,i.+1); _ucross_(s,k) = let (x = rchoice(dom(s)), y = rchoice(dom(s)), cs = CS(GV), cx = gpSEL(x,1), cy = gpSEL(y,1), = _ucrossover_(cx,cy), fx = gpSEL(x,2), fy = gpSEL(y,2), sx = gpSEL(x,3), sy = gpSEL(y,3), rfx = gpSEL(x,4), rfy = gpSEL(y,4), cfx = gpSEL(x,5), cfy = gpSEL(y,5)) in [ k -> R(nx,fx,sx,rfx,cfx), k.+1 -> R(ny,fy,sy,rfy,cfy) ]; _ucrossover_(cx,cy) = if (cx == <> || cy == <>) then <<>,<>> else let (hx = hd(cx), hy = hd(cy), tx = tl(cx), ty = tl(cy), tt = _ucrossover_(tx,ty)) in if (prob(PU(GV),100)) then else ; FUNC gpMUTATION() STATE if (GR(GV) == 0 -> G <- mutation(G), GR(GV) == 1 -> G <- mutation10(G), GR(GV) == 2 -> G <- mutation10l(G)); mutation(s) = if (s == []) then [] else let (x = choice(dom(s)), c = < _mutate_(k) | k <- gpSEL(x,1) >, fx = gpSEL(x,2), sx = gpSEL(x,3), rfx = gpSEL(x,4), cfx = gpSEL(x,5)) in [ x -> R(c,fx,sx,rfx,cfx) ] + mutation(s\{x}); _mutate_(bit) = if (prob(PM(GV),100)) then if (bit == 0 -> 1, bit == 1 -> 0) else bit; mutation10(s) = if (s == []) then [] else let (x = choice(dom(s)), c = < _mutate10_(k) | k <- gpSEL(x,1) >, fx = gpSEL(x,2), sx = gpSEL(x,3), rfx = gpSEL(x,4), cfx = gpSEL(x,5)) in [ x -> R(c,fx,sx,rfx,cfx) ] + mutation10(s\{x}); mutation10l(s) = if (s == []) then [] else let (x = choice(dom(s)), c = < ((_mutate10_)-list)(k) | k <- gpSEL(x,1) >, fx = gpSEL(x,2), sx = gpSEL(x,3), rfx = gpSEL(x,4), cfx = gpSEL(x,5)) in [ x -> R(c,fx,sx,rfx,cfx) ] + mutation10l(s\{x}); _mutate10_(dig) = if (prob(PM(GV),100)) then rand(MV(GV)) else dig; FUNC gpEVAL() STATE G <- rcprob(evalf(G)); evalf(s) = if (s == []) then [] else let (x = choice(dom(s)), cx = gpSEL(x,1), sx = gpSEL(x,3)) in [ x -> R(cx,_evalf_(cx),sx,0,0) ] + evalf(s\{x}); FUNC gpBEST():I->R RETURN [ k -> G[k] | k <- dom(G) : gpSEL(k,2) == max-orio(0,{gpSEL(x,2) | x <- dom(G)}) ]; FUNC gpBESTVAL():I->R PRE not(gpEMPTY()) RETURN let (m = max-orio(0,{ gpSEL(x,2) | x <- dom(G) }), ; b = ([ k -> | k <- dom(G) : gpSEL(k,2) == m ]), b = ([ k -> G[k] | k <- dom(G) : gpSEL(k,2) == m ]), c = choice(dom(b))) ; in < _evalf_(b[c]),b[c] >; in [ c->b[c] ]; FUNC gpEVOLUTION(n:INT) STATE progn(gpSTART(),gpEVAL(), fp <- fopen("w","_"), princ("> Best(",0,"): ", mypptex(gpBESTVAL()), "\n> thinking..."), foreach(x,inseg(n),gpSELECT(),gpCROSSOVER(),gpMUTATION(),gpEVAL(), princ(" best (",x,"): ", mypptex(gpBESTVAL()), "\n> thinking...")), fclose(fp)); mypp(x) = let (a = choice(dom(x)), b = x[a]) in "IND(" ++ itoa(a) ++ ") with CROM(" ++ "<" ++ pplst(p1(b)) ++ ">" ++ ") and EVAL(" ++ itoa(p2(b)) ++ ")"; mypptex(x) = let (a = choice(dom(x)), b = x[a], s = itoa(a) ++ " & " ++ "$<" ++ pplst(p1(b)) ++ ">$" ++ " & " ++ itoa(p2(b)) ++ "\\\\ \n\\hline\\\\\n") in fprint("_","a",); pplst(l) = if l == <> then "" else itoa(hd(l)) ++ "," ++ pplst(tl(l)); FUNC gpSETTINGS(p:P) STATE GV <- P(CS(p),PS(p),SS(p),PC(p),PU(p),PM(p),VC(p),CT(p),BS(p),GR(p),MV(p).+1); FUNC gpSHOWSETTINGS() RETURN princ( "CS (Chromsize) = ",CS(GV), "\nPS (Population Size) = ",PS(GV), "\nSS (Segment Size) = ",SS(GV)," (decimal list representation only)", "\nPC (Probability Crossover) = ",PC(GV),"%", "\nPU (Probability Unif. Crossover) = ",PU(GV),"%", "\nPM (Probability Mutation) = ",PM(GV),"%", "\nVC (Variable Size Chrom.) = ",VC(GV)," (true/false)", "\nCT (Crossover type) = ",CT(GV)," (1=one-point, 2=two-point,3=unif.)", "\nBS (Best survives) = ",BS(GV)," (true/false)", "\nGR (Gene Representation) = ",GR(GV)," (0=binary, 1=decimal, 2=decimal-list)", "\nMV (Maximum Gene Value) = ",MV(GV)," (decimal and dec-list representation only)", "\n" ); FUNC gpRULES(a:I):INT-list PRE a in dom(G) RETURN let (c = 1, ps = SS(GV), cx = gpSEL(a,1)) in _c2rules_(c,ps,cx); _c2rules_(c,ps,cx) = let (l = length(cx)) in if gt(c,l) then <> else let (cp = < nth(i,cx) | i <- inseg(l) : (geq(i,c) && leq(i,c .+ ps .- 1)) >) in cons(bin2dec(cp),_c2rules_(add(c,ps),ps,cx)); bin2dec(s) = if s == <> then 0 else if (hd(s) == 1) then let (l = sub(length(s),1), v = if (l == 0 -> 1, l == 1 -> 2, l == 2 -> 4, l == 3 -> 8, l == 4 -> 16, l == 5 -> 32, l == 6 -> 64, l == 7 -> 128, l == 8 -> 256, l == 9 -> 512, l == 10 -> 1024) otherwise (princ("\n!..out of range...\n"))) in add(v,bin2dec(tl(s))) else bin2dec(tl(s));