diff --git a/Examples/Regression/test1.csv b/Examples/Regression/test1.csv new file mode 100644 --- /dev/null +++ b/Examples/Regression/test1.csv @@ -0,0 +1,16 @@ +a,y +-3.7438660654452747,-66.09733622782144 +-2.7182309524462624,-27.179607724815707 +-1.3113335433493276,-3.872386021392077 +-0.8908615033854232,-1.0338527633560117 +0.30864747123329295,0.23582966844187134 +0.9766536818516052,0.02267576938240401 +1.10577496836002,-0.20713956068088413 +1.701605297004015,2.4618209247991887 +1.9944192912592449,3.9981711228094454 +2.5436349987678284,10.032973222574228 +3.974401503289897,47.20698473869758 +4.03652924593575,49.64182181261254 +6.915181689963077,282.6937057201347 +7.510440074553447,367.3489344243017 +9.560294762868352,782.8018308835866 diff --git a/Examples/Regression/test1.in b/Examples/Regression/test1.in new file mode 100644 --- /dev/null +++ b/Examples/Regression/test1.in @@ -0,0 +1,27 @@ +rateMutate = 0.105 +rate1R = 0.3 +rate2R = 0.3 +rateGR = 0.2 +rateIS = 0.3 +rateRIS = 0.2 +rateGT = 0.4 + +genomeTerminals = a1 +genomeNonterminals = +/*- +genomeMaxArity = 2 +genomeNumGenes = 3 +genomeHeadLength = 12 +genomeGeneConnector = * + +maxISLen = 5 +maxRISLen = 5 + +populationSize = 30 + +rouletteExponent = 1.10 + +maxFitness = 15000.0 + +numGenerations = 500 + +selectionRange = 1000.0 diff --git a/Examples/Regression/test2.csv b/Examples/Regression/test2.csv new file mode 100644 --- /dev/null +++ b/Examples/Regression/test2.csv @@ -0,0 +1,14 @@ +a,y +-4.271398191440724,-1032.2436261876069 +-2.5413595175500596,-23.7672998229445 +-2.043723676188776,6.566985619973131 +-1.5870068083576072,10.041751536181923 +-1.3411569693674235,7.5247650436481575 +-0.7751341152005793,1.9951266023533076 +-0.6916313722428153,1.4564553307423131 +1.0028570632996416,-3.6824341198990647 +1.0592788484233289,-4.277236050174281 +1.083897470722917,-4.897509955917283 +1.0971924626343466,-4.665386752684195 +1.633671819252653,-9.705139593014213 +2.4800622898663054,17.564630974749306 diff --git a/Examples/Regression/test2.in b/Examples/Regression/test2.in new file mode 100644 --- /dev/null +++ b/Examples/Regression/test2.in @@ -0,0 +1,27 @@ +rateMutate = 0.055 +rate1R = 0.3 +rate2R = 0.3 +rateGR = 0.2 +rateIS = 0.3 +rateRIS = 0.2 +rateGT = 0.4 + +genomeTerminals = a1 +genomeNonterminals = +/*- +genomeMaxArity = 2 +genomeNumGenes = 1 +genomeHeadLength = 15 +genomeGeneConnector = + + +maxISLen = 4 +maxRISLen = 4 + +populationSize = 30 + +rouletteExponent = 1.25 + +maxFitness = 13000.0 + +numGenerations = 1000 + +selectionRange = 1000.0 diff --git a/Examples/Regression/test3.csv b/Examples/Regression/test3.csv new file mode 100644 --- /dev/null +++ b/Examples/Regression/test3.csv @@ -0,0 +1,21 @@ +a,y +-1.8896922309246262,28.64110750383876 +-1.8811555048439734,27.895712008888534 +-1.4508365684545979,14.937428308492514 +-0.9996036794068095,6.6535735964920075 +-0.9875374941854806,6.625423696051809 +-0.5027867246783915,2.8985158751064306 +-0.4070899617557915,2.1961086113898807 +-0.29975622903884336,2.290627822906094 +-0.175138446768905,2.3134028050496624 +-0.0928258512975848,1.5786320938475755 +-0.007173088900153779,1.6449353869900236 +0.4262405899926014,2.2871617094703893 +0.607988973447223,2.239637944127404 +0.8220166642008158,1.7848873336481021 +0.9363908841757942,1.7756447429905156 +1.3803226260330694,-1.370483156231777 +1.5010418624427375,-3.3303516801706428 +1.5707922669916048,-4.386252446139438 +1.753102299062812,-7.293760890713594 +1.8192611179940936,-8.84774101934889 diff --git a/Examples/Regression/test3.in b/Examples/Regression/test3.in new file mode 100644 --- /dev/null +++ b/Examples/Regression/test3.in @@ -0,0 +1,27 @@ +rateMutate = 0.055 +rate1R = 0.3 +rate2R = 0.3 +rateGR = 0.2 +rateIS = 0.3 +rateRIS = 0.2 +rateGT = 0.4 + +genomeTerminals = a +genomeNonterminals = +/*- +genomeMaxArity = 2 +genomeNumGenes = 5 +genomeHeadLength = 27 +genomeGeneConnector = + + +maxISLen = 4 +maxRISLen = 4 + +populationSize = 30 + +rouletteExponent = 1.25 + +maxFitness = 20000.0 + +numGenerations = 100 + +selectionRange = 1000.0 diff --git a/Examples/Regression/test4.csv b/Examples/Regression/test4.csv new file mode 100644 --- /dev/null +++ b/Examples/Regression/test4.csv @@ -0,0 +1,201 @@ +a,y +-9.92436518914499,-0.04827142567430991 +-9.892108431309406,-0.04554181849124436 +-9.737023786845572,-0.031549336595843185 +-9.73504652098557,-0.031362396028669255 +-9.728413391750166,-0.030733819996383124 +-9.413333941920264,0.0012156977672262534 +-9.407080412760788,0.0018812026075159603 +-9.397127886456097,0.002942021389841638 +-9.370061741486708,0.005836559322554946 +-9.180270072646803,0.026369472512399354 +-9.126762299764831,0.032171749958215944 +-9.06532783475566,0.038802739530076576 +-9.051911236668552,0.04024417144125716 +-8.968053193383273,0.04917577329131689 +-8.92741819404182,0.05344286973572366 +-8.911315233282863,0.05512052684064859 +-8.629861915939582,0.08271335240881934 +-8.540936808344341,0.09052643743717079 +-8.171803783902334,0.11624339868429981 +-8.159236006262773,0.11689458850251086 +-8.096942007505305,0.11987612485162326 +-8.056256274955945,0.12159644727881706 +-8.007260605423753,0.12342245478028961 +-7.897427404037678,0.12650402844617364 +-7.80138129923948,0.12800514204140245 +-7.63867252154434,0.12789007467400781 +-7.606926569853325,0.1274676177079961 +-7.465496991431259,0.12396818592398776 +-7.362334511486633,0.11973871632859182 +-7.36075401421504,0.11966291255899804 +-7.2457986812299,0.11326392403715083 +-6.969067542723167,0.09088102265285893 +-6.933353268946391,0.0873055338967636 +-6.882868027708543,0.08199787946824372 +-6.875355032007782,0.08118309846260967 +-6.660051022160907,0.05525602602552739 +-6.639725704987647,0.05256757829814684 +-6.4648295517945975,0.027943043035661034 +-6.45741294389822,0.026844731879894338 +-6.440743444333968,0.024361638025168435 +-6.3806134790482005,0.015245259710561126 +-6.323588064532174,0.006387475861775942 +-6.174017991460268,-0.017646630023908323 +-5.87133718906092,-0.06817928880699625 +-5.6999765446095765,-0.09661533107205716 +-5.529972782683341,-0.12368701147627664 +-5.438855871357134,-0.1374417501222207 +-5.333621209045667,-0.15245962150357123 +-5.278876822604815,-0.15984291355799732 +-5.193641221571479,-0.17067331584132164 +-5.142742935456603,-0.17671856256663235 +-5.097670914296902,-0.18178743362675912 +-4.994496551995226,-0.19230584203803067 +-4.861991497337073,-0.20337970551594922 +-4.8031798985562055,-0.2073379211199429 +-4.625772094551856,-0.21536969005337755 +-4.512382997801112,-0.21719463745551154 +-4.457574359736757,-0.2170934149506262 +-4.18720829226195,-0.20663728763144237 +-4.142798595932714,-0.20327368726809456 +-4.140860670780793,-0.20311605105406452 +-4.110441076901282,-0.20052207666951005 +-4.074132626440349,-0.19713050829863843 +-4.070927307369345,-0.19681559910179666 +-4.015341766184136,-0.19095288314196213 +-3.9889584515129606,-0.18790350431438105 +-3.9664622164821566,-0.18516734230775495 +-3.9103596026718925,-0.17779681663023367 +-3.864622560800562,-0.17120935692727698 +-3.8382148547341863,-0.16716899867880614 +-3.7535579812977247,-0.15304871605351728 +-3.7167435352521423,-0.1463543013025259 +-3.606003713598561,-0.12420850115994178 +-3.5243084230325614,-0.10596153704053425 +-3.440352823334898,-0.08555387771622452 +-3.4240288980390368,-0.08139422896225305 +-3.3589482012441962,-0.06420109385923276 +-3.358384182494177,-0.06404787384289065 +-2.7095064621632687,0.1545544091901658 +-2.322997192024552,0.314329653719055 +-2.320763842805597,0.31528887055969795 +-2.0929005521363706,0.414148541619928 +-2.0915319728744954,0.4147454727990226 +-1.2183660815247102,0.7703239839941323 +-1.2016322985009218,0.7761353628943246 +-0.819056923002563,0.8918819889564741 +-0.38414562886683257,0.9755861886350284 +-0.2057155962278081,0.9929617579649572 +-0.16047959016283642,0.995713240577317 +-0.10365802225243925,0.9982101309469716 +0.11905122069389762,0.9976394745721257 +0.19402596524952287,0.9937374537792565 +0.29547031926773215,0.9855129312338212 +0.30752214508041575,0.9843127162893716 +0.36930277667586253,0.9774237469897258 +0.41969151623423073,0.9709006372197799 +0.4444549209732429,0.9674002962860803 +0.5839363283902159,0.9441308023468729 +0.6321346613886263,0.934719001417312 +0.8714321166498635,0.878154023842011 +1.0392089537782496,0.8294804530915295 +1.0941742025244672,0.8120733335802369 +1.175638218372086,0.7850507894247336 +1.216941135958848,0.7708210127967214 +1.3250191879588016,0.7320260271786845 +1.3784077481538901,0.7120899684590205 +1.4972351403110835,0.666091496864835 +1.5665326493204574,0.6383466766394881 +1.6001882255994282,0.6246565705497726 +1.8019255348100032,0.5402045320089811 +1.8922375210656313,0.5014069694484782 +1.9725259388727459,0.46660277354485596 +2.0619093165414313,0.42766600032450386 +2.197643459748811,0.36852246464768307 +2.4288982378757638,0.2692063151899796 +2.512476917906241,0.2342031537151097 +2.6486541998751676,0.17866301569971366 +2.798671086502729,0.12014273045466212 +2.801877034204793,0.11892705262937536 +2.995950446208134,0.04844134456594448 +3.0380100011753157,0.034034622123031655 +3.1049078495532783,0.011812452452553393 +3.1747717731435756,-0.010448950254797222 +3.2197977834773184,-0.024264081742990082 +3.272851609485251,-0.039990316661263216 +3.3543028631642713,-0.06293701206160675 +3.4634394126628365,-0.09133089817205615 +3.556882482744342,-0.11342942669445208 +3.5603855180065906,-0.11421738798529316 +3.571117742234307,-0.11661309072882435 +3.6040846515548566,-0.12379833725387301 +3.7346911069055224,-0.14965976115572305 +3.8424452235597926,-0.16782790566599126 +3.875662188520124,-0.17284700917242263 +3.8921384081421735,-0.17523477058150203 +3.9049533064595323,-0.17704525973967283 +3.905606885257683,-0.1771365031447534 +4.023181427331053,-0.19182584943530198 +4.071496814470848,-0.19687173485469311 +4.102794010003102,-0.19983454614044008 +4.1672515096829486,-0.20518464350305837 +4.224026843581598,-0.2090664970460924 +4.426100862147486,-0.2167367446961122 +4.4720314736841615,-0.21718383204896374 +4.7056623351300715,-0.21250512786304182 +4.7765635515873015,-0.20892457685105162 +5.017412828690631,-0.1901059018621527 +5.204744308477622,-0.16931128248188537 +5.569096326671662,-0.11760063063151889 +5.570997619036284,-0.11730237810885435 +5.721526935338851,-0.09308538382859366 +5.759635033580594,-0.08680376317830038 +5.958494745689606,-0.05353961773254879 +6.011693991576422,-0.04460779715321305 +6.1924968475984485,-0.014624827960987487 +6.225118260994563,-0.009322621303563127 +6.349579435667586,0.01044878016919672 +6.396988924017435,0.017751809032711462 +6.429206089830586,0.02263147621705392 +6.44445756079179,0.024916616999877645 +6.6107218849369005,0.048665115759083874 +6.629298712759912,0.05117347712998996 +6.639982397783456,0.05260177178523779 +6.656188593466311,0.054748124656489684 +6.740236036458704,0.0654730006844618 +6.953910352154537,0.08938195896229431 +6.975981444009278,0.091555748188541 +7.166702494126049,0.10785644965053523 +7.22948955687739,0.11221541891814661 +7.349068851515952,0.11909218504769035 +7.496383787447421,0.12495896234459097 +7.726395645122899,0.12837446955816392 +7.769028731868019,0.1282520256119115 +7.798691207018756,0.1280306973558057 +7.974891819334282,0.12447808532322459 +8.036388585949993,0.12236963372212378 +8.06735661668612,0.12114523304336669 +8.109968990117828,0.11928698730908201 +8.11326890702641,0.11913483602963451 +8.116917819204453,0.11896522779931272 +8.20742102179566,0.1143096958278718 +8.3141455424091,0.10776570052564975 +8.369907668851695,0.10392423419391172 +8.374029200873984,0.10362939068301068 +8.419046041796484,0.10031470424465776 +8.627736835516409,0.08290603891303629 +8.660802465175216,0.07987684497184856 +8.753715814861984,0.07103476771715511 +9.03271752123699,0.042301037870321655 +9.267163246615802,0.016937538724270482 +9.309477734847661,0.012357828157417698 +9.33873804115185,0.009201864481115018 +9.442716625810988,-0.0018996337251612969 +9.496939873264267,-0.007591845493369206 +9.564941443254384,-0.014605943651546532 +9.689123991644351,-0.026966119095529803 +9.746267608692207,-0.03242064042655879 +9.907636425492171,-0.046864126749139784 +9.96212745109834,-0.05138067402964015 +9.981797782797052,-0.05296229028981533 diff --git a/Examples/Regression/test4.in b/Examples/Regression/test4.in new file mode 100644 --- /dev/null +++ b/Examples/Regression/test4.in @@ -0,0 +1,27 @@ +rateMutate = 0.055 +rate1R = 0.3 +rate2R = 0.3 +rateGR = 0.2 +rateIS = 0.3 +rateRIS = 0.2 +rateGT = 0.4 + +genomeTerminals = a +genomeNonterminals = +-/* +genomeMaxArity = 2 +genomeNumGenes = 5 +genomeHeadLength = 15 +genomeGeneConnector = + + +maxISLen = 4 +maxRISLen = 4 + +populationSize = 60 + +rouletteExponent = 1.25 + +maxFitness = 200000.0 + +numGenerations = 100 + +selectionRange = 1000.0 diff --git a/Examples/Regression/test5.csv b/Examples/Regression/test5.csv new file mode 100644 --- /dev/null +++ b/Examples/Regression/test5.csv @@ -0,0 +1,76 @@ +a,y +-3.2023449699825584,9.038216548974829 +-3.129574041062053,8.624207208295626 +-3.0920541818001794,8.603392138880373 +-2.7840724988386114,7.526643002389225 +-2.648699408637352,6.089428664770707 +-2.4096442105189126,5.156248476082049 +-2.2750220758858113,5.259895239749692 +-2.086447321121348,3.982433973488761 +-1.8793287281951478,2.803216684179565 +-1.828982940612967,2.652067559525717 +-1.5540407765943627,1.9657180330899322 +-1.3072304151093412,1.4142587729394198 +-0.7807234186208021,0.6769439856648136 +-0.6387363936167425,0.16367012299123385 +-0.541241533409309,0.7790024411524569 +-0.5072954419239721,0.30877962993395425 +-0.2619191758209638,-0.07657558945263034 +-0.08368305061632242,0.14430151843012 +0.0000394905883354113,0.2997214778055629 +0.38019613811832187,0.3916388690804494 +0.39717524219302547,0.40052703799530964 +1.6654508544722049,2.602720201327579 +2.124716248349003,5.2393323263713665 +2.266838922092166,5.873224353160797 +2.6911449293091962,8.293558937817908 +2.9990150188673006,9.989216986483452 +3.0932959741800445,10.17590511543377 +3.2060433833790114,10.97858877711241 +3.2085960873076402,11.442582759580194 +3.678380781400776,15.265705483358005 +4.3510798565868996,21.21718659557844 +4.392827310695303,21.868755349010673 +4.51764594060694,22.48309785757076 +4.628270024739656,24.426175681350717 +4.833875680218867,26.17275891649361 +4.8428794594462055,25.71818408158858 +4.958874637561745,27.747946700411507 +5.193982119280257,29.7051619535712 +5.271783138517005,31.490947730460285 +5.577349421565135,34.866202092108864 +5.947853075014681,38.93335223094319 +6.012000944765614,39.53335252543539 +6.116981508411548,40.78199510147485 +6.1464761450113095,41.86678344420952 +6.894454354855711,51.13212713860577 +7.610817470989712,60.02506315818497 +7.7359864213986,61.84059322221353 +7.747162878444193,62.26177028609347 +8.372346149068477,69.20983671721322 +8.501166684654823,71.34437119284829 +8.704915320246585,73.55671467695066 +9.064477117678848,76.10246307850005 +9.625515008792,80.83101857456619 +9.693344113335204,80.98038620087347 +9.906115252187323,82.2787700884214 +10.263012205220733,83.61460746796762 +10.815751093717509,83.55426937361555 +10.903647944696274,83.27052709990804 +10.949186794355874,83.69243747817748 +11.141545162389527,82.53449517434335 +11.419102082093772,80.10049162519917 +11.665283897438798,77.62939854764628 +11.827302079307039,75.86331521943514 +11.981544548005942,73.5770966799671 +12.159216526626594,70.85848268458926 +12.254925136553581,68.47871767746437 +12.900006386041674,52.419790363315066 +13.241561157633,41.170487656250984 +13.295166625977807,38.95363724609544 +13.326941116999578,36.971994762945194 +13.573523215160712,26.935589714151977 +13.640616891327923,24.272359297327448 +14.007229944541933,5.340757291302113 +14.788600441394742,-44.64452713469935 +14.825370816654143,-47.80574586928097 diff --git a/Examples/Regression/test5.in b/Examples/Regression/test5.in new file mode 100644 --- /dev/null +++ b/Examples/Regression/test5.in @@ -0,0 +1,27 @@ +rateMutate = 0.075 +rate1R = 0.3 +rate2R = 0.3 +rateGR = 0.075 +rateIS = 0.3 +rateRIS = 0.2 +rateGT = 0.25 + +genomeTerminals = a +genomeNonterminals = +-/* +genomeMaxArity = 2 +genomeNumGenes = 3 +genomeHeadLength = 30 +genomeGeneConnector = + + +maxISLen = 3 +maxRISLen = 4 + +populationSize = 150 + +rouletteExponent = 1.10 + +maxFitness = 75000.0 + +numGenerations = 200 + +selectionRange = 1000.0 diff --git a/GEP/Examples/Regression/ArithmeticIndividual.hs b/GEP/Examples/Regression/ArithmeticIndividual.hs new file mode 100644 --- /dev/null +++ b/GEP/Examples/Regression/ArithmeticIndividual.hs @@ -0,0 +1,218 @@ +{-| + Code for individuals representing arithmetic expressions. This is used + most frequently for regression applications. + + Author: mjsottile\@computer.org +-} +module GEP.Examples.Regression.ArithmeticIndividual( + express_individual, + evaluate, + fitness_evaluate_absolute, + fitness_evaluate_relative, + evaluate_nodes, + infixWalker, + aiToGraphviz, + dumpDotFile +) where + +import GEP.Types +import Maybe +import IO + +data BinOperator = Plus | Minus | Divide | Times | Exp + deriving Show + +data UnOperator = Sqrt + deriving Show + +data AINode = BinOp BinOperator AINode AINode + | UnOp UnOperator AINode + | GeneConnector AINode + | Terminal Char + deriving Show + +-- +-- dump an expressed individual to a file as a graphviz dot file +-- +dumpDotFile :: Maybe String -> AINode -> IO () +dumpDotFile Nothing _ = return () +dumpDotFile (Just fname) n = do + fh <- openFile fname WriteMode + hPutStrLn fh "digraph HSGEP_Regression {" + mapM (hPutStrLn fh) (aiToGraphviz n) + hPutStrLn fh "}" + hClose fh + +-- Node, parent ID, (kidsstring,maxkidid) +arithToGraphviz :: AINode -> Int -> Bool -> ([String],Int) +arithToGraphviz (Terminal c) i _ = + ([" "++ident++" [label=\""++lbl++"\"];"], i') + where + i' = i+1 + ident = "l"++(show i') + lbl = (show c) + +arithToGraphviz (UnOp Sqrt kidNodes) i isGC = + ([" "++ident++" [label=\""++lbl++"\""++special++"];", + " "++ident++" -> "++kidIdent++";"]++kids, kidID) + where + special = if isGC then ", color=red" else "" + i' = i+1 + (kids,kidID) = arithToGraphviz kidNodes i' False + ident = "l"++(show i') + kidIdent = "l"++(show (i'+1)) + lbl = "Q" + +arithToGraphviz (BinOp bop lKids rKids) i isGC = + ([" "++ident++" [label=\""++ops++"\""++special++"];", + " "++ident++" -> "++lkidIdent++";", + " "++ident++" -> "++rkidIdent++";"]++lkidlist++rkidlist, rkidID) + where + special = if isGC then ", color=red" else "" + i' = i+1 + ident = "l"++(show i') + lkidIdent = "l"++(show (i'+1)) + (lkidlist,lkidID) = arithToGraphviz lKids i' False + rkidIdent = "l"++(show (lkidID+1)) + (rkidlist,rkidID) = arithToGraphviz rKids lkidID False + ops = case bop of + Minus -> "-" + Plus -> "+" + Divide -> "/" + Times -> "*" + Exp -> "^" + +arithToGraphviz (GeneConnector g) i _ = arithToGraphviz g i True + +aiToGraphviz :: AINode -> [String] +aiToGraphviz n = ss + where + (ss,_) = arithToGraphviz n 0 False + +type AISymTable = SymTable Double + +{-| + Return the arity of a character representing a terminal or nonterminal. + + TODO: This should be made part of the genome, and the arity of each + symbol should be specified with the symbols in the input file. +-} +arity :: Char -> Int +arity 'Q' = 1 +arity '-' = 2 +arity '+' = 2 +arity '*' = 2 +arity '/' = 2 +arity '^' = 2 +arity _ = 0 + +levelize :: [Char] -> Int -> [[Char]] +levelize _ 0 = [] +levelize [] _ = [] +levelize s i = + [front]++(levelize back (foldr (+) 0 (map arity front))) + where + (front,back) = splitAt i s + +infixWalker :: AINode -> String +infixWalker (Terminal c) = [c] +infixWalker (UnOp Sqrt e) = "sqrt("++(infixWalker e)++")" +infixWalker (GeneConnector g) = infixWalker g +infixWalker (BinOp op a b) = "("++as++ops++bs++")" + where + as = infixWalker a + bs = infixWalker b + ops = case op of + Minus -> "-" + Plus -> "+" + Divide -> "/" + Times -> "*" + Exp -> "^" + +express :: Char -> [AINode] -> AINode +express c kids = + case c of + 'Q' -> UnOp Sqrt lhs + '-' -> BinOp Minus lhs rhs + '+' -> BinOp Plus lhs rhs + '*' -> BinOp Times lhs rhs + '/' -> BinOp Divide lhs rhs + '^' -> BinOp Exp lhs rhs + _ -> Terminal c + where + lhs = head kids + rhs = head (tail kids) + +lvlAssemble :: [Char] -> [AINode] -> [AINode] +lvlAssemble [] _ = [] +lvlAssemble (c:cs) kids = + [express c cneed]++(lvlAssemble cs csneed) + where + ac = arity c + (cneed,csneed) = splitAt ac kids + +assemble :: [[Char]] -> [AINode] +assemble [] = [] +assemble (c:[]) = (map (\x -> Terminal x) c) +assemble (c:cs) = lvlAssemble c (assemble cs) + +express_individual :: Individual -> Genome -> AINode +express_individual chrom g = + connect_genes g ets + where + genes = chromToGenes chrom (geneLength g) + ets = map (\i -> head (assemble (levelize i 1))) genes + +connect_genes :: Genome -> [AINode] -> AINode +connect_genes g x | length x == 1 = head x +connect_genes g x | otherwise = connect_genes g (xh':ys) + where + c = geneConnector g + xh = head x + xs = tail x + y = head xs + ys = tail xs + xh' = GeneConnector (express c [xh,y]) + +lookup_sym :: Char -> AISymTable -> Maybe Double +lookup_sym _ [] = Nothing +lookup_sym '1' _ = Just 1.0 +lookup_sym sym ((c,x):syms) = + if sym==c + then + Just x + else + (lookup_sym sym syms) + +evaluate :: AINode -> AISymTable -> Double +evaluate node syms = + case node of + (GeneConnector g) -> evaluate g syms + (BinOp op a b) -> + let ea = evaluate a syms in + let eb = evaluate b syms + in + case op of + Plus -> ea + eb + Minus -> ea - eb + Times -> ea * eb + Divide -> ea / eb + Exp -> ea ** eb + (UnOp Sqrt a) -> sqrt(evaluate a syms) + (Terminal x) -> fromJust (lookup_sym x syms) + +evaluate_nodes :: [AINode] -> AISymTable -> [Double] +evaluate_nodes nodes syms = + map (\x -> evaluate x syms) nodes + +fitness_evaluate_absolute :: AINode -> AISymTable -> Double -> Double -> Double +fitness_evaluate_absolute node syms target selection_range = + selection_range - (abs (c - target)) + where + c = evaluate node syms + +fitness_evaluate_relative :: AINode -> AISymTable -> Double -> Double -> Double +fitness_evaluate_relative node syms target selection_range = + selection_range - (abs ( ( (c - target) / target ) * 100.0 ) ) + where + c = evaluate node syms diff --git a/GEP/Examples/Regression/Driver.hs b/GEP/Examples/Regression/Driver.hs new file mode 100644 --- /dev/null +++ b/GEP/Examples/Regression/Driver.hs @@ -0,0 +1,77 @@ +-- | +-- Haskell gene expression programming, regression example +-- +-- Author: mjsottile\@computer.org +-- +module Main ( + main +) where + +import GEP.Params +import GEP.GenericDriver +import GEP.Util.ConfigurationReader +import GEP.Examples.Regression.ArithmeticIndividual +import GEP.Examples.Regression.FitnessInput +import GEP.Examples.Regression.MaximaClient +import System.Environment (getArgs) +import System.Exit + +-- +-- sanity check arguments to see if we have enough +-- +validateArgs :: [String] -> IO () +validateArgs s = do + if (length s < 2) then do putStrLn "Must specify config file and fitness test data file names." + exitFailure + else do return () + +-- +-- currently this is here to shut up whining tools who just really +-- need a main nearby to make them feel good. that means you haddock. +-- you're not even a linker - get over the lack of main already... +-- +main :: IO () +main = do + -- read in parameters from specified file + args <- getArgs + + -- sanity check + validateArgs args + + -- give args nice names + configFile <- return $ head args + fitnessFile <- return $ head (tail args) + + -- if optional third argument is present, assume it is dot file + dotfile <- if ((length args) == 3) then return $ Just $head (tail (tail args)) + else return $ Nothing + + -- read parameters + (rs,gnome,params) <- readParameters configFile + + -- read fitness test data + (testDict, ys) <- readFitnessInput fitnessFile + + -- call generic driver + (best,pop) <- gepDriver params rs gnome testDict ys fitness_evaluate_absolute express_individual + + -- Express best individual + bestExpressed <- return $ express_individual (head pop) gnome + + -- Flatten best individual via infix walk + bestString <- return $ infixWalker bestExpressed + + -- report status + putStrLn "-------------------------------------------------" + putStrLn $ "DONE : "++(show best) + putStrLn $ "INFIX : "++bestString + + putStrLn $ "MAXIMA OUTPUT :" + -- send flattened individual to maxima for pretty printing + maxOut <- maximaExpand bestString "qubu.net" 12777 + + -- print lines that come back + mapM putStrLn maxOut + + -- dump to dot file if one was specified + dumpDotFile dotfile bestExpressed diff --git a/GEP/Examples/Regression/FitnessInput.hs b/GEP/Examples/Regression/FitnessInput.hs new file mode 100644 --- /dev/null +++ b/GEP/Examples/Regression/FitnessInput.hs @@ -0,0 +1,68 @@ +{-| + + Code to read input data files containing the test inputs and test outputs + used to evaluate the fitness of individuals. + + Author: mjsottile\@computer.org + + NOTE: Parsec code for CSV files + +-} +module GEP.Examples.Regression.FitnessInput ( + readFitnessInput +) where + +import Text.ParserCombinators.Parsec +import System.Exit + +-- +-- assume files have CSV format with a header row where each entry in the +-- header row names a variable. note that currently we require these to +-- be single characters. eventually we may automate the process of mapping +-- variables onto characters in the genome to allow more expressive names +-- to be associated with variables. +-- + +-- PARSEC STUFF + +csvfile = many csvline + +csvline = do + entries <- (sepBy entry (char ',')) + newline + return entries + +-- entry accepts any string containing alphanum or periods, with spaces either +-- before or after the value. +entry = do + many (char ' ') + body <- many (noneOf ",\n") + many (char ' ') + return body + +-- END PARSEC STUFF + +type FitnessDict = [[(Char,Double)]] + +dictify :: [String] -> [[String]] -> (FitnessDict, [Double]) +dictify lbls values = + (map (\j -> zip (init charLbls) j) (init floatValues), + map last floatValues) + where + charLbls = map head lbls + floatValues = map (\j -> map (\i -> (read i) :: Double) j) values + +-- function that takes a filename and returns a dictionary +readFitnessInput :: String -> IO (FitnessDict,[Double]) +readFitnessInput fname = do + result <- parseFromFile csvfile fname + case result of Left err -> do putStrLn "Bad regression fitness input!" + exitFailure + Right xs -> do return $ dictify (head xs) (tail xs) + +{- +main :: IO () +main = do + x <- readFitnessInput "test.csv" + print x +-} diff --git a/GEP/Fitness.hs b/GEP/Fitness.hs new file mode 100644 --- /dev/null +++ b/GEP/Fitness.hs @@ -0,0 +1,70 @@ +-- | This module contains code related to fitness evaluation. The +-- main purpose of the code is to both evaluate fitnesses of individuals +-- and to sort individuals by fitness. These are intended to all be +-- higher order functions that assume nothing about the purpose of the +-- individuals or the types of inputs being used for fitness testing. +-- The only assumption made currently is that the outputs for test cases +-- are floating point numbers. That likely should change for general +-- purpose usage. +-- +-- mjsottile\@computer.org +-- +module GEP.Fitness ( + fitness_tester, + fitness_filter, + sortByFitness +) where + +import GEP.Types + +-- +-- Sort a list of pairs by first element of each pair. Disregard duplicates +-- pairs. +-- +pairSort :: (Ord a) => [(a,b)] -> [(a,b)] +pairSort [] = [] +pairSort ((f,i):rest) = + lhs++((f,i):rhs) + where + lhs = [(ff,ii) | (ff,ii) <- rest, ff < f] + rhs = [(ff,ii) | (ff,ii) <- rest, ff >= f] + +-- | +-- Fitness evaluator for generic individuals. This needs to go away +-- and use a more general approach like evaluateFitness above. +-- +fitness_tester :: a -- ^ Expressed individual + -> (a -> b -> Double -> Double -> Double) -- ^ Fitness function + -> [b] -- ^ List of symbol tables for test cases + -> [Double] -- ^ List of expected outputs for test cases + -> Double -- ^ Range of selection. M in original + -- GEP paper equations for fitness. + -> Double -- ^ Fitness value for given individual +fitness_tester who ffun inputDict outputs m = + foldr (+) 0.0 tests + where + tests = map (\(x,y) -> ffun who x y m) + (zip inputDict outputs) + +-- | +-- Given a list of fitness values and a corresponding list of individuals, +-- return a list of tuples pairing the fitness value with the individuals for +-- only those individuals that have a valid fitness value. This means those +-- that are +/- infinity or NaN are removed. +-- +fitness_filter :: [Double] -- ^ Fitness values + -> [Individual] -- ^ Individuals + -> [(Double,Individual)] -- ^ Paired fitness/individuals after + -- filtering +fitness_filter fitnesses pop = + foldr (\(i,j) -> + \x -> if ((isNaN i) || (isInfinite i)) + then x + else ((i,j):x) + ) [] (zip fitnesses pop) + +-- | +-- Sort a set of individuals with fitness values by their fitness +-- +sortByFitness :: [(Double,Individual)] -> [(Double,Individual)] +sortByFitness xs = reverse (pairSort xs) diff --git a/GEP/GeneOperations.hs b/GEP/GeneOperations.hs new file mode 100644 --- /dev/null +++ b/GEP/GeneOperations.hs @@ -0,0 +1,165 @@ +-- | +-- Operations on the chromosomes of individuals. The following assumptions +-- are made. +-- +-- * Symbols are numbered 1 through n for a chromosome of length n. +-- +-- * Genes are numbered 0 through m-1 for a chromosome with m genes. +-- +-- The functions provided in this module are purely functional. See +-- "GEP.MonadicGeneOperations" for code that invokes these from within the +-- "GEP.Rmonad" monad. +-- + +module GEP.GeneOperations ( + crossover1pt, + crossover2pt, + crossoverGene, + transposeGene, + transposeIS, + transposeRIS +) where + +import GEP.Types + +-- | +-- One-point crossover +crossover1pt :: ([Symbol], [Symbol]) -- ^ Pair of individuals before crossover + -> Int -- ^ Crossover point + -> ([Symbol],[Symbol]) -- ^ Pair of individuals after crossover +crossover1pt (x,y) loc = (x', y') + where + (fx, bx) = splitAt (loc-1) x + (fy, by) = splitAt (loc-1) y + x' = fx++by + y' = fy++bx + +-- +-- helper to split a list into three parts. +-- +splitThirds :: [a] -> Int -> Int -> ([a],[a],[a]) +splitThirds x l1 l2 = (fx,mx,bx) + where + (fx,tmp) = splitAt l1 x + (mx,bx) = splitAt (l2-l1) tmp + +-- | +-- Two-point crossover +crossover2pt :: ([Symbol], [Symbol]) -- ^ Pair of individuals before crossover + -> Int -- ^ Crossover point 1 + -> Int -- ^ Crossover point 2 + -> ([Symbol],[Symbol]) -- ^ Pair of individuals after crossover +crossover2pt (x,y) loc1 loc2 = (x',y') + where + -- make sure we know which location is lower than the other + minLoc = min loc1 loc2 + maxLoc = max loc1 loc2 + (fx,mx,bx) = splitThirds x (minLoc-1) (maxLoc-1) + (fy,my,by) = splitThirds y (minLoc-1) (maxLoc-1) + x' = fx++my++bx + y' = fy++mx++by + +-- +-- Helper to extract a gene from a sequence and return the sequence +-- before the gene, the gene itself, and the sequence after the gene. +-- +geneExtract :: [Symbol] -> Int -> Int -> ([Symbol],[Symbol],[Symbol]) +geneExtract x gene geneLen = (before, theGene, after) + where + geneStart = geneLen * gene + geneEnd = geneStart + geneLen + (before,theGene,after) = splitThirds x geneStart geneEnd + +-- | +-- Gene crossover +crossoverGene :: ([Symbol], [Symbol]) -- ^ Pair of individuals before crossover + -> Int -- ^ Gene number for crossover + -> Int -- ^ Gene length in symbols + -> ([Symbol], [Symbol]) -- ^ Pair of individuals after crossover +crossoverGene (x,y) gene geneLen = (x',y') + where + (fx,mx,bx) = geneExtract x gene geneLen + (fy,my,by) = geneExtract y gene geneLen + x' = fx++my++bx + y' = fy++mx++by + +-- +-- Find a root insertion sequence within a sequence. This means looking +-- for the first subsequence that starts with a nonterminal. If no such +-- subsequence exists, return the empty list. +-- +findRIS :: [Symbol] -> Genome -> [Symbol] +findRIS [] _ = [] +findRIS (x:xs) g | (isNonterminal x g) = (x:xs) +findRIS (_:xs) g | otherwise = findRIS xs g + +-- | +-- Root insertion sequence transposition. +transposeRIS :: [Symbol] -- ^ Sequence to perform RIS transposition on + -> Genome -- ^ Genome information + -> Int -- ^ Gene to perform RIS transposition within + -> Int -- ^ Position within gene to start search for + -- RIS for transposition + -> Int -- ^ Length of RIS + -> [Symbol] -- ^ Sequence after RIS transposition performed +transposeRIS x genome gene pos len = + fx ++ risSeq ++ keepHead ++ geneTail ++ bx + where + -- pull the gene out that we want + geneLen = (geneLength genome) + (fx,theGene,bx) = geneExtract x gene geneLen + + -- separate into head and tail + (geneHead, geneTail) = splitAt (headLength genome) theGene + + -- find the root insertion sequence within the candidate region given + -- by the search start position + risCandidateRegion = drop pos theGene + risSeq = take len (findRIS risCandidateRegion genome) + + -- determine how much of the head to preserve based on the length of + -- the root insertion sequence + keepHeadlen = (headLength genome) - (length risSeq) + + -- extract the parts of the head and tail of the original gene that + -- are preserved after transposition + keepHead = take keepHeadlen geneHead + +insertIntoGene :: [Symbol] -> [Symbol] -> Int -> Int -> [Symbol] +insertIntoGene x ins hl pos = (take hl (pre++ins++post))++tX + where + hX = take hl x + tX = drop hl x + pre = take pos x + post = drop pos hX + +-- | +-- Insertion sequence transposition. +transposeIS :: [Symbol] -- ^ Chromosome + -> Genome -- ^ Genome + -> Int -- ^ Gene number + -> Int -- ^ Position to take from within a gene + -> Int -- ^ Length to take + -> Int -- ^ Position to put within a gene + -> [Symbol] -- ^ Resulting chromosome +transposeIS x genome genenum takepos len putpos = + genesBefore ++ gene' ++ genesAfter + where + geneLen = (geneLength genome) + (genesBefore, gene, genesAfter) = geneExtract x genenum geneLen + iseq = take len (drop takepos gene) + gene' = insertIntoGene gene iseq (headLength genome) putpos + +-- | +-- Gene transposition. +transposeGene :: [Symbol] -- ^ Chromosome + -> Genome -- ^ Genome + -> Int -- ^ Gene number + -> [Symbol] -- ^ Resulting chromosome +transposeGene x genome gnum = gene++pregene++postgene + where + geneLen = (headLength genome) + (tailLength genome) + gene = take geneLen (drop (geneLen * gnum) x) + pregene = take (geneLen * gnum) x + postgene = drop (geneLen * (gnum+1)) x + diff --git a/GEP/GenericDriver.hs b/GEP/GenericDriver.hs new file mode 100644 --- /dev/null +++ b/GEP/GenericDriver.hs @@ -0,0 +1,62 @@ +module GEP.GenericDriver where + +import System.Random.Mersenne.Pure64 +import GEP.TimeStep +import GEP.Rmonad +import GEP.Random +import GEP.Types +import GEP.Params + +-- | Fitness function type +type FitnessFunction a b = a -> b -> Double -> Double -> Double + +-- | Function to express an individual into a list of ET structures +type ExpressionFunction a = Individual -> Genome -> a + +-- | A test case maps a list of terminals to float values +type TestCase a = SymTable a + +-- | A test dictionary is a set of test cases +type TestDict a = [TestCase a] + +-- | The set of outputs expected for each entry in the test dictionary +type TestOuts = [Double] + +{-| + Generic driver to be called from specific GEP program instances in their + main routine. +-} +gepDriver :: SimParams -- ^ Simulation parameters + -> Rates -- ^ Rates for genetic operators + -> Genome -- ^ Genome that individuals are drawn from + -> TestDict b -- ^ Test dictionary for fitness testing + -> TestOuts -- ^ Expected test results for test dictionary + -> FitnessFunction a (TestCase b) -- ^ Fitness testing function + -> ExpressionFunction a -- ^ String to ET expression function + -> IO (Double,[String]) -- ^ Return best individual fitness and population +gepDriver params rs gnome testdict testouts fitness_evaluate expression_function = do + -- create initial population + (initialPopulation,rngState) <- return $ runRmonad + (newPopulation gnome + (popSize params)) + (pureMT 1) + + -- Step 3: run the multistep iterator to evolve the population. this + -- is the core of the GEP process. Pass same rngState returned + -- when creating an initial population above when going back into + -- the Rmonad + ((best,pop),_) <- return $ runRmonad + (multiStep + initialPopulation + gnome + params + rs + expression_function + fitness_evaluate + testdict + testouts + (numGenerations params) + (maxFitness params) ) + rngState + + return (best,pop) diff --git a/GEP/MonadicGeneOperations.hs b/GEP/MonadicGeneOperations.hs new file mode 100644 --- /dev/null +++ b/GEP/MonadicGeneOperations.hs @@ -0,0 +1,96 @@ +{-| + This module contains wrappers around the purely functional gene operations + in "GEP.GeneOperations" in order to string the random number generation + state through via the "GEP.Rmonad". These helper functions are responsible + for sampling the random number generator to determine the parameters for + applying the genetic operators. + + The reasoning behind using a specialized Random monad instead of the + system generator provided by IO is that this allows independent + generators to be used should we support multiple threads of execution. + Parallel random number generation requires distinct generators, not a + shared one. + + Author: mjsottile\@computer.org +-} +module GEP.MonadicGeneOperations where + +import GEP.Rmonad +import GEP.GeneOperations +import GEP.Types +import GEP.Params + +{-| + IS Transposition helper +-} +isTransposer :: Genome -> + SimParams -> + Individual -> + GEPMonad [Symbol] +isTransposer genome params who = + do takelen <- nextR (maxISLen params) + takepos <- nextR ((geneLength genome)-takelen) + whichgene <- nextR (numGenes genome) + putpos <- nextR ((headLength genome)-1) + return $ transposeIS who genome (whichgene-1) takepos takelen (putpos+1) + +{-| + RIS Transposition helper +-} +risTransposer :: Genome -> + SimParams -> + Individual -> + GEPMonad [Symbol] +risTransposer genome params who = + do takelen <- nextR (maxRISLen params) + takepos <- nextR ((headLength genome)-1) + genenum <- nextR (numGenes genome) + return $ transposeRIS who genome genenum (takepos+1) takelen + +{-| + Gene transposition helper +-} +geneTransposer :: Genome -> + Individual -> + GEPMonad [Symbol] +geneTransposer genome who = + do whichGene <- nextR (numGenes genome) + return $ transposeGene who genome whichGene + +{-| + One-point crossover helper. Takes a genome, a pair of individuals, + and selects the crossover point before generating the new pair of + resulting individuals after crossover. +-} +x1PHelper :: Genome -> + (Individual,Individual) -> + GEPMonad (Individual,Individual) +x1PHelper g pair = + do xoverPos <- nextR (geneLength g) + return $ crossover1pt pair xoverPos + +{-| + Two-point crossover helper. Takes a genome, a pair of individuals, + and selects the crossover points before generating the new pair of + resulting individuals after crossover. +-} +x2PHelper :: Genome -> + (Individual,Individual) -> + GEPMonad (Individual,Individual) +x2PHelper g pair = + do xoverPos1 <- nextR (geneLength g) + xoverPos2 <- nextRDifferent (geneLength g) xoverPos1 + return $ crossover2pt pair (min xoverPos1 xoverPos2) + (max xoverPos1 xoverPos2) +{-| + Gene crossover helper. Takes a genome, a pair of individuals, and + selects the crossover gene before generating the new pair of + individuals resulting after crossover. +-} +xGHelper :: Genome -> + (Individual, Individual) -> + GEPMonad (Individual,Individual) +xGHelper g pair | (numGenes g) == 1 = return pair +xGHelper g pair | otherwise = do + xoverGene <- nextR (numGenes g) + return $ crossoverGene pair xoverGene (geneLength g) diff --git a/GEP/Params.hs b/GEP/Params.hs new file mode 100644 --- /dev/null +++ b/GEP/Params.hs @@ -0,0 +1,46 @@ +-- | +-- GEP parameters. These are related to both population management, +-- selection, and rates of genetic operators. The rates are a set of +-- probabilities of each operator being applied during each step of the +-- selection and reproduction phase. +-- +-- Author: mjsottile\@computer.org +-- + +module GEP.Params ( + Rates(..), + SimParams(..) +) where + +-- | The SimParams structure reprents the parameters for a run of the GEP +-- algorithm. This includes gross parameters unrelated to individuals +-- such as the population size, parameters related to selection, and +-- parameters related to specific genetic operators. +data SimParams = SimParams { + popSize :: Int, -- ^ Population size + rouletteExponent :: Double, -- ^ Exponent for defining the roulette + -- wheel bin sizes + maxFitness :: Double, -- ^ Fitness of the ideal individual + numGenerations :: Int, -- ^ Number of generations to run the + -- algorithm for + selectionRange :: Double, -- ^ Parameter m for fitness value + -- computation from the GEP paper. + maxISLen :: Int, -- ^ Maximum length of an IS transpose seq. + maxRISLen :: Int -- ^ Maximum length of an RIS transpose seq. +} deriving Show + +-- | The Rates structure is used to hold the probability of various events +-- occurring during the evolution of the GEP algorithm. +data Rates = Rates { + pMutate :: Double, -- ^ Probability of any single symbol being mutated + -- per individual + pIS :: Double, -- ^ Probability of an individual experiencing + -- insertion sequence transposition + pRIS :: Double, -- ^ Probability of an individual experiencing + -- root insertion sequence transposition + pGT :: Double, -- ^ Probability of an individual experiencing + -- gene transposition + p1R :: Double, -- ^ Probability of a 1pt recombination event + p2R :: Double, -- ^ Probability of a 2pt recombination event + pGR :: Double -- ^ Probability of a gene recombination event +} deriving Show diff --git a/GEP/Random.hs b/GEP/Random.hs new file mode 100644 --- /dev/null +++ b/GEP/Random.hs @@ -0,0 +1,95 @@ +{- | + Randomized functions for GEP applications. Attempting to + isolate all code that needs to be run under the Rmonad here. + + Author: mjsottile\@computer.org +-} +module GEP.Random ( + randomSymbol, + randomSymbolList, + newIndividual, + newPopulation, + mutateSymbol, + mutate +) where + +import GEP.Types +import GEP.Params +import GEP.Rmonad +import System.Random.Mersenne.Pure64 + +{-| + Select a random symbol from the provided list. +-} +randomSymbol :: [Symbol] -- ^ List of symbols + -> GEPMonad Symbol-- ^ Selected symbol +randomSymbol syms = + do index <- nextR (length syms) + return (syms !! (index-1)) + +{-| + Select a sequence of random symbols from the provided list. +-} +randomSymbolList :: [Symbol] -- ^ List of symbols + -> Int -- ^ Number to select + -> GEPMonad [Symbol] -- ^ List of selected + -- symbols +randomSymbolList _ 0 = do return [] +randomSymbolList syms n = + do current <- randomSymbol syms + rest <- randomSymbolList syms (n-1) + return ([current]++rest) + +-- | Generate a new individual given a genome specification. +newIndividual :: Genome -- ^ Genome for individual + -> Int -- ^ Number of genes to generate + -> GEPMonad Individual +newIndividual _ 0 = do return [] +newIndividual g n = + do hI <- randomSymbolList (allsymbols g) head_len + tI <- randomSymbolList (terminals g) tail_len + otherGenes <- newIndividual g (n-1) + return (hI++tI++otherGenes) + where + head_len = headLength g + tail_len = tailLength g + +-- |Create a population of fresh random individuals given a genome +-- |specification. +newPopulation :: Genome -- ^ Genome of population + -> Int -- ^ Number of individuals to create + -> GEPMonad [Individual] +newPopulation _ 0 = do return [] +newPopulation g n = + do p <- newPopulation g (n-1) + i <- newIndividual g (numGenes g) + return ([i]++p) + +mutateSymbol :: Genome -> Rates -> Symbol -> Double -> Bool -> GEPMonad Symbol +mutateSymbol g r _ p True | (p < (pMutate r)) = + do s <- randomSymbol (allsymbols g) + return s + +mutateSymbol g r _ p False | (p < (pMutate r)) = + do s <- randomSymbol (terminals g) + return s + +mutateSymbol _ _ s _ _ | otherwise = + do return s + +mutateGene :: Genome -> Rates -> [Symbol] -> GEPMonad [Symbol] +mutateGene_ _ [] = do return [] +mutateGene g r (s:ss) = + do prob <- nextF 1.0 + news <- mutateSymbol g r s prob ((length ss) >= (tailLength g)) + newss <- mutate g r ss + return ([news]++newss) + +mutate :: Genome -> Rates -> [Symbol] -> GEPMonad [Symbol] +mutate g r s = + do + genes' <- mapM (\i -> mutateGene g r i) genes + return $ genesToChrom genes' + where + genes = chromToGenes s (geneLength g) + diff --git a/GEP/Rmonad.hs b/GEP/Rmonad.hs new file mode 100644 --- /dev/null +++ b/GEP/Rmonad.hs @@ -0,0 +1,114 @@ +-- | +-- Monad based on state for passing random number state around for GEP. +-- The choice of Mersenne.Pure64 was for performance, and the pure version +-- will play nicely with threading. +-- +-- Author: mjsottile\@computer.org +-- + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GEP.Rmonad ( + GEPMonad, + nextF, + nextR, + nextRDifferent, + nextRList, + nextRListUnique, + nextRListPairs, + generatePairs, + runRmonad +) where + +import System.Random.Mersenne.Pure64 +import Control.Monad.State.Strict +import Debug.Trace + +newtype Rmonad s a = S (State s a) + deriving (Monad) + +-- | The GEPMonad is just a specific instance of the State monad where the +-- state is just the PureMT PRNG state. +type GEPMonad a = Rmonad PureMT a + +-- | Generate a random number as a Double between 0.0 and the given upper +-- bound. +nextF :: Double -- ^ Upper bound. + -> Rmonad PureMT Double +nextF up = S $ do st <- get + let (x,st') = randomDouble st + put st' + return (x*up) + +-- | Generate a random integer between 1 and the upper bound (inclusive). +nextR :: Int -- ^ Upper bound. + -> Rmonad PureMT Int +nextR up = S $ do st <- get + let (x,st') = randomInt st + put st' + return (1 + ((abs x) `mod` up)) + +-- | Generate a list of random integers. +nextRList :: Int -- ^ Number of integers to generate + -> Int -- ^ Upper bound for each integer. + -> Rmonad PureMT [Int] +nextRList 0 _ = do return [] +nextRList n up = do val <- nextR up + vals <- nextRList (n-1) up + return (val:vals) + +removeNth :: [a] -> Int -> [a] +removeNth [] _ = [] +removeNth (_:xs) 0 = (xs) +removeNth (x:xs) n = x:(removeNth xs (n-1)) + +shuffle :: [Int] -> Rmonad PureMT [Int] +shuffle [] = do return [] +shuffle x = do val <- nextR $ (length x) + rest <- shuffle $ (removeNth x (val-1)) + return ((x !! (val-1)):rest) + +pairify :: [Int] -> [(Int,Int)] +pairify [] = [] +pairify (_:[]) = [] +pairify (x:y:xs) = ((x,y):(pairify xs)) + +-- | Document me! +generatePairs :: Int -> Rmonad PureMT [(Int,Int)] +generatePairs 0 = do return [] +generatePairs 1 = do return [] +generatePairs n = do vals <- shuffle $! [1..n] + return $ (pairify vals) + +-- | Generate a list of n random integers such that each entry occurs at most +-- once. Each number in the list must be unique. +nextRListUnique :: Int -> [Int] -> Int -> Rmonad PureMT [Int] +nextRListUnique 0 l _ = do return l +nextRListUnique n l up = do val <- nextR up + let t = foldr (||) False (map (\i -> i==val) l) + if t == True + then do ret <- nextRListUnique n l up + return ret + else do ret <- nextRListUnique (n-1) (val:l) up + return ret + +nextRListPairs :: Int -> Int -> Rmonad PureMT [(Int,Int)] +nextRListPairs 0 _ = do return [] +nextRListPairs n up = do val1 <- nextR up + val2 <- nextRDifferent up val1 + rest <- nextRListPairs (n-1) up + return $ ((val1,val2):rest) + +-- | Generate a random integer in the specified range that is NOT equal to +-- the integer provided. +nextRDifferent :: Int -- ^ Upper bound. + -> Int -- ^ Integer to avoid. + -> Rmonad PureMT Int +nextRDifferent up x = do x' <- nextR up + if x' == x + then do x'' <- nextRDifferent up x + return x'' + else return x' + +-- | Run function for the Rmonad. +runRmonad :: Rmonad PureMT a -> PureMT -> (a, PureMT) +runRmonad (S m) s = runState m s diff --git a/GEP/Selection.hs b/GEP/Selection.hs new file mode 100644 --- /dev/null +++ b/GEP/Selection.hs @@ -0,0 +1,106 @@ +-- | +-- Routines for selection after fitness evaluation. Selection is the process +-- of taking some input population P, a set of fitness values such that +-- each p in P has a fitness score f(p,X) under some fitness test X, and +-- selecting which members of P participate in the creation of the next +-- population P'. +-- +-- A common technique is roulette wheel selection. In essence, this means that +-- we create a roulette wheel with one slot per individual where the width of +-- each slot is a function of the fitness of the individuals. So, those +-- individuals with very good fitness will have wide slots and a correspondingly +-- high likelihood of selection, while poor fitness individuals will have tiny +-- slots and a low probability of being selected. +-- +-- Fitness testing takes place outside this module. This module is only +-- concerned with the selection process (ie: generating the roulette wheel). +-- +-- Author: mjsottile\@computer.org +-- +module GEP.Selection ( + generate_roulette_weights, + roulette, + selector, + getBest +) where + +import GEP.Types +import GEP.Rmonad +import List (sort) + +{-| + Given a set of pairs (f,i) where f is the fitness of the individual i, + return the pair representing the individual with the best fitness. + We may return nothing if an empty set is passed in to begin with, so + the return type is a Maybe pair. +-} +getBest :: [(Double,Individual)] -- ^ Fitness/Individual pairs + -> Maybe (Double,Individual) -- ^ Best pair, or Nothing if no such pair +getBest [] = Nothing +getBest individuals = + let innerBest [] bi bf = Just (bf,bi) + innerBest ((f,i):rest) bi bf = if f > bf + then + innerBest rest i f + else + innerBest rest bi bf + (firstB, firstI) = head individuals + in + innerBest (tail individuals) firstI firstB + +weight_function :: Double -> Double -> Double +weight_function n e = + 1.0 / (n ** e) + +{-| + Given a list of indices and a list of data elements, create a new list + of data elements composed of the elements listed in the index list. + The output list may contain duplicates. +-} +selector :: [Int] -- ^ List of indices to select + -> [a] -- ^ List of elements + -> [a] -- ^ List composed of elements selected from original set by indices provided +selector i x = reverse (innerSelect 0 (sort i) x []) + +-- tail recursive version of inner select +innerSelect :: Int -> [Int] -> [a] -> [a] -> [a] +innerSelect _ [] _ l = l +innerSelect _ _ [] l = l +innerSelect n (i:is) (x:xs) l = + if (i==n) + then innerSelect n is (x:xs) (x:l) + else innerSelect (n+1) (i:is) xs l + +{-| + Generate n roulette weights with a generator exponent e. A helper function + weight_function is used to generate the actual weights. For example, + w = (k^e)^(-1) for k from 1 to n leads to a set of weights such that the + size of the slots decreases exponentially as fitness decreases. When e=1, + this decrease is linear. The list that is returned is the width of each slot + such that the total of the weights adds to 1.0. +-} +generate_roulette_weights :: Double -> Double -> [Double] +generate_roulette_weights n e = + map (\i -> i / sx) weights + where + weights = [weight_function x e | x <- [1..n]] + sx = foldr (+) 0.0 weights + +{-| + Given a set of roulette weights and a number of spins of the wheel, return + a list of indices corresponding to the winning slot for each spin. This + is used to perform the actual selection after a set of roulette weights are + generated. +-} +roulette :: [Double] -> Int -> GEPMonad [Int] +roulette _ 0 = do return [] +roulette weights n = + do val <- nextF 1.0 + rest <- roulette weights (n-1) + return ([find_bin 0.0 0 val weights]++rest) + where + find_bin _ m _ [] = m + find_bin tot m val (b:bs) = + if (val > tot) && (val <= (tot+b)) then m + else find_bin (tot+b) (m+1) val bs + diff --git a/GEP/TimeStep.hs b/GEP/TimeStep.hs new file mode 100644 --- /dev/null +++ b/GEP/TimeStep.hs @@ -0,0 +1,238 @@ +-- | +-- Code representing a single step of the GEP algorithm resides here. +-- +-- single step of fitness evaluation, selection and reproduction to make +-- a new population +-- +-- process includes: +-- +-- (1) expression of individuals +-- +-- (2) fitness evaluation +-- +-- (3) filtration to eliminate individuals yielding impossible +-- fitness values (infinite or NaN) +-- +-- (4) preservation of best individual +-- +-- (5) generation of roulette selection weights +-- +-- (6) roulette selection of individuals +-- +-- (7) perform mutation operator +-- +-- (8) IS transposition +-- +-- (9) RIS transposition +-- +-- (10) Gene transposition +-- +-- (11) 1Pt recombination +-- +-- (12) 2Pt recombination +-- +-- (13) Gene recombination +-- +-- Author: mjsottile\@computer.org +-- +module GEP.TimeStep ( + multiStep +) where + +import GEP.Rmonad +import GEP.MonadicGeneOperations +import GEP.Random +import GEP.Selection +import GEP.Fitness +import GEP.Types +import GEP.Params +import Debug.Trace +import List (sort) + + +-- | debugging version of (!!) thanks to #haskell help. by default we let +-- (!!!) simply alias (!!), but when we need to we can swap in a new + +-- implementation of (!!) to trace for debugging reasons. +(!!!) :: [a] -> Int -> String -> a + +-- debugging version +-- (!!!) x y s = trace (s++": "++(show y)++"//"++(show (length x))) (x !! y) + +-- production version : just alias (!!) +(!!!) x y _ = (x !! y) + +-- +-- helper for type conversion +-- +intToDouble :: Int -> Double +intToDouble n = fromInteger (toInteger n) + +{-| + Reassemble a population. We are given a full population, the set + of individuals that are to be replaced and their indices. The output + of this function is the new population where the unmodified individuals + are carried forward and those that were modified are replaced with their + new versions. +-} +putTogether :: [Int] -- ^ Indices of individuals to replace + -> [Individual] -- ^ Replacement individuals + -> [Individual] -- ^ Original population + -> [Individual] -- ^ New population +putTogether indices replacements original = + let innerPutTogether cur _ [] [] qs = drop (cur-1) qs + innerPutTogether cur _ [] _ qs = drop (cur-1) qs + innerPutTogether cur _ _ [] qs = drop (cur-1) qs + innerPutTogether cur mx (l:ls) (p:ps) qs = + if (cur > mx) + then + [] + else + if (l==cur) + then + (p:(innerPutTogether (cur+1) mx ls ps qs)) + else + (((!!!) qs (cur-1) "putTogether"): + (innerPutTogether (cur+1) mx (l:ls) (p:ps) qs)) + in + innerPutTogether 1 (length original) indices replacements original + +fillFilterGap :: Genome -> + Int -> + [(Double,Individual)] -> + GEPMonad [(Double,Individual)] +fillFilterGap genome popsize pop = + if (popsize-(length pop)) > 0 + then do newIndividuals <- newPopulation genome (popsize-(length pop)) + newPop <- return $ map (\i -> (0.0,i)) newIndividuals + return $! pop++newPop + else return $! pop + +{-| + Single step of GEP algorithm +-} +singleStep :: [Individual] -- ^ List of individuals + -> Genome -- ^ Genome + -> SimParams -- ^ Simulation parameters + -> Rates -- ^ Gene operator rates + -> (Individual -> Genome -> a) -- ^ Expression function + -> (a -> b -> Double -> Double -> Double) -- ^ Fitness function + -> [b] -- ^ Fitness inputs + -> [Double] -- ^ Fitness outputs + -> GEPMonad (Double,[Individual]) +singleStep pop g params r express_individual fitness_evaluate + testInputs testOutputs = + do indices <- roulette weights nSelect + + filtered <- fillFilterGap g nSelect initialFiltering + + -- selection + selected <- return $ map (\(_,b) -> b) (selector indices filtered) + + -- mutation + mutated <- mapM (mutate g r) selected + + -- IS transposition + isTransposePop <- nextRListUnique pISCount [] nSelect + isPopIn <- return $ map (\i -> (!!!) mutated (i-1) "isPopIn") + isTransposePop + isPopOut <- mapM (isTransposer g params) isPopIn + isPop <- return $ putTogether (sort isTransposePop) isPopOut mutated + + -- RIS transposition + risTransposePop <- nextRListUnique pRISCount [] nSelect + risPopIn <- return $ map (\i -> (!!!) isPop (i-1) "risPopIn") + risTransposePop + risPopOut <- mapM (risTransposer g params) risPopIn + risPop <- return $ putTogether (sort risTransposePop) risPopOut isPop + + -- Gene transposition + geneTransposePop <- nextRListUnique pGTCount [] nSelect + genePopIn <- return $ map (\i -> (!!!) risPop (i-1) "genePopIn") + geneTransposePop + genePopOut <- mapM (geneTransposer g) genePopIn + genePop <- return $ putTogether (sort geneTransposePop) genePopOut risPop + + -- 1Pt crossover + x1ptPopPairs <- generatePairs nSelect + x1ptPopSomePairs <- return $ take p1PCount x1ptPopPairs + x1UnpairPop <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] x1ptPopSomePairs + x1ptPopIn <- return $ map (\(a,b) -> ((!!!) genePop (a-1) "x1A", + (!!!) genePop (b-1) "x1B")) + x1ptPopSomePairs + x1ptPopOut <- mapM (x1PHelper g) x1ptPopIn + x1ptPopOutFlat <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] x1ptPopOut + x1ptPop <- return $ putTogether (sort x1UnpairPop) x1ptPopOutFlat genePop + + -- 2Pt crossover + x2ptPopPairs <- generatePairs nSelect + x2ptPopSome <- return $ take p2PCount x2ptPopPairs + x2UnpairPop <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] x2ptPopSome + x2ptPopIn <- return $ map (\(a,b) -> ((!!!) x1ptPop (a-1) "x2A", + (!!!) x1ptPop (b-1) "x2B")) + x2ptPopSome + x2ptPopOut <- mapM (x2PHelper g) x2ptPopIn + x2ptPopOutFlat <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] x2ptPopOut + x2ptPop <- return $ putTogether (sort x2UnpairPop) x2ptPopOutFlat x1ptPop + + -- Gene crossover + xGPopPairs <- generatePairs nSelect + xGPopSome <- return $ take pGRCount xGPopPairs + xGUnpairPop <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] xGPopSome + xGPopIn <- return $ map (\(a,b) -> ((!!!) x2ptPop (a-1) "xGA", + (!!!) x2ptPop (b-1) "xGB")) + xGPopSome + xGPopOut <- mapM (xGHelper g) xGPopIn + xGPopOutFlat <- return $ foldr (\(a,b) -> \i -> (a:b:i)) [] xGPopOut + xGPop <- return $ putTogether (sort xGUnpairPop) xGPopOutFlat x2ptPop + +-- return $ (trace (bestIndividual++" => "++(show bestFitness)++" AVG="++(show avgFitness)) (bestFitness,[bestIndividual]++x2ptPop)) + return $ (trace ((show bestFitness)++" "++(show avgFitness)) (bestFitness,[bestIndividual]++xGPop)) + where + nPop = length pop + nSelect = nPop - 1 + fnSelect = intToDouble nSelect + pISCount = floor (fnSelect * (pIS r)) + pRISCount = floor (fnSelect * (pRIS r)) + pGTCount = floor (fnSelect * (pGT r)) + p1PCount = floor (fnSelect * (p1R r)) + p2PCount = floor (fnSelect * (p2R r)) + pGRCount = floor (fnSelect * (pGR r)) + expressedPop = map (\i -> express_individual i g) pop + fitnesses = map (\i -> fitness_tester + i (fitness_evaluate) + testInputs testOutputs + (selectionRange params)) + expressedPop + initialFiltering = fitness_filter fitnesses pop + avgFitness = foldr (\(x,_) -> + \a -> a + + (x / + (intToDouble (length initialFiltering)))) + 0.0 initialFiltering + best = getBest initialFiltering + Just (bestFitness,bestIndividual) = best + weights = generate_roulette_weights + (intToDouble (length initialFiltering)) + (rouletteExponent params) + +multiStep :: [Individual] -- ^ List of individuals + -> Genome -- ^ Genome + -> SimParams -- ^ Simulation parameters + -> Rates -- ^ Gene operator rates + -> (Individual -> Genome -> a) -- ^ Expression function + -> (a -> b -> Double -> Double -> Double) -- ^ Fitness function + -> [b] -- ^ Fitness inputs + -> [Double] -- ^ Fitness outputs + -> Int -- ^ Maximum number of generations to test + -> Double -- ^ Ideal fitness + -> GEPMonad (Double,[Individual]) +multiStep pop g params r expresser fitnesser tests outs 0 _ = + do (bf,newp) <- singleStep pop g params r expresser fitnesser tests outs + return (bf,newp) +multiStep pop g params r expresser fitnesser tests outs i maxfitness = + do (bf,newp) <- singleStep pop g params r expresser fitnesser tests outs + (if (bf == maxfitness) + then return $ (bf,newp) + else do (bf',newp') <- multiStep newp g params r expresser fitnesser tests outs (i-1) maxfitness + return $ (bf',newp')) diff --git a/GEP/Types.hs b/GEP/Types.hs new file mode 100644 --- /dev/null +++ b/GEP/Types.hs @@ -0,0 +1,96 @@ +-- | This module defines the types used for implementing GEP problems +-- and operations. A few functions are also provided for convenience +-- here for performing common operations. +-- + +module GEP.Types ( + -- * Types + Genome(..), + Symbol, + Gene, + Chromosome, + Individual, + SymTable, + + -- * Functions + tailLength, + geneLength, + allsymbols, + chromToGenes, + genesToChrom, + isNonterminal +) where + +-- | A symbol in a chromosome +type Symbol = Char + +-- | A gene in a chromosome is a list of symbols +type Gene = [Symbol] + +-- | A chromosome is a list of symbols. We avoided using a list of genes to +-- maintain the view of a chromosome as nothing more than a flattened, +-- linear sequence of genes. +type Chromosome = [Symbol] + +-- | An individual is a chromosome +type Individual = Chromosome + +-- | Symbol table used for fitness tests. We assume that there is exactly +-- one pair per symbol. If there are symbols missing, fitness testing +-- may fail (the library does not have facilities yet to allow for +-- default values). If a symbol occurs multiple times in the symbol +-- table, no guarantee is provided for which value will be chosen. +type SymTable a = [(Symbol,a)] + +-- | Data type representing a genome. The genome contains all necessary +-- parameters to interpret a chromosome. These include the alphabet (split +-- between terminal and nonterminal characters), connective characters for +-- multi-gene chromosomes, the maximum arity of any nonterminal, the length +-- of the head of a gene, and the number of genes per chromosome. +data Genome = Genome { + terminals :: [Symbol], -- ^ Set of terminal symbols + nonterminals :: [Symbol], -- ^ Set of nonterminal symbols + geneConnector :: Symbol, -- ^ Symbol connecting genes in a chromosome + maxArity :: Int, -- ^ Highest arity nonterminal function + headLength :: Int, -- ^ Length of gene head sequence + numGenes :: Int -- ^ Number of genes per chromosome +} deriving Show + +-- | Given a genome, provide the list of all symbols possible in a chromosome. +-- This is just nonterminals ++ terminals. +allsymbols :: Genome -- ^ Genome + -> [Symbol] -- ^ List of symbols +allsymbols g = (terminals g)++(nonterminals g) + +-- | Return the length of the tail of a gene for a given genome +tailLength :: Genome -- ^ Genome + -> Int -- ^ Number of symbols in a gene tail +tailLength g = ((headLength g) * ((maxArity g)-1))+1 + +-- | Return length of a gene (tail + head) for a given genome +geneLength :: Genome -- ^ Genome + -> Int -- ^ Total length of a gene. +geneLength g = (headLength g) + (tailLength g) + +-- | Test if a symbol is a nonterminal +isNonterminal :: Symbol -- ^ Symbol to test + -> Genome -- ^ Genome providing context + -> Bool -- ^ True if symbol is a nonterminal, false otherwise +isNonterminal s g = + let isNT [] = False + isNT (x:_) | (s == x) = True + isNT (_:xs) | otherwise = (isNT xs) + in + isNT (nonterminals g) + +-- | Fracture a chromosome into a set of genes +chromToGenes :: Chromosome -- ^ Chromosome to split into a set of genes + -> Int -- ^ Length of a single gene + -> [Gene] -- ^ Ordered list of genes from chromosome +chromToGenes [] _ = [] +chromToGenes c glen = (take glen c):(chromToGenes (drop glen c) glen) + +-- | Assemble a chromosome from a set of genes +genesToChrom :: [Gene] -- ^ List of genes + -> Chromosome -- ^ Chromosome assembled from genes +genesToChrom genes = foldl (++) [] genes diff --git a/GEP/Util/ConfigurationReader.hs b/GEP/Util/ConfigurationReader.hs new file mode 100644 --- /dev/null +++ b/GEP/Util/ConfigurationReader.hs @@ -0,0 +1,121 @@ +-- | +-- Code to read configuration files. +-- +-- Author: mjsottile\@computer.org +-- + +module GEP.Util.ConfigurationReader ( + readParameters +) where + +import GEP.Params +import GEP.Types +import System.IO +import Maybe + +-- +-- given a list of pairs mapping keys to values, lookup the various +-- parameters and populate the rates, genome, and simparams structures +-- +extractParameters :: [(String,String)] -> (Rates,Genome,SimParams) +extractParameters config = (r,g,s) + where + s = SimParams { + popSize = fromJust (lookupInt "populationSize" config), + selectionRange = fromJust (lookupDouble "selectionRange" config), + maxFitness = fromJust (lookupDouble "maxFitness" config), + numGenerations = fromJust (lookupInt "numGenerations" config), + maxISLen = fromJust (lookupInt "maxISLen" config), + maxRISLen = fromJust (lookupInt "maxRISLen" config), + rouletteExponent = fromJust (lookupDouble "rouletteExponent" config) + } + r = Rates { pMutate = fromJust (lookupDouble "rateMutate" config), + p1R = fromJust (lookupDouble "rate1R" config), + p2R = fromJust (lookupDouble "rate2R" config), + pGR = fromJust (lookupDouble "rateGR" config), + pIS = fromJust (lookupDouble "rateIS" config), + pRIS = fromJust (lookupDouble "rateRIS" config), + pGT = fromJust (lookupDouble "rateGT" config) + } + g = Genome { + terminals = fromJust (lookupString "genomeTerminals" config), + nonterminals = fromJust (lookupString "genomeNonterminals" config), + geneConnector = fromJust (lookupChar "genomeGeneConnector" config), + maxArity = fromJust (lookupInt "genomeMaxArity" config), + numGenes = fromJust (lookupInt "genomeNumGenes" config), + headLength = fromJust (lookupInt "genomeHeadLength" config) + } + +-- +-- function visible to the outside world. passes in a string representing +-- the filename of the configuration, and passes back the rates, +-- genome, and simparams structures. Expected to be called from within the +-- IO monad +-- +readParameters :: String -> IO (Rates,Genome,SimParams) +readParameters filename = + do config <- readConfiguration filename + return $ extractParameters config + +-- +-- lookup helpers: float, int, char, and string versions +-- + +lookupDouble :: String -> [(String,String)] -> Maybe Double +lookupDouble _ [] = Nothing +lookupDouble k ((key,value):_) | (k==key) = Just (read value) +lookupDouble k ((_,_):kvs) | otherwise = lookupDouble k kvs + +lookupInt :: String -> [(String,String)] -> Maybe Int +lookupInt _ [] = Nothing +lookupInt k ((key,value):_) | (k==key) = Just (read value) +lookupInt k ((_,_):kvs) | otherwise = lookupInt k kvs + +lookupString :: String -> [(String,String)] -> Maybe String +lookupString _ [] = Nothing +lookupString k ((key,value):_) | (k==key) = Just value +lookupString k ((_,_):kvs) | otherwise = lookupString k kvs + +lookupChar :: String -> [(String,String)] -> Maybe Char +lookupChar _ [] = Nothing +lookupChar k ((key,value):_) | (k==key) = Just (head value) +lookupChar k ((_,_):kvs) | otherwise = lookupChar k kvs + +-- +-- given a string, remove whitespace +-- +removeWhitespace :: String -> String +removeWhitespace [] = [] +removeWhitespace (x:xs) | (x == ' ') = removeWhitespace xs +removeWhitespace (x:xs) | (x == '\t') = removeWhitespace xs +removeWhitespace (x:xs) | otherwise = x:(removeWhitespace xs) + +-- +-- split a line formatted as "KEY=VALUE", removing whitespace +-- +splitLine :: String -> (String,String) +splitLine l = (front,back) + where + cleaned = removeWhitespace l + front = takeWhile (\i -> not (i == '=')) cleaned + back = drop 1 (dropWhile (\i -> not (i == '=')) cleaned) + +-- +-- read a file handle and return all of the lines in the file +-- +fileToLines :: Handle -> IO [String] +fileToLines h = do eof <- hIsEOF h + (if eof + then return [] + else do line <- hGetLine h + remainder <- fileToLines h + return $ (line:remainder)) + +-- +-- given a filename, open the file, read the lines, and then split them +-- into key/value pairs assuming a "KEY=VALUE" format per line +-- +readConfiguration :: String -> IO [(String,String)] +readConfiguration filename = do handle <- openFile filename ReadMode + fileLines <- fileToLines handle + return $ map (\i -> splitLine i) fileLines diff --git a/HSGEP.cabal b/HSGEP.cabal new file mode 100644 --- /dev/null +++ b/HSGEP.cabal @@ -0,0 +1,29 @@ +Name: HSGEP +Version: 0.1.0 +Cabal-Version: >= 1.6 +License: BSD3 +License-File: LICENSE +Copyright: (c) 2009-2010 Matthew Sottile +Author: Matthew Sottile +Maintainer: Matthew Sottile +Stability: alpha +Homepage: http://github.com/mjsottile/hsgep/ +Category: AI +Synopsis: Gene Expression Programming evolutionary algorithm in Haskell +Build-Type: Simple +Description: Gene Expression Programming evolutionary algorithm implemented + in Haskell. +Extra-Source-Files: Examples/Regression/*.in Examples/Regression/*.csv README README_Params.txt + +Library + Build-Depends: base>=4&&<5, random, mtl, parsec>=2&&<3, network, haskell98, mersenne-random-pure64 + Exposed-modules: + GEP.Fitness, GEP.GeneOperations, GEP.MonadicGeneOperations, + GEP.Params, GEP.Random, GEP.Rmonad, + GEP.TimeStep, GEP.Selection, GEP.Util.ConfigurationReader, + GEP.Types, GEP.GenericDriver, GEP.Examples.Regression.FitnessInput, + GEP.Examples.Regression.ArithmeticIndividual + +Executable HSGEP_Regression + Main-Is: GEP/Examples/Regression/Driver.hs + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2009-2010, Matthew J. Sottile +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,102 @@ +==================================================== += HSGEP: Gene Expression Programming in Haskell = += Version 0.1 = += Author: Matthew Sottile (mjsottile@computer.org) = +==================================================== + +** This code is released under the BSD3 Open Source License ** + +1.0: Introduction +----------------- + +This package implements the Gene Expression Programming algorithm invented +by Candida Ferreira. See the following paper for a good, concise explanation +of the method: + +Ferreira, C., 2001. Gene Expression Programming: A New Adaptive + Algorithm for Solving Problems. Complex Systems, Vol. 13, issue 2:87-129. + http://www.gene-expression-programming.com/webpapers/abstracts.asp#01 + +GEP is an evolutionary algorithm for solving optimization problems. The +introduction to the paper cited above provides a good explanation of what +differentiates GEP from GP and GAs. + +2.0: Background +--------------- + +This project is an ancestor of an earlier effort to build a generic framework +for using GEP, originally in Java. The move to a functional language +(originally SML, now Haskell) was because: + + - At its core, GEP is focused on manipulating symbolic sequences and + tree structures. List and user defined data types in Haskell are very + well suited to this. + + - Functional languages naturally support functions being first class + citizens, being passed around as arguments to functions. While + this abstraction is possible using object interfaces and + hierarchies (which is precisely what the Java version used), it + felt more cumbersome to manage and code up. + + - Pattern matching and strict type checking provide very strong + checks on the core of the library to ensure that some classes of + bugs are not present. For example, being able to guarantee that a pattern + match is exhaustive at compile time is preferable to potential runtime + errors that may result if such compilation time checks are not performed. + + +3.0: Usage +---------- + +At this point, the best places to look for documentation on using the +library is: + +- The Haddock documentation. +- Looking at examples. + +The most mature example currently included in the released code is the +regression example. In this example, a set of data points are provided +and the optimization phase seeks to evolve a polynomial composed of +basic arithmetic (+-*/), sqrt, and exponentiation operations that best fits +the data points. The example provided is fairly simplistic, and fails to +include useful things like the ability to evolve constants as part of the +polynomials. In any case, it is sufficient to demonstrate the library. + +To run a regression example, you can use example input parameter and data +files from the Examples/Regression directory. For example, after building +the code, you can run the example "test1" as: + +./dist/build/HSGEP_Regression/HSGEP_Regression ./Examples/Regression/test1.in ./Examples/Regression/test1.csv + +The current code will then evolve a solution that maximizes the fitness +function (goodness of fit to the given data points), and will print it out. +The example will also attempt to connect to a machine running a Maxima +server to perform polynomial simplification to turn the long string of +basic arithmetic operators into a more useful polynomial. This is likely +going to not work for most people, so either ignore the error, or tweak +the code to either disable it or run the Maxima server code somewhere. + +4.0: FAQ +-------- + +- Q: Is this library intended to be more than a toy? + A: Yes. It has been a testbed for me to get used to some of the + details related to releasing a properly packaged library to + the world on Hackage, so some of the core has been neglected while I + did things related to build, organization, and documentation. + +- Q: What are the plans for near-term new versions? + A: Lots. + + - If a plotting library is available (e.g.: Chart), produce plots of + fitness over time. + - Add more examples, such as the CA Density classification task. + - Performance improvements. + - Go parallel -- there are many opportunities for parallelism during + the run of the algorithm, so it would be worth taking advantage of + them. + - Abstract out some of the patterns currently residing in each example, + such as the process of expressing indiduals as structures. The + ultimate goal is to make the end-user code that uses the library as + simple as possible, so absorbing as much of this into the core of the + library will be a good step in that direction. diff --git a/README_Params.txt b/README_Params.txt new file mode 100644 --- /dev/null +++ b/README_Params.txt @@ -0,0 +1,56 @@ +Setting GEP Parameters +---------------------- + +Rates: + +rateMutate +rate1R +rate2R +rateGR +rateIS +rateRIS +rateGT + +Genome: + +genomeTerminals: list of characters that are valid entries in a +chromosome for terminals (e.g.: variables in a regression problem). + +genomeNonterminals: list of characters that are valid entries in a +chromosome for nonterminals (e.g.: operators in a regression problem). + +genomeMaxArity: maximum arity operator in the nonterminal list. +Examples: boolean NOT has arity 1, arithmetic add has arity 2, boolean +IF has arity 3. + +genomeNumGenes: number of genes in a chromosome. + +genomeHeadLength: number of characters in the head of a gene. This is +used in combination with the maximum arity parameter to determine the +overall gene length. + +genomeGeneConnector: nonterminal used to connect genes in a multi-gene +chromosome to form a single expression tree. + +Genetic Operator Parameters: + +maxISLen: Maximum length of insertion sequences. + +maxRISLen: Maximum length of root insertion sequences. + +Population Parameters: + +populationSize: Number of individuals in the population per step. + +numGenerations: How many generations to run algorithm for if maximum +fitness not achieved. + +Fitness and selection: + +maxFitness: Fitness of ideal individual. + +rouletteExponent: Exponent for weight function used to determine +roulette wheel bin widths. Current default function is 1/(k^e) where +k is the bin number and e is the exponent. + +selectionRange: Range of selection parameter (M) from the GEP paper. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain