Updated testsuite with an expected GCL error in to_poly_share
[maxima.git] / tests / wester_problems / test_equations.mac
blobc4433436edde5f2a7704aa6c2e25016fe43f6a66
1 /* Original version of this file copyright 1999 by Michael Wester,
2  * and retrieved from http://www.math.unm.edu/~wester/demos/Equations/problems.macsyma
3  * circa 2006-10-23.
4  *
5  * Released under the terms of the GNU General Public License, version 2,
6  * per message dated 2007-06-03 from Michael Wester to Robert Dodier
7  * (contained in the file wester-gpl-permission-message.txt).
8  *
9  * See: "A Critique of the Mathematical Abilities of CA Systems"
10  * by Michael Wester, pp 25--60 in
11  * "Computer Algebra Systems: A Practical Guide", edited by Michael J. Wester
12  * and published by John Wiley and Sons, Chichester, United Kingdom, 1999.
13  */
14 /* ----------[ M a c s y m a ]---------- */
15 /* ---------- Initialization ---------- */
16 showtime: all$
17 prederror: false$
18 /* ---------- Equations ---------- */
19 /* Manipulate an equation using a natural syntax:
20    (x = 2)/2 + (1 = 1) => x/2 + 1 = 2 */
21 (x = 2)/2 + (1 = 1);
22 /* Solve various nonlinear equations---this cubic polynomial has all real roots
23    */
24 solve(3*x^3 - 18*x^2 + 33*x - 19 = 0, x);
25 ratsimp(rectform(%));
26 /* Some simple seeming problems can have messy answers:
27    x = {  [sqrt(5) - 1]/4 +/- 5^(1/4) sqrt(sqrt(5) + 1)/[2 sqrt(2)] i,
28         - [sqrt(5) + 1]/4 +/- 5^(1/4) sqrt(sqrt(5) - 1)/[2 sqrt(2)] i} */
29 eqn: x^4 + x^3 + x^2 + x + 1 = 0;
30 solve(eqn, x);
31 /* Check one of the answers */
32 ev(eqn, %[1]);
33 radcan(%);
34 remvalue(eqn)$
35 /* x = {2^(1/3) +- sqrt(3), +- sqrt(3) - 1/2^(2/3) +- i sqrt(3)/2^(2/3)} 
36        [Mohamed Omar Rayes] */
37 solve(x^6 - 9*x^4 - 4*x^3 + 27*x^2 - 36*x - 23 = 0, x);
38 /* x = {1, e^(+- 2 pi i/7), e^(+- 4 pi i/7), e^(+- 6 pi i/7)} */
39 solve(x^7 - 1 = 0, x);
40 /* x = 1 +- sqrt(+-sqrt(+-4 sqrt(3) - 3) - 3)/sqrt(2)   [Richard Liska] */
41 solve(x^8 - 8*x^7 + 34*x^6 - 92*x^5 + 175*x^4 - 236*x^3 + 226*x^2 - 140*x + 46
42       = 0, x);
43 /* The following equations have an infinite number of solutions (let n be an
44    arbitrary integer):
45    x = {log(sqrt(z) - 1), log(sqrt(z) + 1) + i pi} [+ n 2 pi i, + n 2 pi i] */
46 %e^(2*x) + 2*%e^x + 1 = z;
47 solve(%, x);
48 /* x = (1 +- sqrt(9 - 8 n pi i))/2.  Real solutions correspond to n = 0 =>
49    x = {-1, 2} */
50 solve(exp(2 - x^2) = exp(-x), x);
51 /* x = -W[n](-1) [e.g., -W[0](-1) = 0.31813 - 1.33724 i] where W[n](x) is the
52    nth branch of Lambert's W function */
53 solve(exp(x) = x, x);
54 /* x = {-1, 1} */
55 solve(x^x = x, x);
56 /* This equation is already factored and so *should* be easy to solve:
57    x = {-1, 2*{+-arcsinh(1) i + n pi}, 3*{pi/6 + n pi/3}} */
58 (x + 1) * (sin(x)^2 + 1)^2 * cos(3*x)^3 = 0;
59 solve(%, x);
60 multiplicities;
61 /* x = pi/4 [+ n pi] */
62 solve(sin(x) = cos(x), x);
63 solve(tan(x) = 1, x);
64 /* x = {pi/6, 5 pi/6} [ + n 2 pi, + n 2 pi ] */
65 solve(sin(x) = 1/2, x);
66 /* x = {0, 0} [+ n pi, + n 2 pi] */
67 solve(sin(x) = tan(x), x);
68 multiplicities;
69 /* x = {0, 0, 0} */
70 solve(asin(x) = atan(x), x);
71 multiplicities;
72 /* x = sqrt[(sqrt(5) - 1)/2] */
73 solve(acos(x) = atan(x), x);
74 /* x = 2 */
75 solve((x - 2)/x^(1/3) = 0, x);
76 /* This equation has no solutions */
77 solve(sqrt(x^2 + 1) = x - 2, x);
78 /* x = 1 */
79 solve(x + sqrt(x) = 2, x);
80 /* x = 1/16 */
81 solve(2*sqrt(x) + 3*x^(1/4) - 2 = 0, x);
82 /* x = {sqrt[(sqrt(5) - 1)/2], -i sqrt[(sqrt(5) + 1)/2]} */
83 solve(x = 1/sqrt(1 + x^2), x);
84 /* This problem is from a computational biology talk => 1 - log_2[m (m - 1)] */
85 solve(binomial(m, 2)*2^k = 1, k);
86 /* x = log(c/a) / log(b/d) for a, b, c, d != 0 and b, d != 1   [Bill Pletsch] */
87 solve(a*b^x = c*d^x, x);
88 logcontract(%);
89 /* x = {1, e^4} */
90 errcatch(solve(sqrt(log(x)) = log(sqrt(x)), x));
91 /* Recursive use of inverses, including multiple branches of rational
92    fractional powers   [Richard Liska]
93    => x = +-(b + sin(1 + cos(1/e^2)))^(3/2) */
94 assume(sin(cos(1/%e^2) + 1) + b > 0)$
95 solve(log(acos(asin(x^(2/3) - b) - 1)) + 2 = 0, x);
96 forget(sin(cos(1/%e^2) + 1) + b > 0)$
97 /* x = {-0.784966, -0.016291, 0.802557}  From Metha Kamminga-van Hulsen,
98    ``Hoisting the Sails and Casting Off with Maple'', _Computer Algebra
99    Nederland Nieuwsbrief_, Number 13, December 1994, ISSN 1380-1260, 27--40. */
100 eqn: 5*x + exp((x - 5)/2) = 8*x^3;
101 solve(eqn, x);
102 root_by_bisection(eqn, x, -1,  -0.5);
103 root_by_bisection(eqn, x, -0.5, 0.5);
104 root_by_bisection(eqn, x,  0.5, 1);
105 remvalue(eqn)$
106 /* x = {-1, 3} */
107 solve(abs(x - 1) = 2, x);
108 /* x = {-1, -7} */
109 solve(abs(2*x + 5) = abs(x - 2), x);
110 /* x = +-3/2 */
111 solve(1 - abs(x) = max(-x - 2, x - 2), x);
112 /* x = {-1, 3} */
113 solve(max(2 - x^2, x) = max(-x, x^3/9), x);
114 /* x = {+-3, -3 [1 + sqrt(3) sin t + cos t]} = {+-3, -1.554894}
115    where t = (arctan[sqrt(5)/2] - pi)/3.  The third answer is the root of
116    x^3 + 9 x^2 - 18 = 0 in the interval (-2, -1). */
117 solve(max(2 - x^2, x) = x^3/9, x);
118 /* z = 2 + 3 i */
119 declare(z, complex)$
120 eqn: (1 + %i)*z + (2 - %i)*conjugate(z) = -3*%i;
121 solve(eqn, z);
122 declare([x, y], real)$
123 subst(z = x + %i*y, eqn);
124 ratsimp(ev(%, conjugate));
125 solve(%, [x, y]);
126 remove([x, y], real, z, complex)$
127 remvalue(eqn)$
128 /* => {f^(-1)(1), f^(-1)(-2)} assuming f is invertible */
129 solve(f(x)^2 + f(x) - 2 = 0, x);
130 remvalue(eqns, vars)$
131 /* Solve a 3 x 3 system of linear equations */
132 eqn1:   x +   y +   z =  6;
133 eqn2: 2*x +   y + 2*z = 10;
134 eqn3:   x + 3*y +   z = 10;
135 /* Note that the solution is parametric: x = 4 - z, y = 2 */
136 solve([eqn1, eqn2, eqn3], [x, y, z]);
137 /* A linear system arising from the computation of a truncated power series
138    solution to a differential equation.  There are 189 equations to be solved
139    for 49 unknowns.  42 of the equations are repeats of other equations; many
140    others are trivial.  Solving this system directly by Gaussian elimination
141    is *not* a good idea.  Solving the easy equations first is probably a better
142    method.  The solution is actually rather simple.   [Stanly Steinberg]
143    => k1 = ... = k22 = k24 = k25 = k27 = ... = k30 = k32 = k33 = k35 = ...
144       = k38 = k40 = k41 = k44 = ... = k49 = 0, k23 = k31 = k39,
145       k34 = b/a k26, k42 = c/a k26, {k23, k26, k43} are arbitrary */
146 eqns: [
147  -b*k8/a+c*k8/a = 0, -b*k11/a+c*k11/a = 0, -b*k10/a+c*k10/a+k2 = 0,
148  -k3-b*k9/a+c*k9/a = 0, -b*k14/a+c*k14/a = 0, -b*k15/a+c*k15/a = 0,
149  -b*k18/a+c*k18/a-k2 = 0, -b*k17/a+c*k17/a = 0, -b*k16/a+c*k16/a+k4 = 0,
150  -b*k13/a+c*k13/a-b*k21/a+c*k21/a+b*k5/a-c*k5/a = 0, b*k44/a-c*k44/a = 0,
151  -b*k45/a+c*k45/a = 0, -b*k20/a+c*k20/a = 0, -b*k44/a+c*k44/a = 0,
152   b*k46/a-c*k46/a = 0, b^2*k47/a^2-2*b*c*k47/a^2+c^2*k47/a^2 = 0, k3 = 0,
153  -k4 = 0, -b*k12/a+c*k12/a-a*k6/b+c*k6/b = 0,
154  -b*k19/a+c*k19/a+a*k7/c-b*k7/c = 0, b*k45/a-c*k45/a = 0,
155  -b*k46/a+c*k46/a = 0, -k48+c*k48/a+c*k48/b-c^2*k48/(a*b) = 0,
156  -k49+b*k49/a+b*k49/c-b^2*k49/(a*c) = 0, a*k1/b-c*k1/b = 0,
157   a*k4/b-c*k4/b = 0, a*k3/b-c*k3/b+k9 = 0, -k10+a*k2/b-c*k2/b = 0,
158   a*k7/b-c*k7/b = 0, -k9 = 0, k11 = 0, b*k12/a-c*k12/a+a*k6/b-c*k6/b = 0,
159   a*k15/b-c*k15/b = 0, k10+a*k18/b-c*k18/b = 0, -k11+a*k17/b-c*k17/b = 0,
160   a*k16/b-c*k16/b = 0, -a*k13/b+c*k13/b+a*k21/b-c*k21/b+a*k5/b-c*k5/b = 0,
161  -a*k44/b+c*k44/b = 0, a*k45/b-c*k45/b = 0,
162   a*k14/c-b*k14/c+a*k20/b-c*k20/b = 0, a*k44/b-c*k44/b = 0,
163  -a*k46/b+c*k46/b = 0, -k47+c*k47/a+c*k47/b-c^2*k47/(a*b) = 0,
164   a*k19/b-c*k19/b = 0, -a*k45/b+c*k45/b = 0, a*k46/b-c*k46/b = 0,
165   a^2*k48/b^2-2*a*c*k48/b^2+c^2*k48/b^2 = 0,
166  -k49+a*k49/b+a*k49/c-a^2*k49/(b*c) = 0, k16 = 0, -k17 = 0,
167  -a*k1/c+b*k1/c = 0, -k16-a*k4/c+b*k4/c = 0, -a*k3/c+b*k3/c = 0,
168   k18-a*k2/c+b*k2/c = 0, b*k19/a-c*k19/a-a*k7/c+b*k7/c = 0,
169  -a*k6/c+b*k6/c = 0, -a*k8/c+b*k8/c = 0, -a*k11/c+b*k11/c+k17 = 0,
170  -a*k10/c+b*k10/c-k18 = 0, -a*k9/c+b*k9/c = 0,
171  -a*k14/c+b*k14/c-a*k20/b+c*k20/b = 0,
172  -a*k13/c+b*k13/c+a*k21/c-b*k21/c-a*k5/c+b*k5/c = 0, a*k44/c-b*k44/c = 0,
173  -a*k45/c+b*k45/c = 0, -a*k44/c+b*k44/c = 0, a*k46/c-b*k46/c = 0,
174  -k47+b*k47/a+b*k47/c-b^2*k47/(a*c) = 0, -a*k12/c+b*k12/c = 0,
175   a*k45/c-b*k45/c = 0, -a*k46/c+b*k46/c = 0,
176  -k48+a*k48/b+a*k48/c-a^2*k48/(b*c) = 0,
177   a^2*k49/c^2-2*a*b*k49/c^2+b^2*k49/c^2 = 0, k8 = 0, k11 = 0, -k15 = 0,
178   k10-k18 = 0, -k17 = 0, k9 = 0, -k16 = 0, -k29 = 0, k14-k32 = 0,
179  -k21+k23-k31 = 0, -k24-k30 = 0, -k35 = 0, k44 = 0, -k45 = 0, k36 = 0,
180   k13-k23+k39 = 0, -k20+k38 = 0, k25+k37 = 0, b*k26/a-c*k26/a-k34+k42 = 0,
181  -2*k44 = 0, k45 = 0, k46 = 0, b*k47/a-c*k47/a = 0, k41 = 0, k44 = 0,
182  -k46 = 0, -b*k47/a+c*k47/a = 0, k12+k24 = 0, -k19-k25 = 0,
183  -a*k27/b+c*k27/b-k33 = 0, k45 = 0, -k46 = 0, -a*k48/b+c*k48/b = 0,
184   a*k28/c-b*k28/c+k40 = 0, -k45 = 0, k46 = 0, a*k48/b-c*k48/b = 0,
185   a*k49/c-b*k49/c = 0, -a*k49/c+b*k49/c = 0, -k1 = 0, -k4 = 0, -k3 = 0,
186   k15 = 0, k18-k2 = 0, k17 = 0, k16 = 0, k22 = 0, k25-k7 = 0,
187   k24+k30 = 0, k21+k23-k31 = 0, k28 = 0, -k44 = 0, k45 = 0, -k30-k6 = 0,
188   k20+k32 = 0, k27+b*k33/a-c*k33/a = 0, k44 = 0, -k46 = 0,
189  -b*k47/a+c*k47/a = 0, -k36 = 0, k31-k39-k5 = 0, -k32-k38 = 0,
190   k19-k37 = 0, k26-a*k34/b+c*k34/b-k42 = 0, k44 = 0, -2*k45 = 0, k46 = 0,
191   a*k48/b-c*k48/b = 0, a*k35/c-b*k35/c-k41 = 0, -k44 = 0, k46 = 0,
192   b*k47/a-c*k47/a = 0, -a*k49/c+b*k49/c = 0, -k40 = 0, k45 = 0, -k46 = 0,
193  -a*k48/b+c*k48/b = 0, a*k49/c-b*k49/c = 0, k1 = 0, k4 = 0, k3 = 0,
194  -k8 = 0, -k11 = 0, -k10+k2 = 0, -k9 = 0, k37+k7 = 0, -k14-k38 = 0,
195  -k22 = 0, -k25-k37 = 0, -k24+k6 = 0, -k13-k23+k39 = 0,
196  -k28+b*k40/a-c*k40/a = 0, k44 = 0, -k45 = 0, -k27 = 0, -k44 = 0,
197   k46 = 0, b*k47/a-c*k47/a = 0, k29 = 0, k32+k38 = 0, k31-k39+k5 = 0,
198  -k12+k30 = 0, k35-a*k41/b+c*k41/b = 0, -k44 = 0, k45 = 0,
199  -k26+k34+a*k42/c-b*k42/c = 0, k44 = 0, k45 = 0, -2*k46 = 0,
200  -b*k47/a+c*k47/a = 0, -a*k48/b+c*k48/b = 0, a*k49/c-b*k49/c = 0, k33 = 0,
201  -k45 = 0, k46 = 0, a*k48/b-c*k48/b = 0, -a*k49/c+b*k49/c = 0
202  ]$
203 vars: [k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14, k15, k16,
204        k17, k18, k19, k20, k21, k22, k23, k24, k25, k26, k27, k28, k29, k30,
205        k31, k32, k33, k34, k35, k36, k37, k38, k39, k40, k41, k42, k43, k44,
206        k45, k46, k47, k48, k49]$
207 solve(eqns, vars);
208 /* Solve a 3 x 3 system of nonlinear equations */
209 eqn1: x^2*y + 3*y*z - 4 = 0;
210 eqn2: -3*x^2*z + 2*y^2 + 1 = 0;
211 eqn3: 2*y*z^2 - z^2 - 1 = 0;
212 /* Solving this by hand would be a nightmare */
213 solve([eqn1, eqn2, eqn3], [x, y, z]);
214 rectform(sfloat(%[1..5]));
215 remvalue(eqn1, eqn2, eqn3)$