RedMaker 1 Made by Terry Newton (wtnewton@nc5.infi.net) RedMaker is an experimental corewarrior evolver programmed in dos's qbasic. Its design was influenced by George Lebl's Sys4 program, particularly the two dimensional grid layout using the first two letters of the warrior names. Codewise, it's all new. Installing and running ---------------------- If you are running Windows 95 and don't know if you have qbasic, go to a dos prompt and enter "qbasic". If it comes up, alt-f x, you're fine, otherwise you need to find a copy of qbasic.exe and place it in the c:\windows\command directory. Sometimes it's on the Win95 installation CD (something like olddos) otherwise look around on the Microsoft web site, it's there somewhere. It helps to associate .BAS files with the qbasic.exe file. In addition to qbasic you will also need the pmars program, available at http://www.koth.org and other sites. As coded, the program expects to find pmars.exe in the current directory or in a path directory. If it can't find pmars, either add the pmars directory to your autoexec.bat path line, edit the redmaker.bas program to specify the full pmars path, or simply copy the redmaker.bas file to the pmars directory and run it there. This is a file-based system that accesses the disk every few seconds while running, run from a ramdisk if possible. To run, load redmaker.bas into qbasic and press F5, or enter the command "qbasic /run redmaker.bas" to run immediately. The following batch file will run RedMaker, call it redmaker.bat: @echo off qbasic /run redmaker.bas There is no user interface, to change the simulation parameters edit the redmaker.bas file. When running, the only valid interaction is to press control-c to stop the simulation and record the current iteration and survival score. Pressing any other key causes pmars to go into cdb but you won't see a prompt, just what you type. Press control-c and rerun the program. If you have cats, avoid leaving the screen in the forground, click the task bar or something to remove focus and keep random events from halting the simulation. Algorithms and Parameters ------------------------- Parameters are set by editing the redmaker.bas file. Grid size specifies how big to make the "evolution pool", the number is for each side, if 15, there's room for 15*15, or 225 warriors. Do not go over 21 unless you run the program in a console with more than 25 lines. Naming conventions prevent more than 26, any more you'll have to recode it. Note! This like everything else is not bounds-checked! If you enter improper data the program might grind to a halt, litter the screen with error messages or otherwise not function correctly. When the program is run, it checks for the existence of the warrior directory (specified in wardir$ as "warcode") and if present branches to the evolution code, otherwise the directory is created and filled with random warrior code. There are two ways to initialize based on the setting of teststart: if 0 it quickly creates a directory full of untested random redcode, if 1 it tests each member against a test warrior, specified in testwar$ and related variables. Initial populations must score at least testscore points. Using teststart = 1 takes a long time (!) but produces reasonably strong warriors without evolution. In fact evolving them might make them worse before they get better. Once there's a population it checks for the testwarrior and creates if necessary (if either teststart or testbirth = 1), reads the counter file if it exists (savefile$) and enters the evolution loop. Once it gets here you can stop it and rerun it at any time without messing things up, press control-c to write the current count and survival score and exit. Simplified main loop... mainloop: select random location if warrior do battle delete the loser (if defined) or warrior(s) that score < mss (min survival score) randomly delete if tie and >= mss else reproduce into the empty space if dobirthtests check new warrior against testwar$ if score < testscore or < mss delete new warrior jump to mainloop (non event, no increment) increment iteration if time increment mss (up to maxscore) if iteration > testdelay, dobirthtests=1 jump to mainloop The reproduce part uses several variables to define the odds of individual things changing, all range between 0 and 1. The localnum and localvar odds determine the proportion and variance of numbers chosen to refer to local code or up to coresize. If testbirth is enabled (1) new members must score at least testscore or mss points (whichever is greater) against the test warrior or they don't count. Usually having to be real is too much of a shock at first, so the testdelay variable defines how many iterations before kicking in evaluation, best to let mss climb over 100 to naturally weed out the duds. (in some cases that makes things worse, especially if evolving pretested warriors made with teststart=1.) If the 'remloser' variable is set to 1, warriors are deleted if they score less than their opponent. When set to 0, they only need to score at least the current mss to survive. REDMAKER 1 code listing ----------------------- Note... make sure wordwrapping is off before copy-paste, fix any wrapped lines before running. ------------- cut, save as REDMAKER.BAS ---------------- ' RedMaker 1 - a program that evolves core-warriors ' (c) 1998 Terry Newton wtnewton@nc5.infi.net ' Last modified March 24, 1998 ' ' Requires qbasic.exe and a dos that runs it like MsDos or win95 ' Pmars.exe must be in current or path dir (specify below if not) ' ' Distributed under GNU General Public License, see (almost any) ' copying.txt for details. ' gridsize = 15 '21 max, produces up to n^2 warriors maxlen = 25 'maximum warrior length coresize = 8000 'target core size rounds = 10 'rounds per battle 33 max perfect = .2 'chance of perfect copy change = .18 'overall chance of change per line datachange = 1 'individual chances, each start with adrchange = .8 ' 1/4 of the opportunities to change instrchange = .7 ' if change=.2 and datachange=.5 then sizechange = .6 ' actual chance=.025 (.2/4 * .5) localnum = .55 'chance constants are within warsize localvar = .15 'per cycle variation from localnum chance tragedy = .4 'chance of "accident" if tie startdensity = .9 'starting population density minscore = 95 'start value for minimum survival score maxscore = 125 'max value for minimum survival score adjrate = 250 'increase msc by 1 every n cycles remloser = 0 '0 or 1, remove loser (otherwise only if < mss) teststart = 0 '0 or 1, test initial population members testbirth = 0 '0 or 1, test new birth members testrounds = 3 'rounds to use when testing testdelay = 3000 'n iterations before testing (if not teststart) testscore = 250 'minimum score when testing pmars$ = "pmars -b" 'pmars comline (add dir if not on path) wardir$ = "warcode" 'directory to place evolved warriors savefile$ = "warcode\redmaker.dat" 'data save file, iteration and mss testwar$ = "warcode\test.war" 'test warrior, creates if not found testwarlen = 1 'default test warrior length testwarline$(1) = "jmp 0" 'a simple do-nothing target... ' instructions,modifiers,modes... DATA 12,dat,spl,jmn,jmp,djn,slt,add,sub,mul,div,mod,cmp DATA 7,a,b,ab,ba,f,x,i DATA 8,#,$,@,*,<,>,{,} ' initialize txto = gridsize * 2 + 8: homex = 17: homey = txto iteration = 0: dobirthchecks = 0: mss = minscore READ nins: DIM instructs$(nins) FOR i = 1 TO nins: READ instructs$(i): NEXT i READ nmod: DIM modifiers$(nmod) FOR i = 1 TO nmod: READ modifiers$(i): NEXT i READ nadr: DIM adrmodes$(nadr) FOR i = 1 TO nadr: READ adrmodes$(i): NEXT i RANDOMIZE TIMER ' check for existence of wardir checkwardir: ON ERROR GOTO nowarerr a$ = wardir$ + "\nul": OPEN a$ FOR INPUT AS #1 CLOSE #1: GOSUB checktestwar: GOTO evolve ' errorhandlers nowarerr: CLOSE : RESUME initstart initerror: CLOSE : PRINT "Cannot make warriors": SYSTEM nodatafile: RESUME cdfdone fswnoscore: CLOSE : RESUME getoutofhere reproerror: CLOSE : KILL redfile$: KILL opponent$ PRINT "Repro error, deleting "; name$; " "; newname$: SYSTEM ' here if invalid score from pressing ctrl-c in pmars getoutofhere: CLS : PRINT : PRINT "Bye!" ON ERROR GOTO getout1 KILL "score$.out": OPEN savefile$ FOR OUTPUT AS #1 PRINT #1, iteration: PRINT #1, mss getout1: CLOSE : SYSTEM ' create new population initstart: ON ERROR GOTO initerror SHELL "md " + wardir$ ON ERROR GOTO fswnoscore CLS : PRINT : PRINT "Creating new population... " IF NOT teststart = 0 THEN PRINT "(takes a long time, ctrl-c to exit)" GOSUB checktestwar FOR x = 1 TO gridsize: FOR y = 1 TO gridsize IF RND > startdensity GOTO initnext LOCATE 5, 1: PRINT "Working on warrior"; x; ","; y; " " name$ = CHR$(x + 64) + CHR$(y + 96) redfile$ = wardir$ + "\" + name$ + ".red" name$ = name$ + name$ makerndwarrior: localchance = localnum + ((RND - .5) * localvar) OPEN redfile$ FOR OUTPUT AS #1 warlen = INT(RND * maxlen) + 1 PRINT #1, ";RedMaker Warrior" PRINT #1, ";name "; name$ PRINT #1, ";assert 1" FOR ln = 1 TO warlen GOSUB makerndwarline: PRINT #1, warline$ NEXT ln: PRINT #1, "end": CLOSE #1 'if defined, battle new warrior against test warrior IF teststart = 0 GOTO initnext cl$ = pmars$ + " -r" + STR$(testrounds) + " -s" + STR$(coresize) cl$ = cl$ + " " + redfile$ + " " + testwar$ + ">score$.out" SHELL cl$: OPEN "score$.out" FOR INPUT AS #1 INPUT #1, a$: INPUT #1, b$: INPUT #1, c$: CLOSE #1 myscore = INT(VAL(RIGHT$(a$, 2)) * (100 / testrounds)) ' if score too try again IF myscore < testscore GOTO makerndwarrior ' do next member initnext: NEXT y: NEXT x ' reset save file OPEN savefile$ FOR OUTPUT AS #1 PRINT #1, 0: PRINT #1, mss: CLOSE #1 ' right to here if warriors exist evolve: 'check for data file ON ERROR GOTO nodatafile OPEN savefile$ FOR INPUT AS #1 INPUT #1, iteration: INPUT #1, mss cdfdone: CLOSE #1 ' ignore test delay if born tested IF testbirth = 1 AND teststart = 1 THEN dobirthchecks = 1 ' draw border CLS : PRINT : PRINT " "; CHR$(201); FOR i = 1 TO gridsize * 2: PRINT CHR$(205); : NEXT i PRINT CHR$(187): FOR i = 1 TO gridsize PRINT " "; CHR$(186); SPACE$(gridsize * 2); CHR$(186): NEXT i PRINT " "; CHR$(200); : FOR i = 1 TO gridsize * 2 PRINT CHR$(205); : NEXT i: PRINT CHR$(188); ' display warrior symbols FOR x = 1 TO gridsize: FOR y = 1 TO gridsize redfile$ = wardir$ + "\" + CHR$(x + 64) + CHR$(y + 96) + ".red" ON ERROR GOTO einowar OPEN redfile$ FOR INPUT AS #1 INPUT #1, a$: INPUT #1, a$: CLOSE #1 name$ = MID$(a$, 7, 2): LOCATE y + 2, x * 2 + 2 n1 = ASC(MID$(name$, 1, 1)): n2 = ASC(MID$(name$, 2, 1)) c1 = n1 MOD 16: c2 = n2 MOD 8 IF c1 = c2 THEN c1 = (n1 + 1) MOD 8 + 8 COLOR c1, c2: PRINT name$: GOTO eicontinue einowar: CLOSE #1: RESUME eicontinue eicontinue: NEXT y: NEXT x COLOR 4, 0: LOCATE 3, txto: PRINT "REDMAKER 1" COLOR 6, 0: LOCATE 15, txto: PRINT "Control-c to exit" LOCATE 16, txto: PRINT "Any key to crash" evolveloop: IF iteration > testdelay AND testbirth <> 0 THEN dobirthchecks = 1 COLOR 7, 0 LOCATE 11, txto: PRINT "Iteration"; iteration LOCATE 12, txto: PRINT "Min survival ="; mss IF testbirth <> 0 THEN LOCATE 13, txto: PRINT "Evaluation "; IF dobirthchecks = 0 THEN PRINT "disabled" ELSE PRINT "enabled " END IF COLOR 7, 0: LOCATE homex, homey ' find a warrior at a random location fragain: x = INT(RND * gridsize) + 1: y = INT(RND * gridsize) + 1 redfile$ = wardir$ + "\" + CHR$(x + 64) + CHR$(y + 96) + ".red" ON ERROR GOTO frnowar OPEN redfile$ FOR INPUT AS #1 INPUT #1, a$: INPUT #1, a$: CLOSE #1: GOTO frok frnowar: CLOSE #1: RESUME fragain frok: name$ = MID$(a$, 7, 4) ' check surrounding area for a warrior to battle direction = INT(RND * 8) IF direction = 0 THEN x1 = x - 1: y1 = y IF direction = 2 THEN x1 = x: y1 = y - 1 IF direction = 4 THEN x1 = x + 1: y1 = y IF direction = 6 THEN x1 = x: y1 = y + 1 IF direction = 1 THEN x1 = x - 1: y1 = y - 1 IF direction = 3 THEN x1 = x + 1: y1 = y - 1 IF direction = 5 THEN x1 = x + 1: y1 = y + 1 IF direction = 7 THEN x1 = x - 1: y1 = y + 1 ' wraparound IF x1 < 1 THEN x1 = gridsize IF y1 < 1 THEN y1 = gridsize IF x1 > gridsize THEN x1 = 1 IF y1 > gridsize THEN y1 = 1 ' form filename and try to open opponent$ = wardir$ + "\" + CHR$(x1 + 64) + CHR$(y1 + 96) + ".red" ON ERROR GOTO fsnowar OPEN opponent$ FOR INPUT AS #1 INPUT #1, a$: INPUT #1, a$: CLOSE #1: GOTO fswar fsnowar: CLOSE #1: RESUME fsreproduce ' if it's a warrior, do battle fswar: opname$ = MID$(a$, 7, 4) LOCATE 5, txto: PRINT name$; " vs. "; opname$; " ": LOCATE homex, homey cl$ = pmars$ + " -r" + STR$(rounds) + " -s" + STR$(coresize) cl$ = cl$ + " " + redfile$ + " " + opponent$ + ">score$.out" ON ERROR GOTO fswnoscore SHELL cl$: OPEN "score$.out" FOR INPUT AS #1 INPUT #1, a$: INPUT #1, b$: INPUT #1, c$: CLOSE #1 myscore = INT(VAL(RIGHT$(a$, 2)) / (rounds / 100)) 'valid if rounds <= 33 opscore = INT(VAL(RIGHT$(b$, 2)) / (rounds / 100)) LOCATE 6, txto: PRINT name$; " scores"; myscore; " " LOCATE 7, txto: PRINT opname$; " scores"; opscore; " " ' remove loser or if below min survival score IF (myscore < opscore AND remloser = 1) OR myscore < mss THEN f$ = redfile$: x2 = x: y2 = y n$ = name$: GOSUB killwarrior END IF IF (opscore < myscore AND remloser = 1) OR opscore < mss THEN f$ = opponent$: x2 = x1: y2 = y1 n$ = opname$: GOSUB killwarrior END IF ' sometimes remove ties IF opscore = myscore AND opscore >= mss THEN f$ = redfile$: x2 = x: y2 = y: n$ = name$ IF RND < tragedy THEN GOSUB killwarrior f$ = opponent$: x2 = x1: y2 = y1: n$ = opname$ IF RND < tragedy THEN GOSUB killwarrior END IF 'and continue GOTO nextfight ' if opponent doesn't exist produce a varient fsreproduce: ON ERROR GOTO reproerror localchance = localnum + ((RND - .5) * localvar) newname$ = LEFT$(name$, 2) + CHR$(x1 + 64) + CHR$(y1 + 96) ' determine warrior size warlen = 0: OPEN redfile$ FOR INPUT AS #1 LINE INPUT #1, a$: LINE INPUT #1, a$: LINE INPUT #1, a$ reprods: LINE INPUT #1, a$ IF a$ <> "end" THEN warlen = warlen + 1: GOTO reprods CLOSE #1: OPEN redfile$ FOR INPUT AS #1 LINE INPUT #1, a$: LINE INPUT #1, a$: LINE INPUT #1, a$ ' open outfile and write headers OPEN opponent$ FOR OUTPUT AS #2 PRINT #2, ";RedMaker Warrior" PRINT #2, ";name "; newname$ PRINT #2, ";assert 1" ln = 0: pc = 0: IF RND < perfect THEN pc = 1 reproloop: ln = ln + 1: LINE INPUT #1, myline$ IF myline$ = "end" GOTO reprodone IF RND > change OR pc = 1 GOTO reprowl ' no change in line ' add, delete and alter various things what = INT(RND * 8) + 1 ' second chances to not change IF what = 3 OR what = 4 THEN IF RND > instrchange GOTO reprowl IF what = 6 OR what = 8 THEN IF RND > datachange GOTO reprowl IF what = 5 OR what = 7 THEN IF RND > adrchange GOTO reprowl IF what = 1 OR what = 2 THEN IF RND > sizechange GOTO reprowl ' change selected thing ON what GOTO addline, delline, chinst, chmod, chadr1, chconst1, chadr2, chconst2 addline: IF warlen = maxlen GOTO reprowl GOSUB makerndwarline: PRINT #2, warline$ warlen = warlen + 1: GOTO reprowl delline: IF warlen = 1 GOTO reprowl warlen = warlen - 1: GOTO reproloop chinst: MID$(myline$, 1, 3) = instructs$(INT(RND * nins) + 1): GOTO reprowl chmod: MID$(myline$, 5, 2) = modifiers$(INT(RND * nmod) + 1) + " ": GOTO reprowl chadr1: MID$(myline$, 8, 1) = adrmodes$(INT(RND * nadr) + 1): GOTO reprowl chadr2: MID$(myline$, 16, 1) = adrmodes$(INT(RND * nadr) + 1): GOTO reprowl chconst1: IF RND < localchance THEN n = INT(RND * warlen) - ln + 1 ELSE n = INT(RND * coresize) END IF MID$(myline$, 9, 5) = LEFT$(STR$(n) + " ", 5): GOTO reprowl chconst2: IF RND < localchance THEN n = INT(RND * warlen) - ln + 1 ELSE n = INT(RND * coresize) END IF MID$(myline$, 17, 5) = LEFT$(STR$(n) + " ", 5) ' write new warrior line, changed or not reprowl: PRINT #2, myline$: GOTO reproloop reprodone: PRINT #2, "end": CLOSE #1: CLOSE #2 'if defined, test new warrior against a test warrior IF dobirthchecks = 0 GOTO updatedisplay cl$ = pmars$ + " -r" + STR$(testrounds) + " -s" + STR$(coresize) cl$ = cl$ + " " + opponent$ + " " + testwar$ + ">score$.out" ON ERROR GOTO fswnoscore SHELL cl$: OPEN "score$.out" FOR INPUT AS #1 INPUT #1, a$: INPUT #1, b$: INPUT #1, c$: CLOSE #1 myscore = INT(VAL(RIGHT$(a$, 2)) / (testrounds / 100)) ' if score too low pretend it didn't happen IF myscore < mss OR myscore < testscore THEN KILL opponent$: GOTO fragain ' update display for birth updatedisplay: LOCATE 9, txto: PRINT "Creating "; newname$ LOCATE y1 + 2, x1 * 2 + 2: n1 = ASC(MID$(name$, 1, 1)) n2 = ASC(MID$(name$, 2, 1)): c1 = n1 MOD 16: c2 = n2 MOD 8 IF c1 = c2 THEN c1 = (n1 + 1) MOD 8 + 8 COLOR c1, c2: PRINT LEFT$(name$, 2); : COLOR 7, 0 ' again and again... nextfight: iteration = iteration + 1 IF iteration MOD adjrate = 0 THEN mss = mss + 1 IF mss > maxscore THEN mss = maxscore GOTO evolveloop ' sub - make one line of redcode (ln=line number) makerndwarline: warline$ = " " a$ = instructs$(INT(RND * nins) + 1) + "." a$ = a$ + modifiers$(INT(RND * nmod) + 1) MID$(warline$, 1, 6) = a$ MID$(warline$, 8, 1) = adrmodes$(INT(RND * nadr) + 1) IF RND < localchance THEN n = INT(RND * warlen) - ln + 1 ELSE n = INT(RND * coresize) END IF MID$(warline$, 9, 5) = STR$(n) MID$(warline$, 14, 1) = "," MID$(warline$, 16, 1) = adrmodes$(INT(RND * nadr) + 1) IF RND < localchance THEN n = INT(RND * warlen) - ln + 1 ELSE n = INT(RND * coresize) END IF MID$(warline$, 17, 5) = STR$(n): RETURN ' sub - remove file f$ and from display killwarrior: LOCATE 8, txto: PRINT "Removing "; n$: KILL f$ LOCATE y2 + 2, x2 * 2 + 2: PRINT " "; : LOCATE homex, homey RETURN 'sub - check for test warrior, create if necessary checktestwar: IF teststart = 0 AND testbirth = 0 GOTO gottestwar 'no need to ON ERROR GOTO notestwar OPEN testwar$ FOR INPUT AS #1: GOTO gottestwar notestwar: CLOSE #1: RESUME maketestwar maketestwar: ON ERROR GOTO initerror OPEN testwar$ FOR OUTPUT AS #1 PRINT #1, ";assert 1": FOR i = 1 TO testwarlen PRINT #1, testwarline$(i): NEXT i gottestwar: CLOSE #1: RETURN ----------------------- cut ------------------------ License Information ------------------- This software is distributed under the terms of the GNU General Public License published by the Free Software Foundation. I'm not going to reprint the legaleeze here, basically what it means is if it works, great, if it breaks your system, too bad (but email me and I'll try to help) and if you distribute it or modified copies you should include or make available the source code and a notice of these terms. If you wish to make money with it, you can't, you have to give it away. My apologies for my loose translation of the terms, the actual text of the license takes precedence.