(***********************************************************************
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.
***********************************************************************)











applykLRules[lsystem_LSystem] :=

    Module[{leftContexts, predecessors, rightContexts, successors,
            leftContextPositions, predecessorPositions, rightContextPositions,
            leftContPosition, rightContPosition,
	    skipPositions, substPositions = {},
	        
            skipLeft, skipRight,
	        
	    leftContextPresent = False,
	    rightContextPresent = False,
	    newAxiom},
	
    axiom      = Cases[lsystem,    _AXIOM,  Infinity];
    lRulesTerm = Cases[lsystem,    _LRULES, Infinity];
    lRules     = Cases[lRulesTerm, _LRule,  Infinity];

    numberOfRules = Length[lRules];

    (***
    Print["Axiom: ",axiom];
    Print["Number of rules: ",numberOfRules];

    Print["Rules: ", lRules]; 
    ***)

    leftContexts  = Cases[lRules, _LEFT,  Infinity];
    predecessors  = Cases[lRules, _PRED,  Infinity];
    rightContexts = Cases[lRules, _RIGHT, Infinity];
    successors    = Cases[lRules, _SUCC,  Infinity];

    (***
    Print["leftContexts: ", leftContexts];
    Print["predecessors: ", predecessors];
    Print["rightContexts: ", rightContexts];
    Print["successors: ", successors];
    ***)

    rules = {};
    rules = MapThread[ First[#1] :> Evaluate[First[#2]] &, 
                       {predecessors,successors}];
	
    (***
    Print["rules: ",rules];
    ***)


    skipPositions = Position[axiom, First[skipPattern]];
   	
    Do[
	AppendTo[substPositions,{}];
		

	lWord = predecessors[[rule]] /. PRED[x_] :> x;

        (***
        Print["lWord: ",lWord];
        ***)

	predecessorPositions = Position[axiom,lWord]; 
		

	(** Check for application of L-Rules ... --------------------------------- **)
		
	Do[
            {collectedLeftContexts, 
             collectedLeftContextPositions,
             collectedRightContexts,
             collectedRightContextPositions} =

              getLeftRightContexts[
                axiom,
                predecessorPositions[[i]],
                Length[leftContexts[[rule]]],
                Length[rightContexts[[rule]]]
              ];
                     
            (***
            Print["i: ",i];
            Print["collectedLeftContexts: ", collectedLeftContexts];
            Print["collectedRightContexts: ", collectedRightContexts];
            Print["collectedLeftContextPositions: ", collectedLeftContextPositions];
            Print["collectedRightContextPositions: ", collectedRightContextPositions];

            Print["leftContexts as list: ", leftContexts[[rule]] /. LEFT -> List];
            Print["rightContexts as list: ", rightContexts[[rule]] /. RIGHT[x__] -> List[x]];
            ***)

            leftContextIsOK = Count[{collectedLeftContexts},
                                    leftContexts[[rule]] /. LEFT[x___] -> List[x]];
            rightContextIsOK = Count[{collectedRightContexts},
                                     rightContexts[[rule]] /. RIGHT[x___] -> List[x]];
  
            If[leftContextIsOK > 0 && rightContextIsOK > 0,
	      
              (*** Print["Contexts are OK. Substitution follows."]; ***)       			        
              substPositions[[rule]] = 
                Join[substPositions[[rule]],
                 {{collectedLeftContextPositions,
                   predecessorPositions[[i]],
                   collectedRightContextPositions}}]
              
              (*** Print["Contexts are NOT OK. No substitution will follow."]; ***)
            ],

            {i,1,Length[predecessorPositions]}
	],
	
    	{rule,1,numberOfRules}

    ]; (* end do *)


    (*** Print["substPositions: ",substPositions]; ***)


    (** Now perform the collected substitutions **)
	
    newAxiom = axiom;
	

    Do[
	  Do[
            leftContPositions    = substPositions[[rule,k,1]];
            predecessorPosition  = substPositions[[rule,k,2]];
            rightContPositions   = substPositions[[rule,k,3]];

            (**
            Print["Rule: ",rule,": ",
              leftContPositions,predecessorPosition,rightContPositions];
            **)


            If[leftContPositions == {} && rightContPositions == {}, (* apply an 0L-rule *)

               (** Print["OL-Rule"]; **)
               oldTerm = PRED[Part[axiom,predecessorPosition /. List[x___] -> Sequence[x]]];

               substRule = predecessors[[rule]] :> Evaluate[successors[[rule]]];

               newTerm = oldTerm /. substRule;

              (***
               Print["oldTerm: ",oldTerm];
               Print["substRule: ",substRule];
               Print["newTerm: ",newTerm];
               ***)
            ];

            

            If[leftContPositions != {} && rightContPositions == {}, (* apply a kL-rule (left context) *)

               (** Print["kL-Rule (left context)"]; **)
               oldTerm = tmpSymbol[Map[LEFT[Part[axiom,# /. List[x___] -> Sequence[x]]]&,
                                       leftContPositions] /. List[x___] -> Sequence[x],
                                   PRED[Part[axiom,predecessorPosition /. List[x___] -> Sequence[x]]]
                                  ];

	       substRule = {tmpSymbol[x:leftContexts[[rule]],
                                      predecessors[[rule]]]  :> Evaluate[successors[[rule]]]};

               newTerm = oldTerm /. substRule;

               (***
               Print["oldTerm: ",oldTerm];
               Print["substRule: ",substRule];
               Print["newTerm: ",newTerm];
               ***)
            ];


            If[leftContPositions == {} && rightContPositions != {}, (* apply a kL-rule (right context) *)

               (** Print["kL-Rule (right context)"]; **)
               oldTerm = tmpSymbol[PRED[Part[axiom,predecessorPosition /. List[x___] -> Sequence[x]]],
                                   Map[RIGHT[Part[axiom,# /. List[x___] -> Sequence[x]]]&,
                                       rightContPositions] /. List[x___] -> Sequence[x]
                                  ];

	       substRule = {tmpSymbol[predecessors[[rule]],
	                              y:rightContexts[[rule]]] :> Evaluate[successors[[rule]]]};

               newTerm = oldTerm /. substRule;

               (***
               Print["oldTerm: ",oldTerm];
               Print["substRule: ",substRule];
               Print["newTerm: ",newTerm];
               ***)
            ];


            If[leftContPositions != {} && rightContPositions != {},

	          (** Print["(m,n)L-Rule (left and right context)"]; **)
	          oldTerm = 
		          tmpSymbol[
		            Map[LEFT[Part[axiom,# /. List[x___] -> Sequence[x]]]&,
                       leftContPositions] /. List[x___] -> Sequence[x], 
		            PRED[Part[axiom,predecessorPosition /. List[x___] -> Sequence[x]]],
	    	        (* Part[axiom,substPositions[[rule,k,3]] /. List[x___] -> Sequence[x]], *)
                    Map[RIGHT[Part[axiom,# /. List[x___] -> Sequence[x]]]&,
                        rightContPositions] /. List[x___] -> Sequence[x]
		          ];
	          (** Print["oldTerm: ",oldTerm]; **)

	          substRule = {tmpSymbol[x:leftContexts[[rule]],
	                              predecessors[[rule]],
	                              y:rightContexts[[rule]]] :> Evaluate[successors[[rule]]]};

	           newTerm = oldTerm /. substRule;

               (**
               Print["oldTerm: ",oldTerm];
               Print["substRule: ",substRule];
               Print["newTerm: ",newTerm];
               **)
            ];


	        (** Print["newTerm: ",newTerm]; Print[" "]; **)
	
	        newAxiom = ReplacePart[newAxiom,newTerm,substPositions[[rule,k,2]]];

            (*** Print["newAxiom: ",newAxiom]; ***)

            newAxiom = postProcessingFunction[newAxiom], 

	    {k,1,Length[substPositions[[rule]]]}
	  ],
	  {rule,1,Length[substPositions]}
    ];
	
    newAxiom = First[finalPostProcessingFunction[newAxiom]]
   		
]; (* end module *)







(** Get the positions of the left and right context *)

getLeftRightContextPositions[skipPositions_, predecessorPosition_,
                             leftContextPositions_, rightContextPositions_] :=

    Module[{skipLeft, skipRight, leftContPosition, rightContPosition},

	{skipLeft, skipRight} = 
	    getLeftRightSkips[skipPositions, predecessorPosition];

	leftContPosition = 
	    Cases[leftContextPositions,
		  Join[Drop[predecessorPosition,-1],
		       {Last[predecessorPosition]-skipLeft}]];

	rightContPosition = 
	    Cases[rightContextPositions,
		  Join[Drop[predecessorPosition,-1],
		       {Last[predecessorPosition]+skipRight}]];

	(** Print["left-right-cont-Positions: ",leftContPosition, rightContPosition]; **)

	{If[leftContPosition != {}, First[leftContPosition], {}], 
	 If[rightContPosition != {}, First[rightContPosition], {}]}

    ]; (* end module *)





(** Get the positions of possible left and right contexts **)

getLeftRightSkips[skipPositions_, predecessorPosition_] :=

    Module[{skipLeft = 1,
	    skipRight = 1
	   },
			
	While[
	    Count[skipPositions,
	    Join[Drop[predecessorPosition,-1],
	         {Last[predecessorPosition]-skipLeft}]] > 0,
						      
	    skipLeft++;
				
	]; (* end while *)
				
	While[
	    Count[skipPositions,
	    Join[Drop[predecessorPosition,-1],
	         {Last[predecessorPosition]+skipRight}]] > 0,
						      
	    skipRight++;
			
	]; (* end while *)
		
	{skipLeft, skipRight}
		
    ]; (* end module *)
	




(** Print the L-rules and its axiom **)

printLRules[axiom_, lRules_] :=

    Module[{leftContexts, predecessors, rightContexts, successors,
            leftContextString, predecessorString, rightContextString, successorString},

	leftContexts  = Map[ #[[1]] &, lRules];
	predecessors  = Map[ #[[2]] &, lRules];
	rightContexts = Map[ #[[3]] &, lRules];
	successors    = Map[ #[[4]] &, lRules];

	Print["Axiom: ",axiom];
	Print[" "];

	Do[
	    Print["Rule ",rule,": ",leftContexts[[rule]]," < ",
                                    predecessors[[rule]]," > ",
	                            rightContexts[[rule]]," -> ",
	                            successors[[rule]]
	    ],
	    {rule,1,Length[predecessors]}
	];

    ]; (* end module *)

	






(* Iterative application of L-rules **)

runKLSystem[lsys_LSystem, iterations_Integer] :=

  Module[
    {axiom = Part[lsys,Apply[Sequence,First[Position[lsys,AXIOM[___]]]]],
     lrules = Part[lsys,Apply[Sequence,First[Position[lsys,LRULES[___]]]]]
    },
    
    NestList[applykLRules[LSystem[#,lrules]]&, axiom, iterations]
  ];







(** Definitions for left contexts ... ------------------------------- **)

(** ----------------------------------------------------------------- **)

getLeftContext::usage =
"getLeftContext[TERM,POSITION]:\n
 Returns the left context and the left context position of a subterm\n
 at position POSITION in term TERM.\n
 Note: POSITION must be a proper position within term TERM.\n
";

getLeftContext[term_, position_] :=

  Module[{sTerm, sTermArity},
  
    If[position == {}, Return[{{},{}}]];

    lastPositionIndex = Last[position];
    restPosition = Drop[position, -1];
    
    If[ Length[position] == 1, (* position is from level one *)
      sTerm = term; levelIsOne = True,
      sTerm = term[[restPosition /. List -> Sequence]]; levelIsOne = False
    ];
    sTermArity = Length[sTerm];
    
    Switch[ Last[position],
    
      1, If[levelIsOne == True, 
            {leftContext,leftContextPosition} = {{},{}},
            {leftContext,leftContextPosition} = getLeftContext[term,restPosition]],
            
      _, leftContextPosition = Append[restPosition, lastPositionIndex-1];
         leftContext = term[[leftContextPosition /. List -> Sequence]]
    ];
    
    {leftContext,leftContextPosition}
  ];
  
  
(** ----------------------------------------------------------------- **)

getLeftContextList::usage =
"getLeftContextList[TERM,POSITION,N]:\n
 Returns the left contexts and the left context positions\n
 (up to a length of N) of a subterm at position POSITION in term TERM.\n
 Note: POSITION must be a proper position within term TERM.\n
";

getLeftContextList[term_, position_, n_] :=

  Module[{},
  
    NestList[getLeftContext[term, #[[2]]]&, {{},position}, n]
  ];
  










(** Definitions for right contexts ... ------------------------------- **)

(** ----------------------------------------------------------------- **)

getRightContext::usage =
"getRightContext[TERM,POSITION]:\n
 Returns the right context and the right context position of a subterm\n
 at position POSITION in term TERM.\n
 Note: POSITION must be a proper position within term TERM.\n
";

getRightContext[term_, position_] :=

  Module[{sTerm, sTermArity},
  
    If[position == {}, Return[{{},{}}]];
    
    lastPositionIndex = Last[position];
    restPosition = Drop[position, -1];
    
    If[ Length[position] == 1, (* position is from level one *)
      sTerm = term; levelIsOne = True,
      sTerm = term[[restPosition /. List -> Sequence]]; levelIsOne = False
    ];
    sTermArity = Length[sTerm];
    
    Switch[ Last[position],
    
      sTermArity, 
         If[levelIsOne == True, 
            {rightContext,rightContextPosition} = {{},{}},
            {rightContext,rightContextPosition} = getRightContext[term,restPosition]],
            
      _, rightContextPosition = Append[restPosition, lastPositionIndex+1];
         rightContext = term[[rightContextPosition /. List -> Sequence]]
    ];
    
    {rightContext,rightContextPosition}
  ];



(** ----------------------------------------------------------------- **)

getRightContextList::usage =
"getRightContextList[TERM,POSITION,N]:\n
 Returns the right contexts and the right context positions\n
 (up to a length of N) of a subterm at position POSITION in term TERM.\n
 Note: POSITION must be a proper position within term TERM.\n
";

getRightContextList[term_, position_, n_] :=

  Module[{},
  
    NestList[getRightContext[term, #[[2]]]&, {{},position}, n]
  ];
  









(** Definitions for left and right contexts ... --------------------- **)

(** ----------------------------------------------------------------- **)

getLeftRightContexts[term_, 
                     position_List, 
                     leftContextSize_Integer,
                     rightContextSize_Integer] :=

  Module[{leftContextList, rightContextList},

    leftContextList =
      Reverse[Drop[getLeftContextList[axiom, position, leftContextSize],1]];
    rightContextList =
      Reverse[Drop[getRightContextList[axiom, position, rightContextSize],1]];

   {
    Map[First[#]&,leftContextList],
    Map[Last[#]&,leftContextList],
    Map[First[#]&,rightContextList],
    Map[Last[#]&,rightContextList]
   }

  ];






postProcessingFunction = (#)&;

finalPostProcessingFunction = (# //. SUCC[x___] -> x)&;
