It might be useful to have a function that converts
an algebraic equation into a polynomial equation, where
the solution set to the algebraic equation is a *subset* of
the solution set to the polynomial equation. Here is my first
attempt at such a function---I haven't tested it all that
much, so I'm sure it has bugs and weaknesses. Maybe somebody
can test it, extend it, fix it, rewrite it from scratch,
or ... I think code like is sometimes more naturally
expressed in Maxima, but I wrote it in Common Lisp.
(%i1) load("topoly.lisp")$
(%i2) eq : a + x - sqrt(x)$
(%i3) topoly(%);
(%o3) x^2+2*a*x-x+a^2=0
(%i4) solve(%,x);
(%o4) [x=-(2*a+sqrt(1-4*a)-1)/2,x=(-2*a+sqrt(1-4*a)+1)/2]
(%i5) eq : abs(1-abs(7-abs(x-8)))$
(%i6) topoly(%);
(%o6) (x-16)*(x-14)*(x-2)*x=0
(%i7) sol : solve(%,x);
(%o7) [x=0,x=2,x=14,x=16]
(%i8) makelist(subst(si,eq),si,sol);
(%o8) [0,0,0,0]
(%i9) eq : x = x^(1/3)$
(%i10) topoly(%);
(%o10) (x-1)*x*(x+1)=0
(%i11) eq : sqrt(x) + sqrt(x-5) = sqrt(7) + sqrt(2)$
(%i12) topoly(%);
(%o12) x-7=0
(%i37) eq : sqrt(x) + sqrt(x-1)/5 = 10$
(%i38) topoly(%);
(%o38) 576*x^2-129952*x+6255001=0
(%i39) sol : solve(%,x);
(%o39) [x=-(125*sqrt(619)-8122)/72,x=(125*sqrt(619)+8122)/72]
(%i40) makelist(subst(si,eq),si, sol)$
(%i41) float(%);
(%o41) [10.0=10.0,14.97995176820824=10.0]
Looks like there is one solution (unless the two square
roots in the equation are allowed to have different branches,
I suppose).
Amusement:
We could have topoly(sqrt(5) - x) --> sqrt(5) - x, but it's
more fun to have it evaluate to x^2 - 25. Proof:
(%i1) eq : sum(sqrt(k),k,1,5)-x;
(%o1) -x+sqrt(5)+sqrt(3)+sqrt(2)+3
(%i2) p : topoly(eq);
(%o2) x^8-24*x^7+212*x^6-792*x^5+622*x^4+3768*x^3-10140*x^2+8568*x-2151=0
(%i3) sol : solve(p,x)$
(%i4) float([eq, last(sol)]);
(%o4) [8.382332347441762-1.0*x,x=8.382332347441764]
(%i5) last(sol);
(%o5)
x=(sqrt(2)*sqrt(15^(3/4)+2*sqrt(4*sqrt(15)+15)+5*15^(1/4))+3*15^(1/8))/15^(1/8)
Tex this and paste it on your wall -- that's the best use I know for this
identity.
---- start topoly.lisp---------------------
(defun suppress-multiple-zeros (q)
(let ((acc 1) ($factorflag nil))
(setq q ($factor q))
(setq q (if (mtimesp q) (margs q) (list q)))
(dolist (qi q acc)
(setq acc (mul acc (cond ((mnump qi) (if (eq t (meqp qi 0)) 0 1))
((mexptp qi) (nth
1 qi))
(t qi)))))))
(defun $topoly (p)
(let ((subs) (nv `((mlist)))) ;; new variables
(setq p (meqhk p))
(setq p (to-polynomial p nil))
(setq subs (second p))
(setq p (first p))
(dolist (sk subs)
(setq nv ($append nv ($listofvars ($lhs sk)))))
(setq p (if (null subs) p ($first (mfuncall '$eliminate `((mlist) ,p
, at subs) nv))))
`((mequal) ,(suppress-multiple-zeros p) 0)))
(defun to-polynomial (p subs)
(cond (($mapatom p) (list p subs))
((mexptp p)
(let ((n (nth 2 p)) (b (nth 1 p)) (nv)(l))
(cond ((integerp n) (list p subs))
(($ratnump n)
(setq b (to-polynomial b nil))
(setq subs (append (second b) subs))
(setq b (first b))
(setq nv (gensym))
(setq subs (cons `((mequal) ,(power nv
($denom n)) ,(power b ($num n))) subs))
(list nv subs))
(t (merror "Nonalgebraic argument given
to 'topoly'")))))
((op-equalp p 'mabs)
(setq b (to-polynomial (first (margs p)) nil))
(setq subs (append (second b) subs))
(setq b (first b))
(setq nv (gensym))
(list nv (cons `((mequal) ,(power nv 2) ,(power b 2))
subs)))
((mtimesp p)
(let ((z 1) (acc nil))
(setq p (mapcar #'(lambda (s) (to-polynomial s nil))
(margs p)))
(dolist (pk p)
(setq z (mul z (first pk)))
(setq acc (append acc (second pk))))
(list z acc)))
((mplusp p)
(let ((z 0) (acc nil))
(setq p (mapcar #'(lambda (s) (to-polynomial s nil))
(margs p)))
(dolist (pk p)
(setq z (add z (first pk)))
(setq acc (append acc (second pk))))
(list z acc)))
(t (merror "Nonalgebraic argument given to 'topoly'"))))
------ end of topoly.lisp--------------------
Barton