(***********************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which typically
will have the same name as this file except ending in ".nb" instead of
".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent to
using the Evaluate Initialiation Cells menu command in the front end.

DO NOT EDIT THIS FILE.  This entire file is regenerated automatically 
each time the parent Notebook file is saved in the Mathematica front end.
Any changes you make to this file will be overwritten.
***********************************************************************)







Needs["DiscreteMath`Tree`"];

Needs["Graphics`Graphics`"];


Needs["Graphics`Graphics3D`"];






numbers = Range[1,10];

constants = 
  Flatten[ numbers ];




patterns = 
{ 
  anExpression[], 
  anExpressionSequence[], 
  aBlank[],
  aSequence[],
  aNull[]
};



maxSequenceLength = 10;



















exprMutationRANKS =
{
  {_f,3},
  {_g,1},
  {_h,1},
  {_k,1}
};



exprCrossoverRANKS = 
{
  {_g,1},
  {_h,1},
  {_k,1}
};



exprShrinkRANKS =
{
  {_f,1},
  {_k,2}
};



exprPermutationRANKS =
{ 
  {_f,1},
  {_k,1}
};



exprEncapsulationRANKS =
{
  {_k,1},
  {_g,1},
  {_h,1}
};





ClearAll[generateExpr];

ClearAll[blankExpr];
ClearAll[constantExpr];
ClearAll[newExpr];

ClearAll[generateExprSequence];







generateExpr[
  x_Blank | 
  x_Condition | 
  x_Pattern,
  opts___
  
] := ((* Print["generateExpr (Blank, Condition, Pattern) ..."]; *)
      blankExpr[x,opts]);


generateExpr[
  x_Alternatives,
  opts___
  
] := ((* Print["generateExpr (Alternatives) ..."]; *)
      generateExpr[
        selectRandomElement[x /. Alternatives -> List],
        opts
      ]);

generateExpr[
  x_BlankSequence /; Length[x] > 0,
  opts___
  
] := ((* Print["generateExpr (BlankSequence, length > 0) ..."]; 
      Print[First[x]]; *)
      generateExprSequence[First[x],opts]);


generateExpr[
  x_BlankSequence /; Length[x] == 0,
  opts___
  
] := ((* Print["generateExpr (BlankSequence, length == 0) ..."]; *)
      generateExprSequence[BLANK,opts]);


generateExpr[
  x_ /; MemberQ[Union[Map[Head,constants]],Head[x]],
  opts___
  
] := ((* Print["generateExpr (constant) ..."]; *) x);


generateExpr[
  x_,
  opts___
  
] := ((* Print["generateExpr (Blank) ..."]; *)
      Map[generateExpr[#,opts]&,x,Heads -> False]);
      

generateExpr[
  DEFAULTTERM,
  opts___
  
] := ((* Print["generateExpr (DEFAULTTERM) ..."]; *)
      DEFAULTTERM);


generateExpr[
  opts___
  
] := ((* Print["generateExpr () ..."]; *)
      generateExpr[
       rouletteWheelSelection[
         GenerationPatterns /. {opts} /. Options[generateExpr],
         GenerationRanks /. {opts} /. Options[generateExpr]
       ]
      ]
     );
     

Options[generateExpr] :=
{
  GenerationPatterns -> Join[exprGenerationPATTERNS,patterns],
  GenerationRanks -> Join[exprGenerationRANKS,Table[1,{Length[patterns]}]]
};







generateExprSequence[BLANK,opts___] := 
  ((* Print["generateExprSequence (BLANK) ..."]; *)
   Table[
     doGenerateExprWithStart[_],
     {Random[Integer,{1,maxSequenceLength}]}
   ] /. List -> Sequence);


generateExprSequence[h_,opts___] := 
  ((* Print["generateExprSequence (Blank[]) ..."]; *)
   Table[
     FixedPoint[
       generateExpr[#,opts]&,
       selectRandomElementCond[
         GenerationPatterns /. {opts} /. Options[generateExprSequence],
         Blank[h],
         GenerationRanks /. {opts} /. Options[generateExprSequence]
       ],
       1
     ],
     {Random[Integer,{1,maxSequenceLength}]}
   ] /. List -> Sequence);


generateExprSequence[h_Alternatives,opts___] :=
  ((* Print["generateExprSequence (Alternatives) ..."]; *)
   Table[
     doFixedPoint[
       selectRandomElementCond[
         GenerationPatterns /. {opts} /. Options[generateExprSequence],
         h,
         GenerationRanks /. {opts} /. Options[generateExprSequence]
       ],
       IterationDepth /. {opts} /. Options[generateExprSequence],
       opts
     ],
     {Random[Integer,{1,maxSequenceLength}]}
   ] /. List -> Sequence);
   

Options[generateExprSequence] := 
{
  GenerationPatterns -> Join[exprGenerationPATTERNS,patterns],
  GenerationRanks -> Join[exprGenerationRANKS,Table[1,{Length[patterns]}]],
  
  IterationDepth -> Infinity
};





blankExpr[pattern_,opts___] := 
 ((* Print["blankExpr (Blank[]) ..."]; *)
  selectRandomElementCond[
    GenerationPatterns /. {opts} /. Options[blankExpr],
    pattern,
    GenerationRanks /. {opts} /. Options[blankExpr]]
 );
    

Options[blankExpr] := 
{
  GenerationPatterns -> exprGenerationPATTERNS,
  GenerationRanks -> exprGenerationRANKS
};





constantExpr[x_,opts___] := 
 ((* Print["consantExpr (Blank[]) ..."]; *)
  selectRandomElement[constants]
 );


Options[constantExpr] := 
{
  GenerationPatterns -> Join[exprGenerationPATTERNS,patterns],
  GenerationRanks -> Join[exprGenerationRANKS,Table[1,{Length[patterns]}]]
};































doGenerateExprWithStart::startSymbolNotFound =
  "Expression with head `1` not found.";
  
doGenerateExprWithStart::startPatternNotFound =
  "Expression with pattern `1` not found.";

doGenerateExprWithStart[

  startPattern_,
  opts___

] :=
  
  Module[
    {resultExpr,
     possiblePositions,
     selectedPosition,
     
     listOfExprPatterns =
       GenerationPatterns /. {opts} /. Options[doGenerateExprWithStart],
     exprPatternRanks =
       GenerationRanks /. {opts} /. Options[doGenerateExprWithStart],
          
     iterDepth =
       IterationDepth /. {opts} /. Options[doGenerateExprWithStart]
    },
          
    (**Print["doGenerateExprWithStart:"];**)
    protoPrint["-- startPattern: ",FullForm[startPattern]];
    protoPrint["-- iterDepth: ",iterDepth];
    
    If[Head[startPattern] === Blank,
    
      possiblePositions = 
        Position[listOfExprPatterns, startPattern];
      selectedPosition = selectRandomElement[possiblePositions];
      
      (**
      protoPrint["-- possiblePositions: ",possiblePositions];
      protoPrint["-- selectedPositions: ",selectedPositions];
      **)
      
      If[selectedPosition === {},
        Message[doGenerateExprWithStart::startPatternNotFound,
                startPattern];
        DEFAULTEXPRESSION,
      
        startExpr = Part[listOfExprPatterns,
                         selectedPosition /. List -> Sequence];
    
        protoPrint["possiblePositions = ",possiblePositions];
        protoPrint["selected          = ",selectedPosition];
        protoPrint["startExpr         = ",startExpr];
        
        doFixedPoint[startExpr,iterDepth,opts]
      ],
      
      doFixedPoint[startPattern,iterDepth,opts]
    ]
];

 Options[doGenerateExprWithStart] := 
 {
   GenerationPatterns -> exprGenerationPATTERNS,
   GenerationRanks -> exprGenerationRANKS,
   
   IterationDepth -> Infinity
 };
 

doFixedPoint::unstableExpr =
 "No stable expression found for start pattern `1` 
  after `2` trials.";

doFixedPoint[

  startPattern_,
  iterDepth_,
  opts___

] :=
  
Module[{maximumTrials =
          MaxTrials /. {opts} /. Options[doFixedPoint],
        trialCounter = 0,
        exprIsUnstable = True,
        resultExpr},

  (* First iterate for iterDepth iterations. *)
  (* Then check if expression is stable ...  *)
  (* If not, repeat generation process       *)
 
 While[trialCounter < maximumTrials && exprIsUnstable,
 
   resultExpr =
     FixedPoint[generateExpr[#,opts]&,startPattern,iterDepth];
   
   If[resultExpr ===
      FixedPoint[generateExpr[#,opts]&,resultExpr,1],
      exprIsUnstable = False
   ];
   
   trialCounter++;
   
 ]; (* end while *)
 
 If[exprIsUnstable === True,
   Message[doFixedPoint::unstableExpr,
     startPattern,maximumTrials];
   DEFAULTEXPRESSION,
   resultExpr
 ]
 
]; (* end module *)  

 Options[doFixedPoint] := 
 {
   MaxTrials -> 3
 };
 


















selectRandomElement[searchList_List] :=
  If[searchList === {},{},searchList[[Random[Integer,{1,Length[searchList]}]]]];
  

selectRandomElementCond::emptySearchList =
 "Searchlist is empty.";
 
selectRandomElementCond::noExpressionFound =
 "Cannot select expression with pattern `1` in `2`.";


selectRandomElementCond[searchList_List,
  pattern_,
  searchListAttr_List:{}] :=

  Module[{positionList,
          positionListAttributes,
          randomPosition,
          selectedElement},
    (**
    Print["selectRandomElementCond:"];
    Print["-- searchList: ",searchList];
    Print["-- pattern: ",pattern];
    Print["-- searchListAttr: ",searchListAttr];
    **)
    
    If[searchList === {},
       
       Message[selectRandomElementCond::emptySearchList];
       {},

       positionList = Position[searchList,pattern,1, Heads -> False];
       (* Print["positionList: ",positionList]; *)
       
       If[positionList === {},
         Message[selectRandomElementCond::noExpressionFound,FullForm[pattern],
           searchList];
         DEFAULTEXPRESSION,
         
         positionListAttributes = 
           Map[Part[searchListAttr,# /. List -> Sequence]&, positionList];
         (* Print["positionListAttributes: ",positionListAttributes]; *)

         randomPosition = rouletteWheelSelection[
                          positionList,
                          Flatten[positionListAttributes]];
         (* Print["randomPosition: ",randomPosition]; *)

         selectedElement = Part[searchList, 
                                randomPosition /. List -> Sequence];
       
         selectedElement
       ]
    ]
  ]; (* end module *)
  


rouletteWheelSelection[elements_List,attributes_List] :=

Module[ {members, totalsum, partsum, index, randpos},

	members		=	Length[attributes];
	totalsum	= 	Apply[Plus,attributes];
	partsum  	= 	attributes[[1]];
	index    	= 	1;
	
	randpos  	=	Random[Real,{0,N[totalsum]}];
	
	While[partsum < randpos && index < members,
	
		index = index + 1;
		partsum = partsum + attributes[[index]];
		
	]; (* end while *)

	elements[[index]]

]; (* end module *)












