100 REM Small Evolver With Automatic Extraction 6/22/09 WTN (mod 6/24/09)
110 REM Requires Blassic and pMARS 0.9.2+ with permutate option
120 REM This code is public domain, provided as-is, no warranty.
130 REM ----- setup (see docs) -----
140 L=5:N=1000:R=20:C=80:U=2:P$="pmars -b -k -s 80 -p 80 -c 800 -l 5"
150 DO=0:ER$=" -r 100 ":BR$=" -P ":BR=142:BF=500:BD$="bench":BM$="*.*"
160 I$="spl spl mov mov mov djn":M$=".i .i .i .a .b .f .x ":N$="$#@*<>{}"
170 IM=3:RM=2:RF=2000:MA=.02:MB=.03:MC=.03:MD=.06:ME=.03:MF=.06:MG=.01
180 SF$="sf.txt":O$="1.war":ST=135:SP$="save":SE$=".war":SN=1
190 REM ----- initialize -----------
200 PRINT "=== SEWAX 0.8 ==="
210 NI=INT((LEN(I$)+1)/4):NM=INT(LEN(M$)/3):NN=LEN(N$)
220 IF DO THEN SHELL "dir /b "+BD$+"\"+BM$+" >c":BP$=BD$+"\"
230 IF DO=0 THEN SHELL "ls -1 "+BD$+"/"+BM$+" >c":BP$=""
240 DIM A$(N,L),B$(N,L),C$(N,L),D(N,L),E$(N,L),F(N,L):RANDOMIZE 'TIMER
250 DIM VA$(L),VB$(L),VC$(L),VD(L),VE$(L),VF(L)
260 REM ----- set initial arrays ---
270 FOR W=1 TO N:FOR I=1 TO L:A$(W,I)="nop":IF IM=0 THEN 330
280 IF IM=1 OR IM=3 THEN A$(W,I)=MID$(I$,INT(RND*NI)*4+1,3)
290 IF (IM=2 OR IM=4) AND I<=NI THEN A$(W,I)=MID$(I$,(I-1)*4+1,3)
300 IF IM<3 THEN 330 ELSE B$(W,I)=MID$(M$,INT(RND*NM)*3+1,3)
310 C$(W,I)=MID$(N$,INT(RND*NN+1),1):D(W,I)=INT((RND^U-RND^U)*C)
320 E$(W,I)=MID$(N$,INT(RND*NN+1),1):F(W,I)=INT((RND^U-RND^U)*C)
330 NEXT I:NEXT W:FOR I=1 TO L:VA$(I)="nop":NEXT I:H=0:B=0:RC=0
340 REM ----- restore best vars and soup ---
350 INPUT "Load soup";Z$:Z$=LEFT$(Z$,1):IF Z$<>"Y" AND Z$<>"y" THEN 430
360 PRINT "Loading...":OPEN SF$ FOR INPUT AS #1:INPUT #1,Z$
370 Z=INSTR(Z$,"next save:"):IF Z THEN SN=VAL(MID$(Z$,Z+10)):PRINT SN
380 Z=INSTR(Z$,"top score:"):IF Z THEN H=VAL(MID$(Z$,Z+10))+1E-8:PRINT H
390 FOR I=1 TO L:INPUT #1,VA$(I),VB$(I),VC$(I),VD(I),VE$(I),VF(I):NEXT I
400 FOR W=1 TO N:INPUT #1,Z$:IF LEFT$(Z$,3)<>"===" THEN CLOSE #1:GOTO 430
410 FOR I=1 TO L:INPUT #1,A$(W,I),B$(W,I),C$(W,I),D(W,I),E$(W,I),F(W,I)
420 NEXT I:NEXT W:CLOSE #1
430 PRINT "Evolving, press Esc to quit"
440 REM ----- main loop ------------
450 WHILE INKEY$<>CHR$(27):B=B+1:RC=RC+1:X=INT(RND*N+1)
460 Y=(X+(INT(RND*2)*2-1)*INT(RND*R+1))MOD N:IF Y<1 THEN Y=Y+N
470 W=X:F$="a":GOSUB 890:W=Y:F$="b":GOSUB 890:SHELL P$+ER$+" a b>s"
480 OPEN "s" FOR INPUT AS #1:INPUT #1,Z$:S1=VAL(Z$)
490 INPUT #1,Z$:S2=VAL(Z$):CLOSE #1:IF S2>=S1 THEN Z=W:W=X:X=Z
500 REM ----- mutate winner over loser -----
510 FOR I=1 TO L:A$(W,I)=A$(X,I):B$(W,I)=B$(X,I):C$(W,I)=C$(X,I)
520 D(W,I)=D(X,I):E$(W,I)=E$(X,I):F(W,I)=F(X,I)
530 IF RND<MA THEN A$(W,I)=MID$(I$,INT(RND*NI)*4+1,3)
540 IF RND<MB THEN B$(W,I)=MID$(M$,INT(RND*NM)*3+1,3)
550 IF RND<MC THEN C$(W,I)=MID$(N$,INT(RND*NN+1),1)
560 IF RND<MD THEN D(W,I)=INT((RND^U-RND^U)*C) 
570 IF RND<ME THEN E$(W,I)=MID$(N$,INT(RND*NN+1),1)
580 IF RND<MF THEN F(W,I)=INT((RND^U-RND^U)*C)
590 IF RND>MG OR I=1 THEN 640
600 Z$=A$(W,I):A$(W,I)=A$(W,I-1):A$(W,I-1)=Z$:Z$=B$(W,I):B$(W,I)=B$(W,I-1)
610 B$(W,I-1)=Z$:Z$=C$(W,I):C$(W,I)=C$(W,I-1):C$(W,I-1)=Z$:Z=D(W,I)
620 D(W,I)=D(W,I-1):D(W,I-1)=Z:Z$=E$(W,I):E$(W,I)=E$(W,I-1):E$(W,I-1)=Z$
630 Z=F(W,I):F(W,I)=F(W,I-1):F(W,I-1)=Z
640 NEXT I:IF B<BF THEN 760 ELSE B=0:W$=" b ":IF S2<S1 THEN W$=" a "
650 REM ----- benchmark current winner -----
660 S=0:V=0:OPEN "c" FOR INPUT AS #2:WHILE NOT EOF(2):V=V+1:INPUT #2,F$
670 SHELL P$+BR$+W$+BP$+F$+" >s":OPEN "s" FOR INPUT AS #1:INPUT #1,Z$
680 CLOSE #1:Z=INSTR(Z$," "):S=S+VAL(LEFT$(Z$,Z))*3+VAL(MID$(Z$,Z)):WEND
690 CLOSE #2:S=(S/V)*(100/BR):IF S<=H THEN 760 ELSE H=S:PRINT S
700 REM ----- if better save to V arrays and file(s) ---
710 FOR I=1 TO L:VA$(I)=A$(X,I):VB$(I)=B$(X,I):VC$(I)=C$(X,I)
720 VD(I)=D(X,I):VE$(I)=E$(X,I):VF(I)=F(X,I):NEXT I
730 W=X:F$=O$:GOSUB 890:IF S<ST THEN 760
740 F$=SP$+MID$(STR$(-SN),2)+SE$:GOSUB 890:SN=SN+1
750 REM ----- copy current best to soup ----
760 IF RM=0 OR RC<RF THEN 790 ELSE IF RM=1 THEN Z=1 ELSE Z=INT(RND*N+1)
770 FOR I=1 TO L:A$(Z,I)=VA$(I):B$(Z,I)=VB$(I):C$(Z,I)=VC$(I)
780 D(Z,I)=VD(I):E$(Z,I)=VE$(I):F(Z,I)=VF(I):NEXT I:RC=0
790 S=0:WEND '----- end main loop -----
800 INPUT "Save soup";Z$:Z$=LEFT$(Z$,1):IF Z$<>"Y" AND Z$<>"y" THEN 870
810 PRINT "Saving...":OPEN SF$ FOR OUTPUT AS #1
820 PRINT #1,"=== next save:";SN;" top score:";H:FOR I=1 TO L
830 PRINT #1,VA$(I);",";VB$(I);",";VC$(I);",";VD(I);",";VE$(I);",";VF(I)
840 NEXT I:FOR W=1 TO N:PRINT #1,"===";W:FOR I=1 TO L:PRINT #1,A$(W,I);
850 PRINT #1,",";B$(W,I);",";C$(W,I);",";D(W,I);",";E$(W,I);",";F(W,I)
860 NEXT I:NEXT W:PRINT #1,"*END*":CLOSE #1
870 SYSTEM
880 REM ----- warrior write sub -----
890 OPEN F$ FOR OUTPUT AS #1:PRINT #1,";assert 1":FOR I=1 TO L
900 PRINT #1,A$(W,I);B$(W,I);" ";C$(W,I);D(W,I);",";E$(W,I);F(W,I)
910 NEXT I:PRINT #1,";soup loc ";W:PRINT #1,";score ";S:CLOSE #1:RETURN
