%mathpiper,def="Solve"

//Retract("Solve",*);

/*
 * Strategy for Solve(expr, x):
 *
 * 10.  Call SolveSystem for systems of equations [now in its own file]
 * 20.  Check arguments.
 * 30.  Get rid of "==" in 'expr'.
 * 40.  Special cases.
 * 50.  If 'expr' is a polynomial in 'x', try to use PSolve.
 * 60.  If 'expr' is a product, solve for either factor.
 * 70.  If 'expr' is a quotient, solve for the denominator.
 * 80.  If 'expr' is a sum and one of the terms is free of 'x',
 *      try to use Solve'Simple.
 * 90.  If every occurance of 'x' is in the same context, use this to reduce
 *      the equation. For example, in 'Cos(x) + Cos(x)^2 == 1', the variable
 *      'x' always occurs in the context 'Cos(x)', and hence we can attack
 *      the equation by first solving 'y + y^2 == 1', and then 'Cos(x) == y'.
 *      This does not work for 'Exp(x) + Cos(x) == 2'.
 * 100. Apply Simplify to 'expr', and try again.
 * 110. Give up.
 */

LocalSymbols(res)
[
  10  # Solve(expr_IsList, var_IsList) <-- SolveSystem(expr, var);
  12  # Solve(_expr, var_IsList)_(Length(var)=1) <--
        [ {Solve(expr,var[1])}; ];
  
  20  # Solve(_expr, _var)_(IsNumber(var) Or IsString(var)) <--
        [ Assert("Solve'TypeError", "Second argument, ":(PipeToString() Write(var)):", is not the name of a variable") False; {}; ];
  22  # Solve(_expr, _var)_(Not IsAtom(var) And Not HasExpr(expr,var)) <--
        [ Assert("Solve'TypeError", "Second argument, ":(PipeToString() Write(var)):", is not the name of a variable") False; {}; ];
  24  # Solve(False,_var) <-- Check(False, "Argument", "Bad input: possibly '=' instead of '==' ");

  30  # Solve(_lhs == _rhs, _var) <-- Solve(lhs - rhs, var);
  40  # Solve(0, _var) <-- {var == var};
  41  # Solve(a_IsConstant, _var) <-- {};
  42  # Solve(_expr, _var)_(Not HasExpr(expr,var)) <--
        [ Assert("Solve", "expression ":(PipeToString() Write(expr)):" does not depend on ":PipeToString() Write(var)) False; {}; ];
  50  # Solve(_expr, _var)_((res := Solve'Poly(expr, var)) != Failed) <-- res;
  60  # Solve(_e1 * _e2, _var) <-- [
      Local(t,u,s);
      t := Union(Solve(e1,var), Solve(e2,var));
      u := {};
      ForEach(s, t) [
         Local(v1,v2);
         v1 := WithValue(var, s[2], e1);
         v2 := WithValue(var, s[2], e2);
         If(Not (IsInfinity(v1) Or (v1 = Undefined) Or
                 IsInfinity(v2) Or (v2 = Undefined)), 
             DestructiveAppend(u, s));
      ];
      u;
  ];
  70  # Solve(_e1 / _e2, _var) <-- [
      Local(tn, t, s);
      tn := Solve(e1, var);
      t := {};
      ForEach(s, tn)
          If(Not(IsZero(WithValue(var, s[2], e2))), 
              DestructiveAppend(t, s)
          );
      t;
  ];
  80  # Solve(_e1 + _e2, _var)_(Not HasExpr(e2,var) And (res := Solve'Simple(e1,-e2,var)) != Failed) <-- res;
  80  # Solve(_e1 + _e2, _var)_(Not HasExpr(e1,var) And (res := Solve'Simple(e2,-e1,var)) != Failed) <-- res;
  80  # Solve(_e1 - _e2, _var)_(Not HasExpr(e2,var) And (res := Solve'Simple(e1,e2,var)) != Failed) <-- res;
  80  # Solve(_e1 - _e2, _var)_(Not HasExpr(e1,var) And (res := Solve'Simple(e2,e1,var)) != Failed) <-- res;
  85  # Solve(_expr, _var)_((res := Solve'Simple(expr, 0, var)) != Failed) <-- res;
  90  # Solve(_expr, _var)_((res := Solve'Reduce(expr, var)) != Failed) <-- res;
  95  # Solve(_expr, _var)_((res := Solve'Divide(expr, var)) != Failed) <-- res;
  100 # Solve(_expr, _var)_((res := Simplify(expr)) != expr) <-- Solve(res, var);
  110 # Solve(_expr, _var) <--
        [ Assert("Solve'Fails", "cannot solve equation ":(PipeToString() Write(expr)):" for ":PipeToString() Write(var)) False; {}; ];
];

/********** Solve'Poly **********/

/* Tries to solve by calling PSolve */
/* Returns Failed if this doesn't work, and the solution otherwise */

/* CanBeUni is not documented, but defined in univar.rep/code.mpi */
/* It returns True iff 'expr' is a polynomial in 'var' */

10 # Solve'Poly(_expr, _var)_(Not CanBeUni(var, expr)) <-- Failed;

/* The call to PSolve can have three kind of results
 *   1) PSolve returns a single root
 *   2) PSolve returns a list of roots
 *   3) PSolve remains unevaluated
 */

20 # Solve'Poly(_expr, _var) <--
LocalSymbols(x)
[
  Local(roots);
  roots := PSolve(expr, var);
  If(Type(roots) = "YacasPSolve",
     If(roots = YacasPSolve(0), {var == var}, Failed),   /* Case 3 */
     If(Type(roots) = "List",
        MapSingle({{x},var==x}, roots),                  /* Case 2 */
        {var == roots}));                                /* Case 1 */
];

/********** Solve'Reduce **********/

/* Tries to solve by reduction strategy */
/* Returns Failed if this doesn't work, and the solution otherwise */

10 # Solve'Reduce(_expr, _var) <--
[
  ClearError("Solve'Fails"); // ..in case one was left over from prior failure
  Local(context, expr2, var2, res, sol, sol2, i);
  context := Solve'Context(expr, var);
  If(context = False,
     res := Failed,
     [
       expr2 := Eval(Subst(context, var2) expr);
       If(CanBeUni(var2, expr2) And (Degree(expr2, var2) = 0 Or (Degree(expr2, var2) = 1 And Coef(expr2, var2, 1) = 1)),
          res := Failed, /* to prevent infinite recursion */
          [
    	    sol2 := Solve(expr2, var2);
	    If(IsError("Solve'Fails"),
	       [
	         ClearError("Solve'Fails");
		 res := Failed;
               ],
    	       [
    		 res := {};
    		 i := 1;
    		 While(i <= Length(sol2) And res != Failed) [
    		   sol := Solve(context == (var2 Where sol2[i]), var);
	           If(IsError("Solve'Fails"),
		      [
		        ClearError("Solve'Fails");
		        res := Failed;
                      ],
    		      res := Union(res, sol));
    		   i++;
    		 ];
    	       ]);
      	   ]);
     ]);
  res;
];

/********** Solve'Context **********/

/* Returns the unique context of 'var' in 'expr', */
/* or {} if 'var' does not occur in 'expr',       */
/* or False if the context is not unique.         */

10 # Solve'Context(expr_IsAtom, _var) <-- If(expr=var, var, {});

20 # Solve'Context(_expr, _var) <--
[
  Local(lst, foundVarP, context, i, res);
  lst := FunctionToList(expr);
  foundVarP := False;
  i := 2;
  While(i <= Length(lst) And Not foundVarP) [
    foundVarP := (lst[i] = var);
    i++;
  ];
  If(foundVarP,
     context := expr,
     [
       context := {};
       i := 2;
       While(i <= Length(lst) And context != False) [
         res := Solve'Context(lst[i], var);
	 If(res != {} And context != {} And res != context, context := False);
	 If(res != {} And context = {}, context := res);
	 i++;
       ];
     ]);
  context;
];

/********** Solve'Simple **********/

/* Simple solver of equations
 *
 * Returns (possibly empty) list of solutions,
 * or Failed if it cannot handle the equation
 *
 * Calling format: Solve'Simple(lhs, rhs, var)
 *                 to solve 'lhs == rhs'.
 *
 * Note: 'rhs' should not contain 'var'.
 */

20 # Solve'Simple(_e1 + _e2, _rhs, _var)_(e1 = var And Not HasExpr(e2,var)) <-- { var == rhs-e2 };
20 # Solve'Simple(_e1 + _e2, _rhs, _var)_(e2 = var And Not HasExpr(e1,var)) <-- { var == rhs-e1 };

20 # Solve'Simple(_e1 - _e2, _rhs, _var)_(e1 = var And Not HasExpr(e2,var)) <-- { var == rhs+e2 };
20 # Solve'Simple(_e1 - _e2, _rhs, _var)_(e2 = var And Not HasExpr(e1,var)) <-- { var == e1-rhs };
20 # Solve'Simple(-(_e1), _rhs, _var)_(e1 = var) <-- { var == -rhs };

20 # Solve'Simple(_e1 * _e2, _rhs, _var)_(e1 = var And Not HasExpr(e2,var)) <-- { var == rhs/e2 };
20 # Solve'Simple(_e1 * _e2, _rhs, _var)_(e2 = var And Not HasExpr(e1,var)) <-- { var == rhs/e1 };

20 # Solve'Simple(_e1 / _e2, _rhs, _var)_(e1 = var And Not HasExpr(e2,var)) <-- { var == rhs*e2 };
10 # Solve'Simple(_e1 / _e2, 0,    _var)_(e2 = var And Not HasExpr(e1,var)) <-- { };
20 # Solve'Simple(_e1 / _e2, _rhs, _var)_(e2 = var And Not HasExpr(e1,var)) <-- { var == e1/rhs };

LocalSymbols(x)
[
  20 # Solve'Simple(_e1 ^ _n, _rhs, _var)_(e1 = var And IsPositiveInteger(n))
       <-- MapSingle({{x}, var == rhs^(1/n)*x}, Exp(2*Pi*I*(1 .. n)/n));
  20 # Solve'Simple(_e1 ^ _n, _rhs, _var)_(e1 = var And IsNegativeInteger(n))
       <-- MapSingle({{x}, var == rhs^(1/n)*x}, Exp(2*Pi*I*(1 .. (-n))/(-n)));
];

20 # Solve'Simple(_e1 ^ _e2, _rhs, _var)
     _ (IsPositiveReal(e1) And e1 != 0 And e2 = var And IsPositiveReal(rhs) And rhs != 0)
     <-- { var == Ln(rhs)/Ln(e1) };

/* Note: These rules do not take the periodicity of the trig. functions into account */
10 # Solve'Simple(Sin(_e1), 1,    _var)_(e1 = var) <-- { var == 1/2*Pi };
10 # Solve'Simple(Sin(_e1), _rhs, _var)_(e1 = var And rhs = -1) <-- { var == 3/2*Pi };
20 # Solve'Simple(Sin(_e1), _rhs, _var)_(e1 = var) <-- { var == ArcSin(rhs), var == Pi-ArcSin(rhs) };
10 # Solve'Simple(Cos(_e1), 1,    _var)_(e1 = var) <-- { var == 0 };
10 # Solve'Simple(Cos(_e1), _rhs, _var)_(e1 = var And rhs = -1) <-- { var == Pi };
20 # Solve'Simple(Cos(_e1), _rhs, _var)_(e1 = var) <-- { var == ArcCos(rhs), var == -ArcCos(rhs) };
20 # Solve'Simple(Tan(_e1), _rhs, _var)_(e1 = var) <-- { var == ArcTan(rhs) };

20 # Solve'Simple(ArcSin(_e1), _rhs, _var)_(e1 = var) <-- { var == Sin(rhs) };
20 # Solve'Simple(ArcCos(_e1), _rhs, _var)_(e1 = var) <-- { var == Cos(rhs) };
20 # Solve'Simple(ArcTan(_e1), _rhs, _var)_(e1 = var) <-- { var == Tan(rhs) };

/* Note: Second rule neglects (2*I*Pi)-periodicity of Exp() */
10 # Solve'Simple(Exp(_e1), 0,    _var)_(e1 = var) <-- { };
20 # Solve'Simple(Exp(_e1), _rhs, _var)_(e1 = var) <-- { var == Ln(rhs) };
20 # Solve'Simple(_b^_e1, _rhs, _var)_(e1 = var And IsFreeOf(var,b) And Not IsZero(b)) <-- { var == Ln(rhs) / Ln(b) };
20 # Solve'Simple(Ln(_e1),  _rhs, _var)_(e1 = var) <-- { var == Exp(rhs) };

/* The range of Sqrt is the set of (complex) numbers with either
 * positive real part, together with the pure imaginary numbers with
 * nonnegative real part. */
20 # Solve'Simple(Sqrt(_e1), _rhs, _var)_(e1 = var And IsPositiveReal(Re(rhs)) And Re(rhs) != 0) <-- { var == rhs^2 };
20 # Solve'Simple(Sqrt(_e1), _rhs, _var)_(e1 = var And Re(rhs)=0 And IsPositiveReal(Im(rhs))) <-- { var == rhs^2 };
20 # Solve'Simple(Sqrt(_e1), _rhs, _var)_(e1 = var And Re(rhs)=0 And IsNegativeReal(Im(rhs)) And Im(rhs) != 0) <-- { };
20 # Solve'Simple(Sqrt(_e1), _rhs, _var)_(e1 = var And IsNegativeReal(Re(rhs)) And Re(rhs) != 0) <-- { };

30 # Solve'Simple(_lhs, _rhs, _var) <-- Failed;


/********** Solve'Divide **********/
/* For some classes of equations, it may be easier to solve them if we
 * divide through by their first term.  A simple example of this is the
 * equation  Sin(x)+Cos(x)==0
 * One problem with this is that we may lose roots if the thing we
 * are dividing by shares roots with the whole equation.
 * The final HasExprs are an attempt to prevent infinite recursion caused by
 * the final Simplify step in Solve undoing what we do here.  It's conceivable
 * though that this won't always work if the recurring loop is more than two
 * steps long.  I can't think of any ways this can happen though :)
 */

10 # Solve'Divide(_e1 + _e2, _var)_(HasExpr(e1, var) And HasExpr(e2, var)
		And Not (HasExpr(Simplify(1 + (e2/e1)), e1)
		      Or HasExpr(Simplify(1 + (e2/e1)), e2)))
                                           <-- Solve(1 + (e2/e1), var);
10 # Solve'Divide(_e1 - _e2, _var)_(HasExpr(e1, var) And HasExpr(e2, var)
		And Not (HasExpr(Simplify(1 - (e2/e1)), e1)
		      Or HasExpr(Simplify(1 - (e2/e1)), e2)))
                                           <-- Solve(1 - (e2/e1), var);

20 # Solve'Divide(_e, _v) <-- Failed;


%/mathpiper

    %output,preserve="false"
      Result: True
.   %/output



%mathpiper_docs,name="Solve",categories="User Functions;Solvers (Symbolic)"
*CMD Solve --- solve an equation
*STD
*CALL
	Solve(eq, var)

*PARMS

{eq} -- equation to solve

{var} -- variable to solve for

*DESC

This command tries to solve an equation. If {eq} does not contain the
{==} operator, it is assumed that the user wants to solve
$eq == 0$. The result is a list of equations of the form {var == value}, each
representing a solution of the given equation. The {Where} operator
can be used to substitute this solution in another expression. If the
given equation {eq} does not have any solutions, or if {Solve} is
unable to find any, then an empty list is returned.

The current implementation is far from perfect. In particular, the
user should keep the following points in mind:
*	{Solve} cannot solve all equations. If it is given a equation
it can not solve, it raises an error via {Check}. Unfortunately, this
is not displayed by the inline pretty-printer; call {PrettyPrinterSet} to
change this. If an equation cannot be solved analytically, you may
want to call {Newton} to get a numerical solution.
*	Systems of equations are not handled yet. For linear systems,
{MatrixSolve} can be used. The old version of {Solve}, with the name
{OldSolve} might be able to solve nonlinear systems of equations.
*	The periodicity of the trigonometric functions {Sin}, {Cos},
and {Tan} is not taken into account. The same goes for the (imaginary)
periodicity of {Exp}. This causes {Solve} to miss solutions.
*	It is assumed that all denominators are nonzero. Hence, a
solution reported by {Solve} may in fact fail to be a solution because
a denominator vanishes.
*	In general, it is wise not to have blind trust in the results
returned by {Solve}. A good strategy is to substitute the solutions
back in the equation.

*E.G. notest

First a simple example, where everything works as it should. The
quadratic equation $x^2 + x == 0$ is solved. Then the result is
checked by substituting it back in the quadratic.

In> quadratic := x^2+x;
Result: x^2+x;
In> Solve(quadratic, x);
Result: {x==0,x==(-1)};
In> quadratic Where %;
Result: {0,0};

If one tries to solve the equation $Exp(x) == Sin(x)$, one finds that
{Solve} can not do this.

In> PrettyPrinterSet("DefaultPrint");
Result: True;
In> Solve(Exp(x) == Sin(x), x);
	Error: Solve'Fails: cannot solve equation Exp(x)-Sin(x) for x
Result: {};

The equation $Cos(x) == 1/2$ has an infinite number of solutions,
namely $x == (2*k + 1/3) * Pi$ and $x == (2*k - 1/3) * Pi$ for any
integer $k$. However, {Solve} only reports the solutions with $k == 0$.

In> Solve(Cos(x) == 1/2, x);
Result: {x==Pi/3,x== -Pi/3};

For the equation $x/Sin(x) == 0$, a spurious solution at $x == 0$ is
returned. However, the fraction is undefined at that point.

In> Solve(x / Sin(x) == 0, x);
Result: {x==0};

At first sight, the equation $Sqrt(x) == a$ seems to have the solution
$x == a^2$. However, this is not true for eg. $a == -1$.

In> PrettyPrinterSet("DefaultPrint");
Result: True;
In> Solve(Sqrt(x) == a, x);
	Error: Solve'Fails: cannot solve equation Sqrt(x)-a for  x
Result: {};
In> Solve(Sqrt(x) == 2, x);
Result: {x==4};
In> Solve(Sqrt(x) == -1, x);
Result: {};

*SEE Check, MatrixSolve, Newton, OldSolve, PrettyPrinterSet, PSolve, Where, AddTo, ==
%/mathpiper_docs
