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
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).
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.
14 /* ----------[ M a c s y m a ]---------- */
15 /* ---------- Initialization ---------- */
18 /* ---------- Equations ---------- */
19 /* Manipulate an equation using a natural syntax:
20 (x = 2)/2 + (1 = 1) => x/2 + 1 = 2 */
22 /* Solve various nonlinear equations---this cubic polynomial has all real roots
24 solve(3*x^3 - 18*x^2 + 33*x - 19 = 0, x);
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;
31 /* Check one of the answers */
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
43 /* The following equations have an infinite number of solutions (let n be an
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;
48 /* x = (1 +- sqrt(9 - 8 n pi i))/2. Real solutions correspond to n = 0 =>
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 */
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;
61 /* x = pi/4 [+ n pi] */
62 solve(sin(x) = cos(x), 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);
70 solve(asin(x) = atan(x), x);
72 /* x = sqrt[(sqrt(5) - 1)/2] */
73 solve(acos(x) = atan(x), x);
75 solve((x - 2)/x^(1/3) = 0, x);
76 /* This equation has no solutions */
77 solve(sqrt(x^2 + 1) = x - 2, x);
79 solve(x + sqrt(x) = 2, x);
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);
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;
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);
107 solve(abs(x - 1) = 2, x);
109 solve(abs(2*x + 5) = abs(x - 2), x);
111 solve(1 - abs(x) = max(-x - 2, x - 2), x);
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);
120 eqn: (1 + %i)*z + (2 - %i)*conjugate(z) = -3*%i;
122 declare([x, y], real)$
123 subst(z = x + %i*y, eqn);
124 ratsimp(ev(%, conjugate));
126 remove([x, y], real, z, complex)$
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 */
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 */
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
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]$
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)$