%mathpiper,name="main",def="UnburyUnknown?;SolveSteps;MetaLevelMain;Otherside;CanEvaluate?;Evaluate;EvaluateDo;TexFormNoDollarSigns;ToLatex;HigherUnknowns;LineForm"

Retract("SolveSteps", All);

//Note:tk:Perhaps create a function called Value that obtains the value that is assigned to a variable
// without evaluating the variable first.

LocalSymbols(stepsList, maximumSteps, )
{
//===================================================================
// currentStep := 0;

StepAppend(stepInfo) :=
{
    If(Assigned?(stepsList))
    {
        Append!(stepsList, stepInfo);
        
        If(maximumSteps !=? Infinity)
        {
            If(Length(stepsList) >? maximumSteps)
            {
                ExceptionThrow("MAXIMUM?STEPS?REACHED", "The maximum number of steps have been reached.");
            }
        }
    }


//Echo("***** STEP: ", currentStep++);
//Echo();
}


MetaLevelMain(equation, unknown, options) :=
{
    Local(rest, currentEquation, path, showTree, stepInfo, match?, metamethodsAll, metamethodsUndefine);
    
    metamethodsAll :=
    [
        UNDEFINE?UNARY?MINUS, //"UndefineNegationOperators",
        UNDEFINE?BINARY?MINUS, //"UndefineSubtractionOperators",
        "Evaluate",
        ELIMINATE?UNKNOWN, //"EliminateUnknown",
        MOVE?RIGHTMOST, //"MoveUnknownsToRightmostPositions",
        HIGHER?UNKNOWNS, //"HigherUnknowns",
        "CloserUnknownHorizontal",
        "CloserUnknownPath",
        MAKE?COEFFICIENT?EXPLICIT, //"MakeCoefficientsExplicit",
    ];
    
    metamethodsUndefine :=
    [
        "UndefineNegationOperators",
        "UndefineSubtractionOperators",
    ];

    // Global.
    stepsList := [];
    
    // Remove all negation operators that have numbers as operands.
    equation := (equation /: [-$ q_Number? <- SubtractN(0,1) * q]);
    
    stepInfo := [];
    stepInfo["ReplacementExp"] := None == None;
    stepInfo["RuleName"] := "Equation";
    stepInfo["DescriptionObjectLevel"] := "The original equation.";
    stepInfo["OriginalExp"] := [equation, "", a_Atom?::(!? UnderscoreConstant?(a)), "ORANGE"];
    stepInfo["Unknown"] := unknown;

    StepAppend(stepInfo);
    

    If(options["ControlRandom"] =? True)
    {
        equation := StepRandom(equation, unknown, options);
    }
    Else
    {
        [equation, match?] := MoveUnknownsToLHS(equation, unknown);
       
        If(options["UnburySimple"] !=? True)
        {
            equation := EliminateCopiesOfUnknown(equation, unknown, metamethodsAll, True);
        }

        If(OccurrencesCount(equation, unknown) =? 1)
        {
            equation := EliminateCopiesOfUnknown(equation, unknown, metamethodsUndefine, False);
            
            equation := UnburyUnknown(equation, unknown);
        }
        Else
        {
            equation := Undefined;
        
            stepInfo := [];
            stepInfo["ReplacementExp"] := [equation, [["", _, "ORANGE"]]];
            stepInfo["RuleName"] := "Failed multiple occurrence method.";
            stepInfo["DescriptionObjectLevel"] := "Failed multiple occurrence method.";
            stepInfo["OriginalExp"] := [unknown, []];
            
            StepAppend(stepInfo);

        }
        
        [equation, match?] := Evaluate(equation, unknown, 2, "Prepatory");
    }
    

}




UnburyUnknown(equation, unknown) :=
{
    If(Verbose?())
    {
        Echo("UnburyUnknown");
    }
    
    Local(path, currentEquation, stepInfo);
    
    stepInfo := [];

    //stepInfo["Method"] := "Unbury";
    //StepAppend(stepInfo);

    // The Rest here removes the effect of the '==' operator on the position.
    path := Rest(PositionStringToList(First(PositionsPattern2(equation, unknown))));

    ForEach(pathNumber, path)
    {
        /*
            Todo:tk: The division in the following example causes a list of equations to be returned:
            In> Show(StepsView(SolveSteps( ((a_^2 * 7/b_)/c_^3 * d_^2)/ 5* e_ == f_, b_) , ShowTree: True))
            Code needs to be added here that will handle a list of equations.
        */

        equation := Otherside(pathNumber, equation);
    }
   
    equation;
}




StepRandom(equation, unknown, options) :=
{
    If(Verbose?())
    {
        Echo("StepRandom");
    }
    
    Local(lhs, rhs, rhsString, pattern, positions, position, negativeOne, equationWithSubstitution, lhsCopy, rhsCopy, oldEquation, rulesCount, match?, stepsToTake);
    
    Local(equationWithSubstitution,  pattern, position, positions, stepInfo, match?);// rule, rules,
    
    match? := False;
    
    rules := MapSingle("PopBack", Select(?rulebaseElementaryAlgebra, Lambda([rule], rule[2]["Type"] !=? None &? Contains?(rule[2] ["Type"], TEXTBOOK) )));
    
    oldEquation := None;
    
    ?loopCount := 0;
    
    stepsToTake := Decide(options["StepsToTake"] =? None, 5, options["StepsToTake"]);
    
    rulesCount := Length(rules);
    
    While(Length(stepsList) <=? stepsToTake)
    {
        oldEquation := equation;

        //[equation, match?] := Apply(?metamethods[RandomInteger(methodCount)], [equation, unknown, 1]);
        
        rule := rules[RandomInteger(rulesCount)];
        
        pattern := rule["Head"];
    
        positions := PositionsPattern(equation, pattern);
    
        positions := Decide(positions =? [], positions, Rest(positions));
        
        If(Length(positions) >? 0)
        {
            match? := True;
            
            position := positions[RandomInteger(Length(positions))];
        
            equationWithSubstitution := SubstitutePosition(equation, position, pattern, First(rule["Body"]));
    
            stepInfo := [];
            stepInfo["Head"] := rule["Head"];
            stepInfo["Body"] := rule["Body"];
            stepInfo["ReplacementExp"] := [equationWithSubstitution, [[position, _, "GREEN"]] ];
            stepInfo["RuleName"] := rule["RuleName"];
            stepInfo["DescriptionObjectLevel"] := rule["DescriptionObjectLevel"];
            stepInfo["OriginalExp"] := [equation, [[position, _, "ORANGE"]]];
            stepInfo["Position"] := position;
            stepInfo["ManualSequence"] := rule["ManualSequence"];
            
            StepAppend(stepInfo);
            
            equation := equationWithSubstitution;
        }

//Echo(?metamethods[methodIndex], ", ", match?, ", ", methodIndex);
        
        ?loopCount++;
    }
    
    equation;
}




EliminateCopiesOfUnknown(equation, unknown, metamethods, stopWhenSingleOccurence?) :=
{
    If(Verbose?())
    {
        Echo("EliminateCopiesOfUnknown");
    }
    
    Local(lhs, rhs, rhsString, pattern, positions, position, negativeOne, equationWithSubstitution, lhsCopy, rhsCopy, oldEquation, methodCount, methodIndex, match?, metaMethod);
    
    oldEquation := None;
    
    ?loopCount := 0;
    
    methodCount := Length(metamethods);
    
    methodIndex := 1;
    
    While(methodIndex <=? methodCount) //?loopCount <? 200 &? 
    {
        oldEquation := equation;

        metaMethod := metamethods[methodIndex];
        
        If(String?(metaMethod))
        {
            [equation, match?] := Apply(metaMethod, [equation, unknown, 1, metaMethod]);
        }
        Else
        {
            [equation, match?] :=  MetaLevelProcess(equation, unknown, 1, metaMethod);
        }
        
        If(stopWhenSingleOccurence? &? OccurrencesCount(equation, unknown) =? 1)
        {
            Break();
        }

        // Echo(metamethods[methodIndex], ", ", match?, ", ", methodIndex, equation);
        
        If(match?)
        {    
            methodIndex := 1;
        }
        Else
        {
            methodIndex := methodIndex + 1;
        }
        
        ?loopCount++;
    }
    
    equation;
}




MetaLevelProcess(equation, unknown, side, structuralEffect) :=
{
    Local(equationWithSubstitution, rules, head, guard, position, positions, stepInfo, match?, metaLevelRule);
    
    metaLevelRule := ?rulebaseMetaLevel[structuralEffect];

    If(Verbose?())
    {
        Echo(metaLevelRule["RuleName"]);
    }
    
    match? := False;
    
    rules := MapSingle("PopBack", Select(?rulebaseElementaryAlgebra, Lambda([rule], rule[2]["StructuralEffect"] !=? None &? Contains?(rule[2] ["StructuralEffect"], structuralEffect) )));
    
    ForEach(rule, rules)
    {
        guard := Substitute(_unknown, unknown) First(rule["Guard"]);
        
        head := `( @rule["Head"]::@guard );
        
        positions := PositionsPattern(equation, head);

        If(Length(positions) >? 0)
        {
            match? := True;
            
            position := First(positions);
    
            equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"]) );    
    
            stepInfo := [];
            stepInfo["Method"] := metaLevelRule["RuleName"];
            stepInfo["Head"] := rule["Head"];
            stepInfo["Body"] := rule["Body"];
            stepInfo["ReplacementExp"] := [equationWithSubstitution, [[position, _, "GREEN"]] ];
            stepInfo["RuleName"] := rule["RuleName"];
            stepInfo["DescriptionObjectLevel"] := rule["DescriptionObjectLevel"];
            stepInfo["OriginalExp"] := [equation, [[position, _, "ORANGE"]]];
            stepInfo["Position"] := position;
            stepInfo["ManualSequence"] := rule["ManualSequence"];
            
            StepAppend(stepInfo);
            
            equation := equationWithSubstitution;
            
            Break();
        }
    }
    
    [equation, match?];
}




MoveUnknownsToLHS(equation, unknown) := 
{
    If(Verbose?())
    {
        Echo("MoveUnknownsToLHS");
    }
    
    Local(equationWithSubstitution, rule, pattern, position, positions, patternVariables, q, r, stepInfo, match?);
    
    match? := False;
    
    rule := ?rulebaseElementaryAlgebra["Otherside RHS"];

    pattern := `(@rule["Head"]::(OccurrencesCount(r, @unknown) >? 0));

    positions := PositionsPattern(equation, pattern);

    If(Length(positions) >? 0)
    {
        match? := True;
   
        position := First(positions);
        
        patternVariables := [];
        equationWithSubstitution := SubstitutePosition(equation, position, pattern, First(rule["Body"]), patternVariables );

        q := patternVariables[q_];
        r := patternVariables[r_];

        stepInfo := [];
        stepInfo["Method"] := "Preperation";
        stepInfo["Head"] := rule["Head"];
        stepInfo["Body"] := rule["Body"];
        stepInfo["ReplacementExp"] := [equationWithSubstitution, [["1", a_Atom?, "GREEN"], ["1,2", _, "GREEN"]] ];
        stepInfo["RuleName"] := rule["RuleName"];
        stepInfo["DescriptionObjectLevel"] := Eval(First(rule["DescriptionObjectLevel"]));
        stepInfo["OriginalExp"] := [q -$ r ==$ r -$ r, [["1", a_Atom?, "ORANGE"], ["1,2", _, "ORANGE"], ["2", a_Atom?, "ORANGE"], ["2,2", _, "ORANGE"]] ];
        stepInfo["Position"] := position;
        stepInfo["ManualSequence"] := rule["ManualSequence"];
        
        StepAppend(stepInfo);
        
        equation := equationWithSubstitution;
    }
    
    [equation, match?];
}




CloserUnknownPath(equation, unknown, side, metaMethodName) :=
{
    If(Verbose?())
    {
        Echo("CloserUnknownPath");
    }
    
    Local(equationWithSubstitution, rules, head, distanceBefore, distanceAfter, subexpressionBefore, subexpressionDistanceBefore, subexpressionAfter, subexpressionDistanceAfter, position, positions, stepInfo, breakForEach, match?);
    
    match? := False;
    
    rules := MapSingle("PopBack", Select(?rulebaseElementaryAlgebra, Lambda([rule], rule[2]["StructuralEffect"] !=? None &? Contains?(rule[2] ["StructuralEffect"], CLOSER?UNKNOWNS?PATH) )));
    
    breakForEach := False;
    
    ForEach(rule, rules)
    {
        head :=  rule["Head"];
        
        positions := PositionsPattern(equation, head);

        While(Length(positions) >? 0)
        {        
            position := First(positions);
            
            subexpressionBefore := PositionGet((equation), position);
            
//    aa := (PositionsPattern(subexpressionBefore, unknown));

            subexpressionDistanceBefore := SymbolPathDistanceTotal(subexpressionBefore, unknown);
            
            distanceBefore := SymbolPathDistanceTotal(equation, unknown);
    
            equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"]) );
            
            subexpressionAfter := PositionGet((equationWithSubstitution), position);
            
//    bb := (PositionsPattern(subexpressionAfter, unknown));
    
            subexpressionDistanceAfter := SymbolPathDistanceTotal(subexpressionAfter, unknown);
            
            distanceAfter := SymbolPathDistanceTotal(equationWithSubstitution, unknown);

            If(distanceAfter <? distanceBefore |? subexpressionDistanceAfter <? subexpressionDistanceBefore)
            {    //todo:tk:metalevel.
                match? := True;
                
                stepInfo := [];
                stepInfo["Method"] := metaMethodName;
                stepInfo["Head"] := rule["Head"];
                stepInfo["Body"] := rule["Body"];
                stepInfo["ReplacementExp"] := [equationWithSubstitution, [[position, _, "GREEN"]] ];
                stepInfo["RuleName"] := rule["RuleName"];
                stepInfo["DescriptionObjectLevel"] := rule["DescriptionObjectLevel"];
                stepInfo["OriginalExp"] := [equation, [[position, _, "ORANGE"]]];
                stepInfo["Position"] := position;
                stepInfo["ManualSequence"] := rule["ManualSequence"];
                stepInfo["Path"] := PositionsPattern(equation, unknown);
                stepInfo["Unknown"] := unknown;
                
                StepAppend(stepInfo);
            
                equation := equationWithSubstitution;
                
                breakForEach := True;
                
                Break();
            }
            Else
            {
                PopFront(positions);
            }
        }
        
        If(breakForEach =? True)
        {
            Break();
        }
    }
    
    [equation, match?];
}




CloserUnknownHorizontal(equation, unknown, side, metaMethodName) :=
{
    If(Verbose?())
    {
        Echo("CloserUnknownHorizontal");
    }

    Local(equationWithSubstitution, rules, head, guard, position, positions, stepInfo, match?);
    
    match? := False;
    
    rules := MapSingle("PopBack", Select(?rulebaseElementaryAlgebra, Lambda([rule], rule[2]["StructuralEffect"] !=? None &? Contains?(rule[2] ["StructuralEffect"], CLOSER?UNKNOWNS?HORIZONTAL) )));
    
    ForEach(rule, rules)
    {
        guard := Substitute(_unknown, unknown) First(rule["Guard"]);
        
        head := `( @rule["Head"]::@guard );
        
        positions := PositionsPattern(equation, head);

        If(Length(positions) >? 0)
        {
            match? := True;
            
            position := First(positions);
    
            equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"]) );    
    
            stepInfo := [];
            stepInfo["Method"] := metaMethodName;
            stepInfo["Head"] := rule["Head"];
            stepInfo["Body"] := rule["Body"];
            stepInfo["ReplacementExp"] := [equationWithSubstitution, [[position ~ "," ~ rule["Subposition"], _, "GREEN"]] ];
            stepInfo["RuleName"] := rule["ManualRuleEquivalent"];
            stepInfo["MetaRuleName"] := rule["RuleName"];
            stepInfo["DescriptionObjectLevel"] := rule["DescriptionObjectLevel"];
            stepInfo["OriginalExp"] := [equation, [[position ~ "," ~ rule["Subposition"], _, "ORANGE"]]];
            stepInfo["Position"] := position ~ "," ~ rule["Subposition"];
            stepInfo["MetaPosition"] := position;
            stepInfo["ManualSequence"] := ?rulebaseElementaryAlgebra[rule["ManualRuleEquivalent"]]["ManualSequence"];
            
            StepAppend(stepInfo);
            
            equation := equationWithSubstitution;
            
            Break();
        }
    }
    [equation, match?];
}




Otherside(side, equation) :=
{
    If(Verbose?())
    {
        Echo("Otherside");
    }

    Local(equationWithSubstitution, position, positions, rules, head, guard, patternVariables, term1, term2, lhs, rhs, stepInfo, q, r, manualRule1, manualRule2);    
    
    rules := MapSingle("PopBack", Select(?rulebaseElementaryAlgebra, Lambda([rule], rule[2]["StructuralEffect"] !=? None &? Contains?(rule[2] ["StructuralEffect"], OTHERSIDE) )));
    
    manualRule1 := ?rulebaseElementaryAlgebra["Otherside 1 [=]"];
    
    manualRule2 := ?rulebaseElementaryAlgebra["Otherside 2 [=]"];
    
    ForEach(rule, rules)
    {
        If(side =? rule["Side"])
        {
            head := `( @rule["Head"] );

            positions := PositionsPattern(equation, head);
                
            If(Length(positions) >? 0)
            {
                position := First(positions);
                
                If(rule["RuleName"] !=? "DivideRightOtherside")
                {
                    patternVariables := [];
    
                    equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"]), patternVariables);
                    
                    q := patternVariables[q_];
                    r := patternVariables[r_];
                    lhs := patternVariables[lhs_];
                    rhs := patternVariables[rhs_];
    
                    stepInfo := [];
                    stepInfo["Head"] := rule["Head"];
                    stepInfo["Body"] := rule["Body"];
                    stepInfo["ReplacementExp"] := [equationWithSubstitution, [] ]; // todo:tk: [["1", a_Atom?::(!? UnderscoreConstant?(a)), "RED"]]
                    stepInfo["RuleName"] := rule["RuleName"];
                    stepInfo["DescriptionObjectLevel"] := Eval(First(rule["DescriptionObjectLevel"]));
                    stepInfo["OriginalExp"] := Eval(First(rule["Before"]));
                    stepInfo["Position"] := position;
                    stepInfo["ManualSequence"] := Decide(side =? 1, manualRule1["ManualSequence"], manualRule2["ManualSequence"]);
                    
                    StepAppend(stepInfo);
                }
                Else
                {
                    // First substep.
                    patternVariables := [];
    
                    equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"])[1], patternVariables);
                    
                    q := patternVariables[q_];
                    r := patternVariables[r_];
                    lhs := patternVariables[lhs_];
                    rhs := patternVariables[rhs_];
    
                    stepInfo := [];
                    stepInfo["Head"] := rule["Head"];
                    stepInfo["Body"] := ListToFunction([ToAtom("'"), First(rule["Body"])[1]]);
                    stepInfo["ReplacementExp"] := [equationWithSubstitution, [] ]; // todo:tk: [["1", a_Atom?::(!? UnderscoreConstant?(a)), "RED"]]
                    stepInfo["RuleName"] := rule["RuleName"];
                    stepInfo["DescriptionObjectLevel"] := Eval(First(rule["DescriptionObjectLevel"])[1]);
                    stepInfo["OriginalExp"] := Eval(First(rule["Before"])[1]);
                    stepInfo["Position"] := position;
                    stepInfo["ManualSequence"] := Decide(side =? 1, manualRule1["ManualSequence"], manualRule2["ManualSequence"]);
                    
                    StepAppend(stepInfo);
                    

                    // Second substep.
                    patternVariables := [];
    
                    equationWithSubstitution := SubstitutePosition(equation, position, head, First(rule["Body"])[2], patternVariables);
                    
                    q := patternVariables[q_];
                    r := patternVariables[r_];
                    lhs := patternVariables[lhs_];
                    rhs := patternVariables[rhs_];
    
                    stepInfo := [];
                    stepInfo["Head"] := rule["Head"];
                    stepInfo["Body"] := ListToFunction([ToAtom("'"), First(rule["Body"])[2]]);
                    stepInfo["ReplacementExp"] := [equationWithSubstitution, [] ]; // todo:tk: [["1", a_Atom?::(!? UnderscoreConstant?(a)), "RED"]]
                    stepInfo["RuleName"] := rule["RuleName"];
                    stepInfo["DescriptionObjectLevel"] := Eval(First(rule["DescriptionObjectLevel"])[2]);
                    stepInfo["OriginalExp"] := Eval(First(rule["Before"])[2]);
                    stepInfo["Position"] := position;
                    stepInfo["ManualSequence"] := Decide(side =? 1, manualRule1["ManualSequence"], manualRule2["ManualSequence"]);
                    
                    StepAppend(stepInfo);
                }

                equation := equationWithSubstitution;
                
                Break();
            }
            
        }

    }

    equation;
}




CanEvaluate?(exp) :=
{
    Local(result);
    
    result := (exp /:
       [
         (q_ ^$ r_)::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? []) <- True,
         (q_ /$ r_)::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? [] &? r !=? 0 ) <- True, //&? (Number?(q) &? Number?(r))
         (q_ *$ r_)::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? []) <- True,
         // (q_ *$ (r_ *$ s_))::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? []) <- True, // todo:tk:short circuit the associative law of *.
         (q_ -$ r_)::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? []) <- True,
         (q_ +$ r_)::(UnderscoreConstantsAll(q) =? [] &? UnderscoreConstantsAll(r) =? []) <- True,
         //(-$ q_)::(UnderscoreConstantsAll(q) =? [] &? !? Number?(q)) <- True
       ]);
       
    Decide(result, True, False);
}




EvaluateDo(exp) :=
{
    (exp /::
       [
         "Exponentation" # q_ ^$ r_ <- q^r,
         "Negation" # -$ q_ <- (SubtractN(0,1) * q),
         //SinD_(q_Number?) <- SinD(q),
         //CosD_(q_Number?) <- CosD(q),
         //TanD_(q_Number?) <- TanD(q),
         "Division" # (q_ /$ r_)::(!? Zero?(r)) <- q/r,
         "Multiplication" # q_ *$ r_ <- q*r,
         "Addition" # q_ +$ r_ <- q+r,
         // q_Number? *$ (r_Number? *$ s_) <- q*r *$ s, // todo:tk:short circuit the associative law of *.
         "Subtraction" # q_ -$ r_ <- q-r,
       ]);
}




Evaluate(equation, unknown, side, metaMethodName) :=
{
    If(Verbose?())
    {
        Echo("Evaluate");
    }
    
    Local(equationWithSubstitution, position, positions, stepInfo, match?);
    
    match? := False;
    
    // Remove all negation operators that have numbers as operands.
    equation := (equation /: [-$ q_Number? <- SubtractN(0,1) * q]);
    
    positions := PositionsPredicate(equation, "CanEvaluate?");

    If(Length(positions) >? 0)
    {
        position := First(positions);
        
        If(position[1] =? ToString(side))
        {
            match? := True;
            
            equationWithSubstitution := SubstitutePosition(equation, position, _, EvaluateDo(PositionGet(equation, position)) );
            
            stepInfo := [];
            stepInfo["ReplacementExp"] := [equationWithSubstitution, [[position, _, "GREEN"]] ];
            stepInfo["RuleName"] := "Evaluate";
            stepInfo["DescriptionObjectLevel"] := "Arithmetic.";
            stepInfo["OriginalExp"] := [equation, [[position, _, "ORANGE"]]];
            stepInfo["Position"] := position;
            stepInfo["ManualSequence"] := ?rulebaseElementaryAlgebra["Arithmetic"]["ManualSequence"];
            
            StepAppend(stepInfo);
                
            equation := equationWithSubstitution;
        }
        Else
        {
            positions := Rest(positions);
        }

    }
    
    // Remove all negation operators that have numbers as operands.
    equation := (equation /: [-$ q_Number? <- SubtractN(0,1) * q]);
    
    [equation, match?];
}




TexFormNoDollarSigns(equation) := 
{
    ToAtom(ListToString(Remove(StringToList(UnparseLatex(RemoveDollarSigns(equation))),"$"), ""));
}




ToLatex(string) :=
{
    string := Substitute('SubtractN(0,1), -1) string; 
    string := ToString(string);
    string := StringReplace(string, "$", "");
    string := StringReplace(string, " ", "\\ ");
    string := StringReplace(string, "==$", "=");
    string := StringReplace(string, "==", "=");
    string := StringReplace(string, "_", "\\_");
}




LineForm(steps) :=
{
    Local(originalEquation);
    
    originalEquation := First(steps);
    
    Echo(MetaToObject(originalEquation["OriginalExp"][1]), "   ", MetaToObject(originalEquation["DescriptionObjectLevel"]));
    
    ForEach(a, Rest(steps))
    {
        Echo(MetaToObject(a["ReplacementExp"][1]), "   ", MetaToObject(a["DescriptionObjectLevel"]));
    }
}


//====================================================================
// SolveSteps

RulebaseListedHoldArguments("SolveSteps",["equation", "unknown", "optionsList"]);

//Handle no options call.
5 # SolveSteps(equation_, unknown_) <-- SolveSteps(equation, unknown, []);


//Main routine.  It will automatically accept two or more option calls because the
//options come in a list.
10 # SolveSteps(equation_, unknown_, optionsList_List?) <--
{
    Local(options, path, steps, caughtException);
   
    RulebaseElementaryAlgebra(); // Load the rules into memory.
    
    Check(PositionsPredicate(equation,  Lambda([x], UnderscoreConstant?(x) &? StringEndsWith?(ToString(x), "_"))) =? [], 
        "The equation must not contain any constants that end with an \"_\" character.");
    
    options := OptionsToAssociationList(optionsList);

    equation := ObjectToMeta(equation);
    
    unknown := ObjectToMeta(unknown);
        
    Check(OccurrencesCount(equation, unknown) >? 0, "The variable " ~ ToString(unknown) ~ " does not occur in the equation.");
    
    maximumSteps := Decide(Integer?(options["MaximumSteps"]), options["MaximumSteps"], Infinity); // Global.
    
    caughtException := ExceptionCatch(MetaLevelMain(equation, unknown, options), "MAXIMUM?STEPS?REACHED", ExceptionGet());
    
    stepsList; //todo:tk:Copy(stepsList) ?
}


//Handle a single option call because the option does not come in a list for some reason.
20 # SolveSteps(equation_, unknown_, singleOption_) <-- SolveSteps(equation, unknown, [singleOption]);


} // End local symbols.


//LineForm(SolveSteps(MathParse("(8*x - 2 == -9 + 7*x)"), _x));

%/mathpiper





This is the isolation procedure message.
"\\GREENtnotesize \\mbox{
The dominant operator on the left side of an equation is the\\\\
operator that has the lowest precedence. This is always the top \\\\
operator on the left side of the equation's expression tree.\\\\
\\vspace{.75in}
The expression tree of an equation that has only one occurrence\\\\
of the unknown to be isolated can be solved using the following\\\\
procedure:\\\\
\\vspace{.75in}
1) Identify the operator that is at the top of the left side of the\\\\
\\hspace{.5in}tree (it is highlighted in the trees below).\\\\
\\vspace{.75in}
2) Identify the operand of this operator that does not contain the\\\\
\\hspace{.75in}unknown to be isolated.\\\\
\\vspace{.75in}
3) Remove the top operator (along with the operand from step 2)\\\\
\\hspace{.5in}from the left side of the tree, and add the inverse of\\\\
\\hspace{.5in}this operator (along with the operand from step 2) to\\\\
\\hspace{.5in}the top of the right side of the tree.\\\\
\\vspace{.75in}
\\rule{30cm}{0.9pt}

}"







%mathpiper_docs,name="SolveSteps",categories="Mathematics Procedures;Solvers (Symbolic)",access="experimental"
*CMD SolveSteps --- produce the steps that are needed to solve an equation

*CALL
    SolveSteps(equation, unknown)

*PARMS
{equation} -- an equation

{unknown} -- the variable to solve for


*DESC
Produce the steps that are needed to solve an equation. Returns the steps in a list.
Note: only equations that have a single occurrence of the unknown to be
solved for are currently supported.

 
*E.G.

In> SolveSteps( ((- _a) * _b )/ _c + _d == _e , _a)

*SEE StepsView
%/mathpiper_docs





%mathpiper,name="SolveSteps",subtype="manual_test"

Verify(SolveSteps( ((- a_) * b_ )/ c_ + d_ == e_ , a_), 
[[d_ -$ (a_ *$ b_) /$ c_ ==$ e_,"Equation","The original equation.",a_],[(a_ *$ b_) /$ c_ ==$ d_ -$ e_,"Subtraction2","\\text{Add }d_\\text{ to both sides:}",(d_ +$ d_) -$ (a_ *$ b_) /$ c_ ==$ e_ +$ d_],[a_ *$ b_ ==$ (d_ -$ e_) *$ c_,"Division1","\\text{Multiply both sides by }c_\\text{:}",c_ *$ (a_ *$ b_) /$ c_ ==$ (d_ -$ e_) *$ c_],[a_ ==$ ((d_ -$ e_) *$ c_) /$ b_,"Multiplication1","\\text{Divide both sides by }b_\\text{:}",(a_ *$ b_) /$ b_ ==$ ((d_ -$ e_) *$ c_) /$ b_]]);

%/mathpiper





%todo
- See "Arithmetic and Algebra", Proga, p.368 for simplification examples.

> It would help if students can see 2 sentential
> lines not just one. The one before the operation
> and then the one after the operation so they can
> see the difference. Otherwise they might need to
> go back and forth. (Robert Mendris)

- Undefine division only when the unknown is in the numerator?


--------------

- Guards appear to be meta-level information.
- In SolveSteps, almost all of the methods should be collapsable
into a single method. Even methods with single rules such as
negation and binary subtraction.
- Split the rulebase into meta-level rules and object-level rules. The
meta-level rules can consist of traditional collection, canceling, etc.
- Maybe collection, etc. are theorems?
%/todo