I append here Ian Musgrave's post with QuickBasic source.
Article 315589 of talk.origins:
Path: news.tamu.edu!cs.utexas.edu!news.uh.edu!swrinde!howland.erols.net!newshub2.home.com!newshub1.home.com!news.home.com!news1.best.com!kerberos.ediacara.org!there.is.no.cabal
From: Ian.Musgrave@RemoveInsert.med.monash.edu.au (Ian Musgrave)
Newsgroups: talk.origins
Subject: Re: "Weasel" Cumulative Selection Demo
Date: 20 Jun 1997 01:21:36 -0400
Organization: Misfits of Reynella
Lines: 258
Approved: robomod@ediacara.org
Message-ID: <33a9fe84.9778627@newsserver.cc.monash.edu.au>
References: <5o77af$h6s@news.tamu.edu> <myers-ya02408000R1706972043480001@netnews.netaxs.com> <5o8hrn$cnt@news.tamu.edu> <myers-ya02408000R1806970910190001@cronkite.temple.edu> <5o8pjv$g5g@news.tamu.edu>
Reply-To: Reynella@RemoveInsert.werple.mira.net.au
NNTP-Posting-Host: kerberos.ediacara.org
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Keywords: dawkins weasle program
X-Newsreader: Forte Agent 1.01/16.397
Reply header altered to avoid spam, delete RemoveInsert
On 18 Jun 1997 09:58:32 -0400, welsberr@orca.tamu.edu (Wesley R.
Elsberry) wrote gracefully:
>In article <myers-ya02408000R1806970910190001@cronkite.temple.edu>,
>PZ Myers <myers@astro.ocis.temple.edu.NOSPAM> wrote:
>>In article <5o8hrn$cnt@news.tamu.edu>, welsberr@orca.tamu.edu (Wesley R.
>>Elsberry) wrote:
>WRE>However, it strikes me that you may be looking for something a bit
>WRE>different, since the source does rely a lot on visual component
>WRE>data structures in Delphi, which may not be very transparent to
>WRE>someone attempting a port. At this point, everything is small
>WRE>enough that producing a batch-oriented version for, say, Un*x in
>WRE>C would not be particularly difficult. So, the question goes,
>WRE>what *is* your preferred operating environment?
>
>PZM>Mac...and I have no experience with Delphi at all. Oh, well.
>
>If you know Pascal, then it shouldn't be too much of a stretch.
Despite an absymal knowledge of Pascal, the challenge was sufficent to
get me to de-lurk and produce something very like a weasle program ;-)
This "weasel" program is written in BASIC, it runs under QBASIC 1.1
(free with DOS 5.0 and above), QuickBasic 4.x for DOS, BASIC PDS 7.x
for DOS and QuickBasic 1.0 for MAC (this latter does NOT work on 32
bit MACS). It should be easily modifyable for most other basics. A
Perl version can be produced in mecessary.
It is different from Wesleys program in that you can only select the
string, and the number of "offspring". Also in this version ALL
offspring strings have one random mutation, so the dynamics are
different from Wesleys.
It is not well written at the moment (I should have made more use of
subroutines and eliminated the GOTO's but I can pretty it up later.
Word wrap on your broswser may mess up some of the lines, so you migh
have to manually concatenate some strings.
Have Fun
===============begin WEASLE2.BAS================================
'WEASLE2.BAS Copyright Ian Musgrave 1997, QB4.x, QBASIC 1.1, PDS 7.X"
'Program to use selection to generate a given string from nonsense
'Inspired by the Richard Dawkins program and the weasle program posted
'by Wesley Elseberry. The only things you can select are the target
'string and the number of offspring. One string is selected to
'"Breed" from out of the offspring. The string is
'duplicated with one random mutation per new string.
'
'Please feel free to improve this
DEFINT A-Z
DECLARE SUB Wait10 ()
DECLARE SUB Pause ()
DECLARE SUB CheckFit ()
COMMON SHARED Target$, TargLen, Diff, BestDiff, BestFit, OffSpring
'Initalize variables
Target$ = "methinks it is a weasle"
TargLen = LEN(Target$)
OffSpring = 10
DIM SHARED CharVals(1 TO TargLen)
DIM SHARED TestVals(1 TO TargLen)
DIM SHARED TestDiff(1 TO OffSpring)
DIM SHARED Test$(1 TO OffSpring)
RANDOMIZE TIMER
Menu:
CLS
PRINT "Program to use selection to generate a given string from
nonsense"
PRINT "Inspired by the Richard Dawkins program and the weasle program
posted"
PRINT "by Wesley Elseberry. The only things you can select are the
target"
PRINT "string and the number of offspring. One string is selected to"
PRINT CHR$(34); "Breed"; CHR$(34); "from out of the offspring. The
string is"
PRINT "duplicated with one random mutation per new string."
PRINT ""
PRINT "Current string is: "; Target$
PRINT "Current Offsprint number: "; OffSpring; " (max 100)"
PRINT ""
PRINT "1) Change target string"
PRINT "2) Change Offspring Number"
PRINT "3) Proceed with simulation"
PRINT ""
DO
Key$ = INKEY$
IF LEN(Key$) THEN
KeyVal = ASC(Key$)
ELSE
KeyVal = 0
END IF
SELECT CASE KeyVal
CASE 49
PRINT "Type new string, lowercase letters only, 40 characters maximum:
"
INPUT ; NewString$
IF NewString$ = "" THEN
PRINT "String empty, press any key to redo"
Pause
GOTO Menu
END IF
IF LEN(NewString$) > 40 THEN
Target$ = MID$(NewString$, 1, 40)
ELSE
Target$ = NewString$
END IF
TargLen = LEN(Target$)
GOTO Menu
CASE 50
INPUT "Type new offspring number, 100 maximum: ", NewNum
IF NewNum = 0 THEN PRINT "No offspring, redo": Pause: GOTO Menu
IF NewNum > 100 THEN
NewNum = 100
ELSE
OffSpring = NewNum
END IF
GOTO Menu
END SELECT
LOOP UNTIL KeyVal = 51
REDIM SHARED CharVals(1 TO TargLen)
REDIM SHARED TestVals(1 TO TargLen)
REDIM SHARED TestDiff(1 TO OffSpring)
REDIM SHARED Test$(1 TO OffSpring)
'Set up array of character values so we can test for
'differences from the target string
FOR J = 1 TO TargLen
CharVals(J) = ASC(MID$(Target$, J, 1))
NEXT
'Make First generation of random strings
FOR I = 1 TO OffSpring
DO UNTIL LEN(Test$(I)) = TargLen
Char$ = CHR$((INT(RND * 26) + 96))
IF Char$ = CHR$(96) THEN Char$ = CHR$(32)
Test$(I) = Test$(I) + Char$
LOOP
NEXT
'Initalise variables to test characters.
MaxDiff = 90 * TargLen
BestDiff = MaxDiff
CurrBestDiff = MaxDiff
BestFit = 0
'Pick closest string of the first generation, and breed from that
CALL CheckFit
Start:
CLS
LOCATE 5, 2: PRINT "Target:"; TAB(12); Target$; " Diff"; BestDiff; "
Generation: "; Gen
LOCATE 7, 2: PRINT "Current Best String is "; Test$(BestFit); " with
a difference of "; BestDiff
LOCATE 8, 2: PRINT "Previous Best String was "; Parent$; " with a
difference of "; CurrBestDiff
Wait10
Gen = Gen + 1
'Find the closest (ie fittest) string
IF CurrBestDiff < BestDiff THEN
Parent$ = Parent$
ELSE
CurrBestDiff = BestDiff
Parent$ = Test$(BestFit)
END IF
'Create Offspring
FOR I = 1 TO OffSpring
Site = (RND * TargLen) + 1
IF Site > TargLen THEN Site = TargLen
Char$ = CHR$((INT(RND * 26) + 96))
IF Char$ = CHR$(96) THEN Char$ = CHR$(32)
Test$(I) = Parent$
MID$(Test$(I), Site) = Char$
NEXT
'test Offsprings fitness
CALL CheckFit
'If string matches, halt, otherwise select best string and breed from
that
IF BestDiff = 0 THEN
LOCATE 5, 2: PRINT "Target:"; TAB(12); Target$; " Diff"; BestDiff; "
Generation: "; Gen
LOCATE 7, 2: PRINT "Current Best String is "; Test$(BestFit); "
with a difference of "; BestDiff
LOCATE 8, 2: PRINT "Previous Best String was "; Parent$; " with a
difference of "; CurrBestDiff
END
END IF
GOTO Start
SUB CheckFit
'Check for the best fit. The ASCII values for each
'character of the test string are subtracted from
'each corresponding character in the target string
'as the fit gets better the values converge to 0.
'this is probably a suboptimal way to do it.
BestDiff = 4000
FOR I = 1 TO OffSpring 'for each offspring
Diff = 0
FOR J = 1 TO TargLen
TestVals(J) = ASC(MID$(Test$(I), J, 1))
Diff = Diff + (ABS(CharVals(J) - TestVals(J)))
NEXT
TestDiff(I) = Diff
IF Diff < BestDiff THEN 'Find the best fit of this iteration
BestDiff = Diff
BestFit = I 'Keep string index
END IF
NEXT
END SUB
SUB Pause
DO
LOOP UNTIL LEN(INKEY$)
END SUB
SUB Wait10
'pauses for 0.05 seconds
Start# = TIMER
DO
Now# = TIMER
Count# = (Now# - Start#)
LOOP UNTIL Count# > .05
END SUB
================end WEASLE2.BAS================================
Enjoy
--------------------------------
Peta, Ian and Jack Francis
reynella at werple dot mira dot net dot au
Aitch Tee Tee Pee colon slash slash werple dot mira dot net dot au slash tilde reynella
Terry Pratchet fans, tree planters and sometime scientists