Symbolic Regression

Robert B. Nachbar

Merck Research Laboratories
Rahway, NJ 07065
nachbar@merck.com

<< "GeneticProgramming`"

<< "SymbolicRegression`"

Getting Aquainted

GeneticProgramming

Scan[ToExpression["Message["<>#1<>"::usage]"]&, 
      Names["GeneticProgramming`*"]]

TableForm[Options[GeneticProgram] /. Rule -> List, 
      TableDepth -> 2]

TableForm[Options[DrawExpression] /. Rule -> List, 
      TableDepth -> 2]

SymbolicRegression

Scan[ToExpression["Message["<>#1<>"::usage]"]&, 
      Names["SymbolicRegression`*"]]

Find an expression for the series 5, 31, 121, 341, 781, 1555, 2801, 4681,…

Here is the list of the eight observations:

cases = {5, 31, 121, 341, 781, 1555, 2801, 4681};

The function set contains just the four arithmetic functions; nothing in the data warrants the use of trigonometric functions or logarithms.

funcs = {{plus, 2}, {subtract, 2}, {times, 2}, {divide, 2}}; terms := {i, Random[Integer, {-3, 3}]}

Standardized fitness is the sum of squared errors, and the success predicate will be a perfect fit.

successQ[stdFit_] := Or@@Thread[Chop[stdFit] == 0]

We will use the default population size of 500, and the genetic operators shown.

$RandomState = 
      1722390512031982838664439278867379071395469814210515694232999358804853513484143544577438881830585908077645270508242939771556331188501889814557977752061413112325637762185006070491739335729547813682997565971021788327043528887747307981048387414709529863025810152581337810951968485084987399696930320317272407666438493216168413988739183611534397943111323464317975516834468614488140226301777413763417155232245904980179281747295693117876167295450667282787450810308190586538437693770467465623276494019237185749079755163561055764822358367736604318005937296074936178041;

result = 
      GeneticProgram[cases, i, funcs, terms, GetData, SumSqr, successQ, 
        GeneticOperators 
          -> {{CrossOver, 2,  .85}, {Reproduce, 1,  .01}, {Mutate, 
              1,  .01}, {Perturb, 1,  .13}}];

Here is the best fitting expression and its depth:

b = BestOfRun /. result

Depth[Last[b]]

DrawExpression[Last[b], AspectRatio -> (210/400)];

Here is the simplified form of the expression:

be = Eval[Last[b]]

bestFit = Together[Expand[be /. PDivide -> Divide]]

Here is how one can use the “program” for new values of i:

bestFit /. i -> 9

bestFit /. i -> 12

Now, let's look at the runners up. Sometimes the numerically best solution does not make good physical, chemical, or biological sense for the problem, so it is always a good idea to examize plausible alternatives.

fp = Sort[Transpose[{FinalFit, FinalPop} /. result]]; First/@Take[fp, 5]

Here is the second best fitting expression and its depth:

sb = fp[[3]]

Depth[Last[sb]]

Here is the tree structure of the second best expression with the differences from the best highlighted with color:

DrawExpression[Last[sb], AspectRatio -> (160/350), 
      ExpressionStyle -> {{{2, 2}, Red}}];

Here is the simplified form of the second best expression:

sbe = Eval[Last[sb]]

secondBestFit = Together[Expand[sbe /. PDivide -> Divide]]