#### QUESTION

I want

$\left\{\frac{1}{1+\sqrt{2}-\sqrt{3}},\sqrt{5-2 \sqrt{6}},\sqrt{4+\sqrt{15}}\right\}$

to be simplified to

$\left\{\frac{1}{4} \left(2+\sqrt{2}+\sqrt{6}\right), \sqrt{3}-\sqrt{2}, \frac{1}{2} \left(\sqrt{6}+\sqrt{10}\right)\right\}$

But I haven't been able to get that result with Mathematica. How could I get it?

#### ANSWER

There is a literature on denesting radicals. Not really my strength. In cases where you know (or suspect) the specific radicals that should appear in the result you can use a Groebner basis computation to recast your algebraic value via a minimal polynomial. Then factor over the extension defined by those radicals, solve, and pick the solution that is numerically correct (the others being algebraic conjugates). I illustrate with that first example.

```
rootpoly =
GroebnerBasis[{x*xrecip - 1, xrecip - (1 + y - z), y^2 - 2, z^2 - 3},
x, {xrecip, y, z}][[1]]
(* -1 + 4*x + 4*x^2 - 16*x^3 + 8*x^4 *)
fax =
Select[FactorList[rootpoly, Extension -> {Sqrt[2], Sqrt[3]}][[All,
1]], ! FreeQ[#, x] &]
(* {2 + Sqrt[2] + Sqrt[6] - 4*x, -2 - Sqrt[2] + Sqrt[6] + 4*x,
2 - Sqrt[2] + Sqrt[6] - 4*x, -2 + Sqrt[2] + Sqrt[6] + 4*x} *)
candidates = Flatten[Map[x /. Solve[# == 0, x] &, fax]];
First[Select[candidates, (N[#] == 1/(1 + Sqrt[2] - Sqrt[3])) &]]
(* (1/4)*(2 + Sqrt[2] + Sqrt[6]) *)
```

If you are more familiar with manipulating algebraic numbers than you are with Groebner bases, here is a better way to get that defining polynomial.

```
RootReduce[1/(1 + Sqrt[2] - Sqrt[3])][[1]][x]
(* Out[35]= -1 + 4 x + 4 x^2 - 16 x^3 + 8 x^4 *)
```

--- edit ---

I will show this in a way that is more automated, in terms of deciding what to use in the extension for factoring. The idea is to allow roots of all factors of all integers that appear in the nested radical.

```
val = Sqrt[4 + Sqrt[15]];
rootpoly = RootReduce[val][[1]][x]
(* 1 - 8 x^2 + x^4 *)
ints =
Flatten[Map[FactorInteger, Cases[val, _Integer, -1]][[All, All, 1]]]
(* {2, 3, 5} *)
fax =
Select[FactorList[rootpoly, Extension -> Sqrt[ints]][[All, 1]], !
FreeQ[#, x] &]
(* {Sqrt[6] + Sqrt[10] - 2 x, Sqrt[6] - Sqrt[10] + 2 x,
Sqrt[6] - Sqrt[10] - 2 x, Sqrt[6] + Sqrt[10] + 2 x} *)
candidates = Flatten[Map[x /. Solve[# == 0, x] &, fax]];
First[Select[candidates, (N[#] == val) &]]
(* 1/2 (Sqrt[6] + Sqrt[10] *)
```

--- end edit ---

Tweet