197 lines
4.9 KiB
Plaintext
197 lines
4.9 KiB
Plaintext
/* Evolutionary "nice" pictures.
|
|
|
|
breed bitmaps. A fitness function will assign numbers according to
|
|
all sorts of perception criteria. mutation, the usual.
|
|
|
|
possible "niceness" criteria:
|
|
- amount of surrounding pixels having a similar color -> smoothness
|
|
- amount of different colors used in total -> diversity
|
|
- longer stretching lines (hard to detect)
|
|
- symmetry / repetition / parallelism
|
|
- find longest path (fill-alg)
|
|
|
|
*/
|
|
|
|
OPT OSVERSION=37, PREPROCESS, REG=5
|
|
|
|
-> fixed parameters
|
|
|
|
DEF bmx=10,bmy=30, -> bitmap size
|
|
bmnum=3, -> #of bitmaps to breed at once
|
|
evrate=2, -> kill/birth rate of evolution. <bmnum
|
|
nummut=1, -> number of mutations each time
|
|
numrate=100 -> how many to rate
|
|
|
|
#define MIRROR
|
|
|
|
DEF bmt, -> total bytes per bitmap
|
|
hinum=0, -> best sofar
|
|
bmp=NIL:PTR TO LONG,
|
|
bmscore=NIL:PTR TO LONG,
|
|
bmcalc=NIL:PTR TO CHAR
|
|
|
|
MODULE 'tools/easygui', 'tools/exceptions', 'tools/clonescreen',
|
|
'intuition/screens'
|
|
|
|
DEF scr=NIL:PTR TO screen,font
|
|
|
|
DEF fmt,keepshowing=TRUE,iterations
|
|
|
|
PROC main() HANDLE
|
|
DEF r
|
|
fmt:='%2ld'
|
|
LOOP
|
|
r:=easygui('Nice Pix',
|
|
[EQROWS,
|
|
[SLIDE,{setbmx},'bitmap x size: ',FALSE,3,99,bmx,10,fmt],
|
|
[SLIDE,{setbmy},'bitmap y size: ',FALSE,3,99,bmy,10,fmt],
|
|
[SLIDE,{setbmn},'#of bitmaps: ',FALSE,2,99,bmnum,10,fmt],
|
|
[SLIDE,{setevr},'kill/birth: ',FALSE,1,99,evrate,10,fmt],
|
|
[SLIDE,{setmut},'mutations: ',FALSE,1,99,nummut,10,fmt],
|
|
[SLIDE,{setrat},'rating: ',FALSE,1,999,numrate,10,fmt],
|
|
[BAR],
|
|
[COLS,[BUTTON,1,'Start'],[SPACEH],[BUTTON,0,'Cancel']]
|
|
]
|
|
)
|
|
evrate:=Bounds(evrate,1,bmnum-1)
|
|
IF r=0 THEN Raise()
|
|
actionreq()
|
|
ENDLOOP
|
|
EXCEPT
|
|
IF scr THEN closeclonescreen(scr,font)
|
|
report_exception()
|
|
ENDPROC
|
|
|
|
PROC setbmx(i,n) IS bmx:=n
|
|
PROC setbmy(i,n) IS bmy:=n
|
|
PROC setbmn(i,n) IS bmnum:=n
|
|
PROC setevr(i,n) IS evrate:=n
|
|
PROC setmut(i,n) IS nummut:=n
|
|
PROC setrat(i,n) IS numrate:=n
|
|
|
|
PROC actionreq() HANDLE
|
|
DEF gh=NIL:PTR TO guihandle,res=-1,count=0,a
|
|
gh:=guiinit('Nice Pix Action: BUSY',
|
|
[EQROWS,
|
|
[CHECK,{togglekeep},'keep showing picture:',keepshowing,TRUE],
|
|
[SLIDE,{setw1},'weight: ',FALSE,0,99,50,10,fmt],
|
|
[BAR],
|
|
[COLS,[BUTTON,{showpic},'Show Picture'],[SPACEH],[BUTTON,0,'Stop']]
|
|
]
|
|
)
|
|
setupsim()
|
|
IF scr THEN SetRast(scr.rastport,0)
|
|
WHILE res<0
|
|
->Wait(gh.sig)
|
|
res:=guimessage(gh)
|
|
FOR a:=1 TO 3 DO dosim()
|
|
IF keepshowing THEN IF count++ AND $F = 0 THEN showpic(0)
|
|
ENDWHILE
|
|
EXCEPT DO
|
|
deallocsim()
|
|
cleangui(gh)
|
|
IF exception THEN ReThrow()
|
|
ENDPROC res
|
|
|
|
PROC setw1(i,n) IS n
|
|
PROC togglekeep(i,n) IS keepshowing:=n
|
|
|
|
CONST XO=40,YO=40,XZ=2,YZ=2,COL=16,DEPTH=4
|
|
CONST XO1=XO+XZ-1,YO1=YO+YZ-1,XZ2=XZ*2,YZ2=YZ*2
|
|
|
|
PROC showpic(i)
|
|
DEF x,y,bm
|
|
bm:=bmp[hinum]
|
|
IF scr=NIL
|
|
scr,font:=openclonescreen('Workbench','Nice!',DEPTH)
|
|
ENDIF
|
|
SetStdRast(scr.rastport)
|
|
Colour(2,0)
|
|
TextF(XO,YO-10,'hi = \d, it = \d ',bmscore[hinum],iterations)
|
|
FOR y:=YZ TO bmy*YZ STEP YZ
|
|
FOR x:=XZ TO bmx*XZ STEP XZ
|
|
#ifdef MIRROR
|
|
Box(bmx*XZ2-x+XO,y+YO,bmx*XZ2-x+XO1,y+YO1,bm[])
|
|
Box(bmx*XZ2-x+XO,bmy*YZ2-y+YO,bmx*XZ2-x+XO1,bmy*YZ2-y+YO1,bm[])
|
|
Box(x+XO,bmy*YZ2-y+YO,x+XO1,bmy*YZ2-y+YO1,bm[])
|
|
#endif
|
|
Box(x+XO,y+YO,x+XO1,y+YO1,bm[]++)
|
|
ENDFOR
|
|
ENDFOR
|
|
ENDPROC
|
|
|
|
PROC setupsim()
|
|
DEF a,bm,b
|
|
bmt:=bmx*bmy
|
|
hinum:=0
|
|
iterations:=0
|
|
NEW bmp[bmnum]
|
|
NEW bmcalc[bmnum]
|
|
NEW bmscore[bmnum]
|
|
FOR a:=0 TO bmnum-1
|
|
bmp[a]:=bm:=FastNew(bmt)
|
|
FOR b:=0 TO bmt-1 DO bm[]++:=Rnd(COL)
|
|
ENDFOR
|
|
ENDPROC
|
|
|
|
PROC deallocsim()
|
|
DEF a
|
|
IF bmp THEN FOR a:=0 TO bmnum-1 DO IF bmp[a] THEN FastDispose(bmp[a],bmt)
|
|
END bmp[bmnum]
|
|
END bmcalc[bmnum]
|
|
END bmscore[bmnum]
|
|
ENDPROC
|
|
|
|
CONST MINSTART=$7FFFFFFF
|
|
|
|
PROC dosim()
|
|
DEF a,b,min,minnum
|
|
iterations++
|
|
FOR a:=0 TO bmnum-1 -> make sure all are rated
|
|
IF bmcalc[a]=FALSE
|
|
mutate(bmp[a])
|
|
bmscore[a]:=rate(bmp[a]) -> mutate and rerate if necessary
|
|
IF bmscore[a]>bmscore[hinum] THEN hinum:=a -> keep track of best
|
|
bmcalc[a]:=TRUE
|
|
ENDIF
|
|
ENDFOR
|
|
FOR a:=1 TO evrate -> pick n victims
|
|
min:=MINSTART
|
|
FOR b:=0 TO bmnum-1
|
|
IF (bmcalc[b]) AND b<>hinum
|
|
IF bmscore[b]<min -> calc worst
|
|
min:=bmscore[b]
|
|
minnum:=b
|
|
ENDIF
|
|
ENDIF
|
|
ENDFOR
|
|
IF min=MINSTART THEN Raise("prob")
|
|
bmcalc[minnum]:=FALSE
|
|
CopyMem(bmp[hinum],bmp[minnum],bmt) -> copy from best
|
|
ENDFOR
|
|
ENDPROC
|
|
|
|
PROC mutate(bm)
|
|
DEF a
|
|
FOR a:=1 TO nummut DO bm[Rnd(bmt)]:=Rnd(COL)
|
|
ENDPROC
|
|
|
|
PROC rate(bma) -> B: mixed environ
|
|
DEF a,c=0,tc,nc,bm
|
|
bm:=bma
|
|
FOR a:=0 TO bmt-1
|
|
tc:=bm[]
|
|
nc:=0
|
|
IF bm[-1]=tc THEN nc++
|
|
IF bm[1]=tc THEN nc++
|
|
IF bm[bmx]=tc THEN nc++
|
|
IF bm[bmx-1]=tc THEN nc++
|
|
IF bm[bmx+1]=tc THEN nc++
|
|
IF bm[-bmx]=tc THEN nc++
|
|
IF bm[-bmx-1]=tc THEN nc++
|
|
IF bm[-bmx+1]=tc THEN nc++
|
|
c:=c+(6-Abs(nc-2))
|
|
bm++
|
|
ENDFOR
|
|
ENDPROC c
|