How to find root-free form of an equation
I've done this before by replacing fractional powers by a variable and introducing appropriate relations (such as under "Set-up" here). Then you eliminate the new variables.
rat[eq_] := Module[{eqn, rads, reps, i, u},
eqn = eq /. Equal -> Subtract;
rads = DeleteDuplicates@Cases[eqn, Sqrt[_], Infinity];
reps = (i = 0; # -> u[++i] & /@ rads);
Eliminate[
Append[(i = 0; First[#] == u[++i]^2 & /@ rads), eqn == 0 /. reps],
Array[u, Length@rads]
]
]
rat[Sqrt[a] + Sqrt[b] == Sqrt[c]]
(* -b^2 + 2 b c - c^2 == a^2 + a (-2 b - 2 c) *)
eee[n_] := Sum[r[i] Sqrt[(x[i] - a[i])^2 + (y[i] - b[i])^2], {i, n}] == T;
rat[eee[2]]
(* T^4 + T^2 (-2 a[1]^2 r[1]^2 - ...) == -a[1]^4 r[1]^4 - ... - r[2]^4 y[2]^4 *)
rat[eee[3]]
(* takes a bit longer than lunch :)
T^8 + T^6 (...) + ... == ...
*)
Each square root doubles the degree. The combinatorial explosion possible can be seen by adding just a linear term to the first example:
rat[Sqrt[a] + Sqrt[b] == Sqrt[c] + x]
(*
a^4 + a^3 (-4 b - 4 c - 4 x^2) +
a^2 (6 b^2 + 4 b c + 6 c^2 + 4 b x^2 + 4 c x^2 + 6 x^4) +
a (-4 b^3 + 4 b^2 c + 4 b c^2 - 4 c^3 + 4 b^2 x^2 - 40 b c x^2 +
4 c^2 x^2 + 4 b x^4 + 4 c x^4 - 4 x^6) == -b^4 + 4 b^3 c -
6 b^2 c^2 + 4 b c^3 - c^4 + 4 b^3 x^2 - 4 b^2 c x^2 - 4 b c^2 x^2 +
4 c^3 x^2 - 6 b^2 x^4 - 4 b c x^4 - 6 c^2 x^4 + 4 b x^6 + 4 c x^6 - x^8
*)
Here a simple and very fast procedure to eliminate the square roots.
First bring all summands of the equation on one side and make a list.
list = List @@ (Sqrt[a] + Sqrt[b] - Sqrt[c] - x);
Then define Tuples and delete the ones that differ only by factor -1.
tup[n_ ] := Tuples[{-1, 1}, n];
uni = Union[tup[4], SameTest -> (#1 == -#2 &)]
(* {{-1, -1, -1, -1}, {-1, -1, -1, 1}, {-1, -1, 1, -1}, {-1, -1, 1,
1}, {-1, 1, -1, -1}, {-1, 1, -1, 1}, {-1, 1, 1, -1}, {-1, 1, 1, 1}} *)
Now multipliy the equation with all these selected tuples.
Times @@ (Plus @@ # & /@ (list*# & /@ uni)) // Expand
(* a^4 - 4 a^3 b + 6 a^2 b^2 - 4 a b^3 + b^4 - 4 a^3 c + 4 a^2 b c +
4 a b^2 c - 4 b^3 c + 6 a^2 c^2 + 4 a b c^2 + 6 b^2 c^2 - 4 a c^3 -
4 b c^3 + c^4 - 4 a^3 x^2 + 4 a^2 b x^2 + 4 a b^2 x^2 - 4 b^3 x^2 +
4 a^2 c x^2 - 40 a b c x^2 + 4 b^2 c x^2 + 4 a c^2 x^2 +
4 b c^2 x^2 - 4 c^3 x^2 + 6 a^2 x^4 + 4 a b x^4 + 6 b^2 x^4 +
4 a c x^4 + 4 b c x^4 + 6 c^2 x^4 - 4 a x^6 - 4 b x^6 - 4 c x^6 + x^8 *)
This works for all dinensions and for your general example.
su = Sum[r[i] Sqrt[(x[i] - a[i])^2 + (y[i] - b[i])^2], {i, 3}] - T;
list = List @@ su
uni = Union[tup[4], SameTest -> (#1 == -#2 &)]
Times @@ (Plus @@ # & /@ (list*# & /@ uni)) // Expand
(* A very large output was generated
T^8-4 T^6 a[1]^2 r[1]^2-.... *)
Appendix
In general you have to multiply with Length[onesided equation] tuples
(( Sqrt[a] + Sqrt[b] - Sqrt[c]) (- Sqrt[a] + Sqrt[b] - Sqrt[
c]) (- Sqrt[a] - Sqrt[b] - Sqrt[c]) (
Sqrt[a] - Sqrt[b] - Sqrt[c]) // Expand) == 0
(* a^2 - 2 a b + b^2 - 2 a c - 2 b c + c^2 == 0 *)
But if you have less than Length[...]-1 square roots, you only have to permutate sign of the square root summands to get the minimal form
(( Sqrt[a] + b - c) (- Sqrt[a] + b - c) // Expand) == 0
(* -a + b^2 - 2 b c + c^2 == 0 *)
(( Sqrt[a] + Sqrt[b] - c + d) (- Sqrt[a] + Sqrt[b] - c +
d) (- Sqrt[a] - Sqrt[b] - c + d) ( Sqrt[a] - Sqrt[b] - c + d) //
Expand) == 0
(* a^2 - 2 a b + b^2 - 2 a c^2 - 2 b c^2 + c^4 + 4 a c d + 4 b c d -
4 c^3 d - 2 a d^2 - 2 b d^2 + 6 c^2 d^2 - 4 c d^3 + d^4 == 0 *)
This is not so different from the response by @MichaelE2, but probably faster on larger problems (don't expect miracles though). It has the weakness of requiring that radicals be algebraically independent. That could be removed but it would take some work.
I'll work with expressions rather than equations so that Variables and the like behave.
The example:
expr = n1*Sqrt[(x - a1)^2 + y^2] + n2*Sqrt[(x - a2)^2 + y^2] - T;
Get the variables and the radicals, the latter in the convenient form of {radicand,power}.
vars = Variables[expr]
rads = Union[Cases[expr, Power[a_, b_Rational] :> {a, b}, Infinity]]
(* Out[296]= {a1, a2, n1, n2, T, x, y}
Out[297]= {{(-a1 + x)^2 + y^2, 1/2}, {(-a2 + x)^2 + y^2, 1/2}} *)
Create a new variable and defining relation for each, and then substitue the new variables for the radicals in the original expression.
newvars = Array[rad, Length[rads]];
replacement = Thread[rads[[All, 1]]^rads[[All, 2]] -> newvars];
newexprs =
Thread[newvars^Denominator[rads[[All, 2]]] -
rads[[All, 1]]^Numerator[rads[[All, 2]]]];
newexpr = expr /. replacement;
Now eliminate the new variables.
AbsoluteTiming[
First[GroebnerBasis[Flatten[{newexprs, newexpr}], vars, newvars,
MonomialOrder -> EliminationOrder]]]
(* Out[303]= {0.002461,
a1^4 n1^4 - 2 a1^2 a2^2 n1^2 n2^2 + a2^4 n2^4 - 2 a1^2 n1^2 T^2 -
2 a2^2 n2^2 T^2 + T^4 - 4 a1^3 n1^4 x + 4 a1^2 a2 n1^2 n2^2 x +
4 a1 a2^2 n1^2 n2^2 x - 4 a2^3 n2^4 x + 4 a1 n1^2 T^2 x +
4 a2 n2^2 T^2 x + 6 a1^2 n1^4 x^2 - 2 a1^2 n1^2 n2^2 x^2 -
8 a1 a2 n1^2 n2^2 x^2 - 2 a2^2 n1^2 n2^2 x^2 + 6 a2^2 n2^4 x^2 -
2 n1^2 T^2 x^2 - 2 n2^2 T^2 x^2 - 4 a1 n1^4 x^3 +
4 a1 n1^2 n2^2 x^3 + 4 a2 n1^2 n2^2 x^3 - 4 a2 n2^4 x^3 +
n1^4 x^4 - 2 n1^2 n2^2 x^4 + n2^4 x^4 + 2 a1^2 n1^4 y^2 -
2 a1^2 n1^2 n2^2 y^2 - 2 a2^2 n1^2 n2^2 y^2 + 2 a2^2 n2^4 y^2 -
2 n1^2 T^2 y^2 - 2 n2^2 T^2 y^2 - 4 a1 n1^4 x y^2 +
4 a1 n1^2 n2^2 x y^2 + 4 a2 n1^2 n2^2 x y^2 - 4 a2 n2^4 x y^2 +
2 n1^4 x^2 y^2 - 4 n1^2 n2^2 x^2 y^2 + 2 n2^4 x^2 y^2 + n1^4 y^4 -
2 n1^2 n2^2 y^4 + n2^4 y^4} *)
For eee[3] in the prior response it produces a result of leaf count around 150K in somewhat under a second. Given eee[4] it ran out of memory on my low-RAM desk top after 3-4 minutes (kernel crash). Might or might not fare better on a bigger machine.
Update: eee[4] ran to completion on a machine with more memory. It took approximately a day. It's larger than the print code cares to consider.