HSGEP 0.1.4 → 0.1.5
raw patch · 9 files changed
+90/−101 lines, 9 filesdep +splitdep −haskell98PVP ok
version bump matches the API change (PVP)
Dependencies added: split
Dependencies removed: haskell98
API changes (from Hackage documentation)
+ GEP.Expression: levelize :: (Symbol -> Int) -> Sequence -> Int -> [Sequence]
Files
- GEP/Examples/Regression/ArithmeticIndividual.hs +4/−17
- GEP/Examples/Regression/Driver.hs +1/−1
- GEP/Expression.hs +20/−0
- GEP/Fitness.hs +18/−23
- GEP/Selection.hs +4/−10
- GEP/TimeStep.hs +16/−16
- GEP/Types.hs +5/−9
- GEP/Util/ConfigurationReader.hs +18/−21
- HSGEP.cabal +4/−4
GEP/Examples/Regression/ArithmeticIndividual.hs view
@@ -14,6 +14,7 @@ ) where import GEP.Types+import GEP.Expression import Data.Maybe import System.IO @@ -103,14 +104,6 @@ arity '^' = 2 arity _ = 0 -levelize :: Sequence -> Int -> [Sequence]-levelize _ 0 = []-levelize [] _ = []-levelize s i =- front : levelize back (foldr ((+) . arity) 0 front)- where- (front,back) = splitAt i s- infixWalker :: AINode -> String infixWalker (Terminal c) = [c] infixWalker (UnOp Sqrt e) = "sqrt("++ infixWalker e ++")"@@ -150,7 +143,7 @@ assemble :: [Sequence] -> [AINode] assemble [] = []-assemble (c:[]) = map (\x -> Terminal x) c+assemble (c:[]) = map Terminal c assemble (c:cs) = lvlAssemble c (assemble cs) express_individual :: Chromosome -> Genome -> AINode@@ -158,7 +151,7 @@ connect_genes g ets where genes = chromToGenes chrom (geneLength g)- ets = map (\i -> head (assemble (levelize i 1))) genes+ ets = map (\i -> head (assemble (levelize arity i 1))) genes connect_genes :: Genome -> [AINode] -> AINode connect_genes _ x | length x == 1 = head x@@ -172,14 +165,8 @@ 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)+lookup_sym sym syms = lookup sym syms evaluate :: AINode -> AISymTable -> Double evaluate node syms =
GEP/Examples/Regression/Driver.hs view
@@ -18,7 +18,7 @@ -- polynomials -- -- import GEP.Examples.Regression.MaximaClient-import System (getArgs)+import System.Environment (getArgs) import System.Console.GetOpt --
+ GEP/Expression.hs view
@@ -0,0 +1,20 @@+-- |+-- Expression related code. These are helpers to turn linear sequences+-- into trees.+-- +-- Author: mjsottile\@computer.org+-- ++module GEP.Expression (+ levelize+) where++import GEP.Types++levelize :: (Symbol -> Int) -> Sequence -> Int -> [Sequence]+levelize _ _ 0 = []+levelize _ [] _ = []+levelize arity s i =+ front : levelize arity back (sum $ map arity front)+ where+ (front,back) = splitAt i s
GEP/Fitness.hs view
@@ -20,6 +20,9 @@ ) where import GEP.Types+import Data.Function+import Data.List (sortBy)+ -- | Fitness function type type FitnessFunction a b = a -> TestCase b -> Double -> Double -> Double @@ -33,30 +36,25 @@ type TestOuts = [Double] ----- Sort a list of pairs by first element of each pair. Disregard duplicates--- pairs.+-- Sort a list of pairs by first element of each pair. -- 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]+pairSort = sortBy (compare `on` fst) +-- -- | -- Fitness evaluator for generic individuals. This needs to go away -- and use a more general approach like evaluateFitness above. -- -fitness_tester :: a -- ^ Expressed individual+fitness_tester :: a -- ^ Expressed individual -> FitnessFunction a b -- ^ Fitness function- -> TestDict b -- ^ List of symbol tables for test cases- -> TestOuts -- ^ 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+ -> TestDict b -- ^ List of symbol tables for test cases+ -> TestOuts -- ^ 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+ sum tests where tests = map (\(x,y) -> ffun who x y m) (zip inputDict outputs)@@ -67,16 +65,13 @@ -- only those individuals that have a valid fitness value. This means those -- that are +/- infinity or NaN are removed. ---fitness_filter :: [Double] -- ^ Fitness values- -> [Chromosome] -- ^ Individuals+fitness_filter :: [Double] -- ^ Fitness values+ -> [Chromosome] -- ^ Individuals -> [(Double, Chromosome)] -- ^ Paired fitness/individuals after - -- filtering+ -- filtering fitness_filter fitnesses pop =- foldr (\(i,j) -> - \x -> if ((isNaN i) || (isInfinite i)) - then x - else ((i,j):x)- ) [] (zip fitnesses pop)+ filter (\(i,_) -> not ((isNaN i) || (isInfinite i))) + (zip fitnesses pop) -- | -- Sort a set of individuals with fitness values by their fitness
GEP/Selection.hs view
@@ -26,7 +26,7 @@ import GEP.Types import GEP.Rmonad-import List (sort)+import Data.List (sort) {-| Given a set of pairs (f,i) where f is the fitness of the individual i,@@ -38,15 +38,9 @@ -> Maybe (Double, Chromosome) -- ^ 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+ Just $ foldl1 (\(f1,i1) (f2,i2) -> if f1 > f2 then (f1,i1) + else (f2,i2)) + individuals weight_function :: Double -> Double -> Double weight_function n e =
GEP/TimeStep.hs view
@@ -47,7 +47,7 @@ import GEP.Types import GEP.Params import Debug.Trace-import List (sort)+import Data.List (sort) -- | debugging version of (!!) thanks to #haskell help. by default we let@@ -181,14 +181,14 @@ {-| Single step of GEP algorithm -}-singleStep :: [Chromosome] -- ^ List of individuals - -> Genome -- ^ Genome- -> SimParams -- ^ Simulation parameters- -> Rates -- ^ Gene operator rates+singleStep :: [Chromosome] -- ^ List of individuals + -> Genome -- ^ Genome+ -> SimParams -- ^ Simulation parameters+ -> Rates -- ^ Gene operator rates -> ExpressionFunction a -- ^ Expression function- -> FitnessFunction a b-- ^ Fitness function- -> TestDict b -- ^ Fitness inputs- -> TestOuts -- ^ Fitness outputs+ -> FitnessFunction a b -- ^ Fitness function+ -> TestDict b -- ^ Fitness inputs+ -> TestOuts -- ^ Fitness outputs -> GEPMonad (Double, [Chromosome]) singleStep pop g params r express_individual fitness_evaluate testInputs testOutputs =@@ -197,7 +197,7 @@ filtered <- fillFilterGap g nSelect initialFiltering -- selection- let selected = map (\(_,b) -> b) (selector indices filtered)+ let selected = map snd (selector indices filtered) -- mutation resultingPop <- applyMutations g params r selected@@ -227,15 +227,15 @@ (intToDouble (length initialFiltering)) (rouletteExponent params) -multiStep :: [Chromosome] -- ^ List of individuals- -> Genome -- ^ Genome- -> SimParams -- ^ Simulation parameters- -> Rates -- ^ Gene operator rates+multiStep :: [Chromosome] -- ^ List of individuals+ -> Genome -- ^ Genome+ -> SimParams -- ^ Simulation parameters+ -> Rates -- ^ Gene operator rates -> ExpressionFunction a -- ^ Expression function- -> FitnessFunction a b -- ^ Fitness function- -> TestDict b -- ^ Fitness inputs+ -> FitnessFunction a b -- ^ Fitness function+ -> TestDict b -- ^ Fitness inputs -> TestOuts -- ^ Fitness outputs- -> Int -- ^ Maximum number of generations to test+ -> Int -- ^ Maximum number of generations to test -> Double -- ^ Ideal fitness -> GEPMonad (Double, [Chromosome]) multiStep pop g params r expresser fitnesser tests outs 0 _ =
GEP/Types.hs view
@@ -22,6 +22,8 @@ isNonterminal ) where +import Data.List.Split (chunksOf)+ -- | A symbol in a chromosome type Symbol = Char @@ -81,21 +83,15 @@ 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)+isNonterminal s g = elem s (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)+chromToGenes c glen = chunksOf glen c -- | Assemble a chromosome from a set of genes genesToChrom :: [Gene] -- ^ List of genes -> Chromosome -- ^ Chromosome assembled from genes-genesToChrom genes = foldl (++) [] genes+genesToChrom genes = concat genes
GEP/Util/ConfigurationReader.hs view
@@ -11,7 +11,7 @@ import GEP.Params import GEP.Types import System.IO-import Maybe+import Data.Maybe -- -- given a list of pairs mapping keys to values, lookup the various@@ -62,33 +62,31 @@ -- lookupDouble :: String -> [(String,String)] -> Maybe Double-lookupDouble _ [] = Nothing-lookupDouble k ((key,value):_) | (k==key) = Just (read value)-lookupDouble k ((_,_):kvs) | otherwise = lookupDouble k kvs+lookupDouble k dict = + case (lookup k dict) of+ Nothing -> Nothing+ Just s -> Just (read s) lookupInt :: String -> [(String,String)] -> Maybe Int-lookupInt _ [] = Nothing-lookupInt k ((key,value):_) | (k==key) = Just (read value)-lookupInt k ((_,_):kvs) | otherwise = lookupInt k kvs+lookupInt k dict =+ case (lookup k dict) of+ Nothing -> Nothing+ Just s -> Just (read s) lookupString :: String -> [(String,String)] -> Maybe String-lookupString _ [] = Nothing-lookupString k ((key,value):_) | (k==key) = Just value-lookupString k ((_,_):kvs) | otherwise = lookupString k kvs+lookupString k dict = lookup k dict lookupChar :: String -> [(String,String)] -> Maybe Char-lookupChar _ [] = Nothing-lookupChar k ((key,value):_) | (k==key) = Just (head value)-lookupChar k ((_,_):kvs) | otherwise = lookupChar k kvs+lookupChar k dict = + case (lookup k dict) of+ Nothing -> Nothing+ Just s -> Just (head s) -- -- 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)+removeWhitespace s = filter (\x -> x /= ' ' && x /= '\t') s -- -- split a line formatted as "KEY=VALUE", removing whitespace@@ -97,9 +95,8 @@ splitLine l = (front,back) where cleaned = removeWhitespace l- front = takeWhile (\i -> not (i == '=')) cleaned- back = drop 1 (dropWhile (\i -> not (i == '=')) cleaned)-+ front = takeWhile (\i -> i /= '=') cleaned+ back = drop (1 + length front) cleaned -- -- read a file handle and return all of the lines in the file --@@ -118,4 +115,4 @@ readConfiguration :: String -> IO [(String,String)] readConfiguration filename = do handle <- openFile filename ReadMode fileLines <- fileToLines handle- return $ map (\i -> splitLine i) fileLines+ return $ map splitLine fileLines
HSGEP.cabal view
@@ -1,9 +1,9 @@ Name: HSGEP-Version: 0.1.4+Version: 0.1.5 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE-Copyright: (c) 2009-2010 Matthew Sottile+Copyright: (c) 2009-2012 Matthew Sottile Author: Matthew Sottile Maintainer: Matthew Sottile <mjsottile@computer.org> Stability: alpha@@ -19,12 +19,12 @@ GHC-Options: -Wall GHC-Prof-Options: -Wall -auto-all -caf-all - Build-Depends: base>=4&&<5, mtl, haskell98, mersenne-random-pure64, monad-mersenne-random, vector+ Build-Depends: base>=4&&<5, mtl, mersenne-random-pure64, monad-mersenne-random, vector, split 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.Types, GEP.GenericDriver, GEP.Expression Executable HSGEP_Regression GHC-Options: -Wall