packages feed

HSGEP 0.1.3 → 0.1.4

raw patch · 6 files changed

+333/−27 lines, 6 files

Files

GEP/Examples/CADensity/Driver.hs view
@@ -34,8 +34,8 @@   validateArgs args    -- give args nice names-  configFile <- return $ head args-  fitnessFile <- return $ head (tail args)+  let configFile = head args+  let fitnessFile = 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))
+ GEP/Examples/Regression/ArithmeticIndividual.hs view
@@ -0,0 +1,213 @@+{-|+  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,+    fitness_evaluate_absolute,+    fitness_evaluate_relative,+    infixWalker,+    aiToGraphviz,+    dumpDotFile+) where++import GEP.Types+import Data.Maybe+import System.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 :: String -> AINode -> IO ()+dumpDotFile 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 :: 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 ++")"+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 :: Sequence -> [AINode] -> [AINode]+lvlAssemble [] _        = []+lvlAssemble (c:cs) kids = +    express c cneed : lvlAssemble cs csneed+    where+      ac = arity c+      (cneed,csneed) = splitAt ac kids++assemble :: [Sequence] -> [AINode]+assemble []     = []+assemble (c:[]) = map (\x -> Terminal x) c+assemble (c:cs) = lvlAssemble c (assemble cs)++express_individual :: Chromosome -> 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 _ 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) -> fromMaybe+                        (error $ "Invalid terminal symbol" ++ show x ++ "appeared.")+                        (lookup_sym x syms)++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
GEP/Examples/Regression/Driver.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveDataTypeable #-}+ -- | --  Haskell gene expression programming, regression example -- @@ -16,41 +18,78 @@ --       polynomials -- -- import GEP.Examples.Regression.MaximaClient-import System.Environment (getArgs)-import Control.Monad (when)+import System (getArgs)+import System.Console.GetOpt  ----- sanity check arguments to see if we have enough+-- command line options ---validateArgs :: [String] -> IO ()-validateArgs s =-    when (length s < 2) $-        error "Must specify config file and fitness test data file names."+data Options = Options {+  optParams :: String,+  optFitness :: String,+  optDotfile :: Maybe String,+  optVerbose :: Bool+}  +options :: [OptDescr (Options -> IO Options)]+options = +  [ Option ['i'] ["params"]  (ReqArg inputFile "FILE")   "Parameters"+  , Option ['f'] ["fitness"] (ReqArg fitnessFile "FILE") "Fitness tests"+  , Option ['d'] ["dot"]     (OptArg dotFile "FILE")     "Graphviz dotfile"+  , Option ['v'] ["verbose"] (NoArg  verbose)            "Verbose output"+  ]++checkOptions :: Options -> IO ()+checkOptions opts =+  case (optParams opts) of+    "" -> error ("Parameter file required.")+    _ -> case (optFitness opts) of+           "" -> error ("Fitness file required.")+           _  -> return ()++programOpts :: [String] -> IO Options+programOpts argv = do+  case getOpt Permute options argv of+    (actions, [], []) -> do opts <- foldl (>>=) (return defaultOptions) actions+                            checkOptions opts+                            return opts+    (_, nonOpts, []) -> error ( "unrecognized arguments: " ++ unwords nonOpts)+    (_, _, msgs) -> error (concat msgs ++ usageInfo header options)+  where header = "Usage: regression [OPTION...]"++inputFile :: String -> Options -> IO Options+inputFile arg opt = return opt { optParams = arg }++fitnessFile :: String -> Options -> IO Options+fitnessFile arg opt = return opt { optFitness = arg }++dotFile :: Maybe String -> Options -> IO Options+dotFile arg opt = return opt { optDotfile = arg }++verbose :: Options -> IO Options+verbose opt = return opt { optVerbose = True }++defaultOptions :: Options+defaultOptions = Options { +  optParams = "", +  optFitness = "", +  optDotfile = Nothing,+  optVerbose = False+}+ -- -- main -- main :: IO () main = do-  -- read in parameters from specified file   args <- getArgs--  -- sanity check-  validateArgs args--  -- give args nice names-  let configFile = head args-  let fitnessFile = 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+  cmdOpts <- programOpts args      -- read parameters-  (rs,gnome,params) <- readParameters configFile+  (rs,gnome,params) <- readParameters (optParams cmdOpts)      -- read fitness test data-  (testDict, ys) <- readFitnessInput fitnessFile+  (testDict, ys) <- readFitnessInput (optFitness cmdOpts)    -- call generic driver   (best,pop) <- gepDriver params rs gnome testDict ys fitness_evaluate_absolute express_individual@@ -74,4 +113,6 @@   -- maximaExpand bestString "qubu.net" 12777 >>= mapM_ putStrLn    -- dump to dot file if one was specified-  dumpDotFile dotfile bestExpressed+  case (optDotfile cmdOpts) of+    Nothing -> return ()+    Just s  -> dumpDotFile s bestExpressed
+ GEP/Examples/Regression/FitnessInput.hs view
@@ -0,0 +1,50 @@+{-|++  Code to read input data files containing the test inputs and test outputs+  used to evaluate the fitness of individuals.++  Author: mjsottile\@computer.org++-}+module GEP.Examples.Regression.FitnessInput (+  readFitnessInput+) where++import Text.CSV++--+-- 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.+--++type FitnessDict = [[(Char,Double)]]++dictify :: Record -> [Record] -> (FitnessDict, [Double])+dictify lbls values =+    (map (\j -> zip (init charLbls) j) (init floatValues),+     map last floatValues)+    where+      charLbls = map head lbls  -- First line contains Terminal chars.+      floatValues = map toDoubles (filter emptyRecord values)+      emptyRecord :: [Field] -> Bool+      emptyRecord r = 0 < (length . concat) r+      toDoubles :: Record -> [Double]+      toDoubles = map read++-- function that takes a filename and returns a dictionary+readFitnessInput :: String -> IO (FitnessDict,[Double])+readFitnessInput fname = do+    result <- parseCSVFromFile fname+    case result of Left err -> error $ "Bad regression fitness input: "+                                 ++ show fname ++ "!\n" ++ show err+                   Right xs -> return $ dictify (head xs) (tail xs)++{-+main :: IO ()+main = do+  x <- readFitnessInput "test.csv"+  print x+-}
HSGEP.cabal view
@@ -1,5 +1,5 @@ Name:          HSGEP-Version:       0.1.3+Version:       0.1.4 Cabal-Version: >= 1.6 License:       BSD3 License-File:  LICENSE@@ -32,6 +32,8 @@    Build-Depends:   csv   Main-Is:         GEP/Examples/Regression/Driver.hs+  Other-Modules:   GEP.Examples.Regression.FitnessInput,+                   GEP.Examples.Regression.ArithmeticIndividual  Executable HSGEP_CADensity     Buildable:  False
README view
@@ -1,6 +1,6 @@ ==================================================== = HSGEP: Gene Expression Programming in Haskell    =-= Version 0.1.1                                    =+= Version 0.1.3                                    = = Author: Matthew Sottile (mjsottile@computer.org) = ==================================================== @@ -73,7 +73,7 @@ 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+./dist/build/HSGEP_Regression/HSGEP_Regression -i ./Examples/Regression/test1.in -f ./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.