)abbrev package ROOTUT RootUtilities
++ Description: This package implements 'complex_roots'.
RootUtilities(R, F) : Exports == Implementation where
  R : Join(GcdDomain, RetractableTo Integer, Comparable,
           LinearlyExplicitOver Integer)
  F : Join(AlgebraicallyClosedFunctionSpace R,
          TranscendentalFunctionCategory)
  C_rec ==> Record(real : F, imag : F)
  r_rec ==> Record(reals : List(F), complexes : List(C_rec))
  SUP ==> SparseUnivariatePolynomial
  UP ==> SUP(F)
  Exports ==> with
    complex_roots : UP -> Union(r_rec, "failed")
      ++ complex_roots(p) computes roots of p in terms of radicals
      ++ separating real and complex roots.
      ++ Returns "failed" when unsuccessful.
    radical_solve : UP -> Union(List(F), "failed")
      ++ radical_solve(p) tries to solve polynomial p in terms
      ++ of radicals.
      ++ Returns "failed" when unsuccessful.
    quartic2 : (UP, F) -> Union(r_rec, "failed")
      ++ quartic2(p, a0) should be local but conditional
    my_sqrt : F -> F
      ++ my_sqrt(a) should be local but conditional
    my_root3 : F -> F
      ++ my_root3(a) should be local but conditional

  Implementation ==> add

    import from AlgebraicManipulations(R, F)
    import from ElementaryFunctionSign(R, F)

    K ==> Kernel F
    P ==> SparseMultivariatePolynomial(R, K)

    dummy := create()$SingletonAsOrderedSet

    root_pair(a : F, b : F) : C_rec == [a, b]

    my_imag := sqrt(-1)

    root4(a : F) : F ==
        rec := froot(a, 4)$PolynomialRoots(IndexedExponents(K), K, R, P, F)
        p1 := monomial(1, rec.exponent)$UP - rec.radicand::UP
        rec.coef*zeroOf(p1)

    if F has PolynomialFactorizationExplicit then

        my_sqrt(a : F) : F ==
            p := monomial(1, 2)$UP - a::UP
            fr := factor(p)
            fl := factorList(fr)
            #fl = 1 => sqrt(a)
            fr1 := fl(1).factor
            degree(fr1) ~= 1 => error "impossible"
            -coefficient(fr1, 0)/coefficient(fr1, 1)

        my_root3(a : F) : F ==
            p := monomial(1, 3)$UP - a::UP
            fr := factor(p)
            fl := factorList(fr)
            #fl = 1 => a^(1/3)
            fr1 := fl(1).factor
            if degree(fr1) ~= 1 then
                fr1 := fl(2).factor
            degree(fr1) ~= 1 => error "impossible"
            -coefficient(fr1, 0)/coefficient(fr1, 1)

        do_rp(r : F, q : F, res1 : r_rec) : Union(r_rec, "failed") ==
            (su := sign(q)) case "failed" => "failed"
            (0 < su@Integer) =>
                qr := my_sqrt(q)
                [res1.reals, cons(root_pair(r, qr), res1.complexes)]
            qr := my_sqrt(-q)
            [cons(r + qr, cons(r - qr, res1.reals)), res1.complexes]

        -- Square of real part u and square of imaginary part v
        -- satisfy (-4)*u*v^2+(4*u^3+2*a*u+b) = 0
        -- so given real part we compute imaginary parts.
        -- In fact, above u is square of average of two roots and
        -- -v^2 is square of half of difference between roots, so
        -- this also works for real roots.
        quartic3(r1 : F, a0 : F, a : F, b : F) : Union(r_rec, "failed") ==
            rr := my_sqrt(r1)
            qq := r1 + (1/2::F)*a
            q1 := qq + b*rr/(4*r1)
            res1 := do_rp(rr + a0, q1, [[], []])
            res1 case "failed" => "failed"
            q2 := qq - b*rr/(4*r1)
            do_rp(-rr + a0, q2, res1)

        do_f2(del : F, a2 : F, b2 : F, a0 : F, a : F, b : F
             ) : Union(r_rec, "failed") ==
            d2 := my_sqrt(del)
            (su := sign(d2)) case "failed" => "failed"
            if su@Integer < 0 then
                d2 := -d2
            quartic3((-b2 + d2)/(2*a2), a0, a, b)

        -- Squares of averages of pairs of roots of quartic satisfy
        -- equation 64u^3 + 32au^2 + (-16c+4a^2)*u - b^2 = 0.
        -- If the qubic factors, and we can determine needed
        -- signs, then this works, otherwise fails.
        quartic2(p : UP, a0 : F) : Union(r_rec, "failed") ==
            a := coefficient(p, 2)
            b := coefficient(p, 1)
            c := coefficient(p, 0)
            xx := monomial(1, 1)$UP
            r := 64*xx^3 + 32*a*xx^2
            r := r + (-16*c+4*a^2)*xx
            r := r - (b^2)::UP
            fr := factor(r)
            fl := factorList(fr)
            flf : List(UP) := []
            for fac in fl repeat
                f1 := fac.factor
                for i in 1..fac.exponent repeat
                    flf := cons(f1, flf)
            #flf = 1 => "failed"
            #flf = 3 =>
                r1 : F
                cnt : Integer := 0
                for f1 in flf repeat
                    cc := coefficient(f1, 0)/coefficient(f1, 1)
                    (su := sign(cc)) case "failed" => return "failed"
                    if su@Integer < 0 then
                        cnt := cnt + 1
                        cnt > 1 => iterate
                        r1 := cc
                cnt = 0 => error "impossible"
                quartic3(-r1, a0, a, b)
            #flf = 2 =>
                r1 : F
                f1 := first(flf)
                f2 := second(flf)
                if degree(f2) = 1 then
                    (f1, f2) := (f2, f1)
                r1 := -coefficient(f1, 0)/coefficient(f1, 1)
                (su := sign(r1)) case "failed" => return "failed"
                s1 := su@Integer
                a2 := coefficient(f2, 2)
                b2 := coefficient(f2, 1)
                del := b2^2 - 4*a2*coefficient(f2, 0)
                if not(su := sign(del)) case "failed" then
                    if su@Integer < 0 then return
                        0 < s1 => quartic3(r1, a0, a, b)
                        error "impossible"
                    not(0 < s1) => return do_f2(del, a2, b2, a0, a, b)
                    t1 := r1 + b2/(2*a2)
                    t2 := del/(4*a2*a2) - t1*t1
                    if not(su := sign(t2)) case "failed" then
                        (0 < su@Integer) =>
                            return do_f2(del, a2, b2, a0, a, b)
                        return quartic3(r1, a0, a, b)
                su := sign(b2)
                su case "failed" or not(0 < su@Integer) => return "failed"
                su := sign(a2*coefficient(f2, 0))
                if su case "failed" or not(0 < su@Integer) then
                    return "failed"
                quartic3(r1, a0, a, b)
            error "impossible"

    else

        quartic2(p : UP, a0 : F) : Union(r_rec, "failed") == "failed"

        my_sqrt(a : F) ==
            rec := froot(a, 2)$PolynomialRoots(IndexedExponents(K), K, R, P, F)
            rec.exponent = 2 => sqrt(a)
            rec.coef*rec.radicand

        my_root3(a : F) : F ==
            rec := froot(a, 3)$PolynomialRoots(IndexedExponents(K), K, R, P, F)
            rec.exponent = 3 => a^(1/3)
            rec.coef*rec.radicand

    qubic(p : UP) : Union(r_rec, "failed") ==
        p := (1/leadingCoefficient(p))*p
        a0 := -coefficient(p, 2)/3::F
        p := eval(p, dummy, monomial(1, 1)$UP + a0::UP)
        ground?(rp := reductum(p)) =>
            a := ground(rp)
            a = 0 => [[a0, a0, a0], []]
            (su := sign(a)) case "failed" => "failed"
            (su@Integer < 0) =>
                r1 := my_root3(-a)
                (su := sign(r1)) case "failed" => "failed"
                [[r1 + a0], [root_pair(-r1/(2::F) + a0,
                                       sqrt(3::F)*r1/(2::F))]]
            r1 := my_root3(a)
            (su := sign(r1)) case "failed" => "failed"
            [[-r1 + a0], [root_pair(r1/(2::F) + a0, sqrt(3::F)*r1/(2::F))]]
        "failed"

    quartic0(p : UP, a0 : F) : Union(r_rec, "failed") ==
        pu := p exquo monomial(1, 1)$UP
        pu case "failed" => error "impossible"
        p := pu@UP
        ru := qubic(p)
        ru case "failed" => "failed"
        r1 := ru@r_rec
        rl : List(F) := [a0]
        for r in r1.reals repeat
            rl := cons(r + a0, rl)
        cl : List(C_rec) :=
            empty?(r1.complexes) => []
            cp := first(r1.complexes)
            [root_pair(cp.real + a0, cp.imag)]
        [rl, cl]

    quartic(p : UP) : Union(r_rec, "failed") ==
        coefficient(p, 0) = 0 => quartic0(p, 0)
        lc := leadingCoefficient(p)
        p := (1/lc)*p
        a0 := -coefficient(p, 3)/(4::F)
        p := eval(p, dummy, monomial(1, 1)$UP + a0::UP)
        ground?(rp := reductum(p)) =>
            a := ground(rp)
            a = 0 => [[a0, a0, a0, a0], []]
            (su := sign(a)) case "failed" => "failed"
            (si := su@Integer) = 1 =>
                r1 := root4(a/(4::F*leadingCoefficient(p)))
                [[], [root_pair(r1 + a0, r1), root_pair(-r1 + a0, r1)]]
            si = -1 =>
                r1 := rootSimp(zeroOf(p))
                [[r1 + a0, -r1 + a0], [root_pair(a0, r1)]]
            error "impossible"
        coefficient(p, 0) = 0 => quartic0(p, a0)
        coefficient(p, 1) = 0 =>
            b := coefficient(p, 2)
            c := coefficient(p, 0)
            del := b*b - 4*c
            (su := sign(del)) case "failed" => "failed"
            not((si := su@Integer) < 0) =>
                r1 := my_sqrt(del)
                x1 := (-b + r1)/(2::F)
                x2 := (-b - r1)/(2::F)
                (su := sign(x1)) case "failed" => "failed"
                (su@Integer < 0) =>
                    [[], [root_pair(a0, my_sqrt(-x1)),
                          root_pair(a0, my_sqrt(-x2))]]
                (su := sign(x2)) case "failed" => "failed"
                r2 := my_sqrt(x1)
                (su@Integer < 0) =>
                    [[r2 + a0, -r2 + a0], [root_pair(a0, my_sqrt(-x2))]]
                r3 := my_sqrt(x2)
                [[r2 + a0, -r2 + a0, r3 + a0, -r3 + a0], []]
            quartic2(p, a0)
        quartic2(p, a0)

    complex_roots(p : UP) : Union(r_rec, "failed") ==
        d := degree(p)
        (d = 3) => qubic(p)
        (d = 4) => quartic(p)
        "failed"

    radical_solve(p : UP) : Union(List(F), "failed") ==
        r1u := complex_roots(p)
        r1u case "failed" => "failed"
        r1 := r1u@r_rec
        res := reverse!(r1.reals)
        for c1 in r1.complexes repeat
            res := cons(c1.real + my_imag*c1.imag, res)
            res := cons(c1.real - my_imag*c1.imag, res)
        reverse!(res)


)abbrev package RSIMP RootSimplification
)boot $tryRecompileArguments := nil
++ Description:
++  This package performs root simplifications developing further
++  methods from references below.
++ References:
++  A. Borodin et all,
++   Decreasing the Nesting Depth of Expressions Involving Square Roots,
++   JSC (1985) 1, 169-188.
++  R. Zippel,
++   Simplification of expressions involving radicals,
++   JSC (1985) 1, 189-210.
RootSimplification() : Exports == Implementation where
  eI ==> Expression(Integer)
  Exports ==> with
    rsimp : eI -> Union(eI, "failed")
      ++ rsimp(a : eI) : Union(eI, "failed") tries to express
      ++ a using roots of lower nesting depth.  If this fails
      ++ it returns "failed"
    rsimp1 : (eI, Integer) -> Union(eI, "failed")
      ++ rsimp1(a : eI, k : Integer) : Union(eI, "failed") returns
      ++ root of degree k of a if such root exists in the field
      ++ generated by kernels contained in a.
      ++ Otherwise it returns "failed".

  Implementation ==> add

    -- Below we need to initialize variables with large expressions.
    -- Spad compiler and sbcl have trouble with the expressions
    -- (sbcl runs out of memory compiling resulting code).  Instead
    -- we pass expressions as strings to interpreter for evaluation.
    -- Since it is done only when we instantiate this package the
    -- overhead is acceptable.
    --
    -- Helper function to evaluate string as expression.
    str_to_expr(s : String) : eI ==
        af := parse(s)$InputForm
        av := interpret_in_new_env(af)$InputForm
        retract(av)$AnyFunctions1(eI)

    SUP ==> SparseUnivariatePolynomial
    RF ==> Fraction(SUP(eI))
    fRU ==> Factored(SUP(eI))
    K ==> Kernel(eI)

    a := 'a::eI
    b := 'b::eI
    c := 'c::eI
    kc := kernel('c)$K
    r := 'r::eI

    ------------------------------------------------------------------
    -- Denesting when base field is generated by square root
    -- and we are computing roots of degree between 3 and 11

    p2c := b*c^2 - 2*a*c + b*r
    p2cu := numer(univariate(p2c, kc)$eI)$RF
    p2s := (-b*c + 2*a)/(2*r)

    p3c := (3*b*c+(-1)*a)*r+(b*c^3+(-3)*a*c^2)
    -- p3cu := numer(univariate(p3c::eI, c))
    p3cu := numer(univariate(p3c, kc))
    p3s := (8*b*r+(3*b*c^2+(-9)*a*c))/(8*r^2)

    p5c := (5*b*c - a)*r^2 + (10*b*c^3 - 10*a*c^2)*r + b*c^5  - 5*a*c^4
    p5cu := numer(univariate(p5c, kc))
    p5s := (128*b*r^2 + (345*b*c^2 - 325*a*c)*r + 35*b*c^4 - 175*a*c^3) _
           /(128*r^4)

    p7c := (7*b*c+(-1)*a)*r^3+(35*b*c^3+(-21)*a*c^2)*r^2+(21*b*c^5 _
           +(-35)*a*c^4)*r+(b*c^7+(-7)*a*c^6)
    p7cu := numer(univariate(p7c, kc))
    p7s := (1024*b*r^3+(7651*b*c^2+(-4165)*a*c)*r^2+(4830*b*c^4 _
           +(-7938)*a*c^3)*r+(231*b*c^6+(-1617)*a*c^5))/(1024*r^6)

    p11c := (11*b*c+(-1)*a)*r^5+(165*b*c^3+(-55)*a*c^2)*r^4+(462*b*c^5 _
            +(-330)*a*c^4)*r^3+(330*b*c^7+(-462)*a*c^6)*r^2+(55*b*c^9 _
            +(-165)*a*c^8)*r+(b*c^11+(-11)*a*c^10)
    p11cu := numer(univariate(p11c, kc))
    p11s := (262144*b*r^5+(6631845*b*c^2+(-1913615)*a*c)*r^4+(20560540*b*c^4 _
       +(-14188460)*a*c^3)*r^3+(15109094*b*c^6+(-20942922)*a*c^5)*r^2 _
       +(2537964*b*c^8+(-7594444)*a*c^7)*r+(46189*b*c^10+(-508079)*a*c^9)) _
        /(262144*r^10)

    rsimp1_gen_2(av : eI, bv : eI, rv : eI, pcu : SUP(eI), ps : eI
                ) : Union(List(eI), "failed") ==
        -- print(message("rsimp1_gen_2")$OutputForm)$OutputForm
        el1 := [a = av, b = bv, r = rv]$List(Equation(eI))
        -- print(message("el1 assigned")$OutputForm)$OutputForm
        pcue : SUP(eI) := map((c1 : eI) : eI +-> subst(c1, el1), pcu)
        -- print(message("after map")$OutputForm)$OutputForm
        -- print(pcue::OutputForm)$OutputForm
        fl := factorList(factor(pcue))$fRU
        -- print(fl::OutputForm)$OutputForm
        for fac in fl repeat
            fp := fac.factor
            if degree(fp) = 1 then
                -- print(message("found linear factor")$OutputForm)$OutputForm
                -- print(fp::OutputForm)$OutputForm
                cv := -coefficient(fp, 0)/leadingCoefficient(fp)
                el2 := cons('c::eI = cv, el1)
                sv := subst(ps, el2)
                return [sv, cv, 1]
        "failed"

    rsimp_gen_2a(rl : List(eI), rv : eI) : Union(List(eI), "failed") ==
        s := rl(1); av := rl(2); bv := rl(3);
        res2 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
        if res2 case "failed" then
            tmp := rv*bv
            s := s/rv; bv := av; av := tmp
            res2 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
        res2 case "failed" => "failed"
        cons(s, res2)

    rsimp_gen_2(av : eI, bv : eI, rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        k = 2 => rsimp1_gen_2(av, bv, rv, p2cu, p2s)
        k = 3 => rsimp1_gen_2(av, bv, rv, p3cu, p3s)
        k = 4 =>
            res1 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
            res1 case "failed" => "failed"
            (res2 := rsimp_gen_2a(res1, rv)) case "failed" => "failed"
            r2l := res2@List(eI)
            [r2l(1)*r2l(2)^2, r2l(3), r2l(4)]
        k = 5 => rsimp1_gen_2(av, bv, rv, p5cu, p5s)
        k = 6 =>
            res1 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_2(r1l(2), r1l(3), rv, p3cu, p3s)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [r1l(1)*r2l(1)^2, r2l(2), r2l(3)]
        k = 7 => rsimp1_gen_2(av, bv, rv, p7cu, p7s)
        k = 8 =>
            res1 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
            res1 case "failed" => "failed"
            (res2 := rsimp_gen_2a(res1, rv)) case "failed" => "failed"
            r2l := res2@List(eI)
            s := r2l(1)
            (res3 := rsimp_gen_2a(rest(r2l), rv)) case "failed" => "failed"
            r3l := res3@List(eI)
            [s*r3l(1)^2*r3l(2)^4, r3l(3), r3l(4)]
        k = 9 =>
            res1 := rsimp1_gen_2(av, bv, rv, p3cu, p3s)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_2(r1l(2), r1l(3), rv, p3cu, p3s)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [r1l(1)*r2l(1)^3, r2l(2), r2l(3)]
        k = 10 =>
            res1 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_2(r1l(2), r1l(3), rv, p5cu, p5s)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [r1l(1)*r2l(1)^2, r2l(2), r2l(3)]
        k = 11 => rsimp1_gen_2(av, bv, rv, p11cu, p11s)
        k = 12 =>
            res1 := rsimp1_gen_2(av, bv, rv, p2cu, p2s)
            res1 case "failed" => "failed"
            (res2 := rsimp_gen_2a(res1, rv)) case "failed" => "failed"
            r2l := res2@List(eI)
            s := r2l(1)
            r2l := rest(r2l)
            res3 := rsimp1_gen_2(r2l(2), r2l(3), rv, p3cu, p3s)
            res3 case "failed" => "failed"
            r3l := res3@List(eI)
            [s*r2l(1)^2*r3l(1)^4, r3l(2), r3l(3)]
        "failed"


    ------------------------------------------------------------------
    -- Base field generated by root of degree 3.
    -- We are trying to solve equation
    --  a + b*r^(1/3) + c*r^(2/3) = s*(d + e*r^(1/3) + f*r^(2/3))^k
    --
    -- for k \in [2, 3].
    --
    -- Case when k = 2 and f = 0 need to be handled separately (it is
    -- easier).
    -- When f ~= 0 by changing s we can assume f = 1.  With that
    -- assumption we get solutions below

    init_str : String := "eI := Expression(Integer); a := 'a::eI; " _
       "b := 'b::eI; c := 'c::eI; r := 'r::eI; e := 'e::eI;"
    e := 'e::eI;
    ke := kernel('e)$K

    -- Equation for coefficient e
    rp2 := str_to_expr( init_str _
           "(-1)*c^2*r^2+((-8)*c^2*e^3+18*b*c*e^2+((-4)*a*c+(-8)*b^2)*e+" _
           "4*a*b)*r +((4*a*c+(-1)*b^2)*e^4+(-4)*a*b*e^3)");
    rp2u := numer(univariate(rp2, ke))$RF
    -- Expression for d
    rp2d := str_to_expr( init_str _
           "((8*c^3*e^2+(-9)*b*c^2*e+(4*a*c^2+(-1)*b^2*c))*r" _
           " +(((-4)*a*c^2+b^2*c)*e^3+b^3*e^2))/(2*c^3*r+(-2)*b^3)");
    -- Expression for s
    rp2s := str_to_expr( init_str _
       "(((-8)*c^4*e+10*b*c^3)*r^2+((4*a*c^3+(-9)*b^2*c^2)*e^2+17*b^3*c*e" _
        "+((-4)*a*b^2*c+(-9)*b^4))*r+((4*a*b^2*c+(-1)*b^4)*e^3" _
         "+(-4)*a*b^3*e^2))/(9*c^3*r^3+(-9)*b^3*r^2)");

    rp3e := str_to_expr( init_str _
      "(-1)*c^3*r^4+(3*c^3*e^3+(3*a*b*c+(-1)*b^3))*r^3" _
      "+(24*c^3*e^6+(-81)*b*c^2*e^5+(27*a*c^2+81*b^2*c)*e^4" _
      "+((-63)*a*b*c+(-24)*b^3)*e^3+(9*a^2*c+27*a*b^2)*e^2" _
      "+(-9)*a^2*b*e)*r^2+(c^3*e^9+(-27)*a*c^2*e^7+(63*a*b*c+(-3)*b^3)*e^6" _
      "+((-18)*a^2*c+(-27)*a*b^2)*e^5+18*a^2*b*e^4)*r+(((-3)*a*b*c+b^3)*e^9" _
      "+9*a^2*c*e^8+(-9)*a^2*b*e^7)");
    rp3u := numer(univariate(rp3e, ke))$RF;
    rp3d := str_to_expr( init_str _
      "((7*c^9*e^2+(-18)*b*c^8*e+(13*a*c^8+(-11)*b^2*c^7))*r^5" _
      "+((-119)*c^9*e^5+336*b*c^8*e^4+((-140)*a*c^8+(-203)*b^2*c^7)*e^3" _
      "+(160*a*b*c^7+10*b^3*c^6)*e^2+((-41)*a^2*c^7+93*a*b^2*c^6" _
      "+(-43)*b^4*c^5)*e+((-58)*a^2*b*c^6+88*a*b^3*c^5+(-29)*b^5*c^4))*r^4" _
      "+((-5)*c^9*e^8+(-3)*b*c^8*e^7+(136*a*c^8+(-2)*b^2*c^7)*e^6+(289" _
       "*a*b*c^7+(-272)*b^3*c^6)*e^5+(94*a^2*c^7+(-1509)*a*b^2*c^6" _
      "+818*b^4*c^5)*e^4+(593*a^2*b*c^6+547*a*b^3*c^5+(-461)*b^5*c^4)*e^3" _
      "+(18*a^3*c^6+(-870)*a^2*b^2*c^5+519*a*b^4*c^4+(-37)*b^6*c^3)*e^2" _
      "+(144*a^3*b*c^5+(-157)*a^2*b^3*c^4+29*a*b^5*c^3+11*b^7*c^2)*e" _
      "+(27*a^4*c^5+(-36)*a^3*b^2*c^4+(-14)*a^2*b^4*c^3+15*a*b^6*c^2))*r^3" _
      "+((37*a*b*c^7+(-17)*b^3*c^6)*e^8+((-44)*a^2*c^7+21*a*b^2*c^6" _
      "+(-10)*b^4*c^5)*e^7+((-580)*a^2*b*c^6+337*a*b^3*c^5" _
      "+(-5)*b^5*c^4)*e^6+((-234)*a^3*c^6+1149*a^2*b^2*c^5" _
      "+(-657)*a*b^4*c^4+83*b^6*c^3)*e^5+(261*a^3*b*c^5" _
      "+29*a^2*b^3*c^4+44*a*b^5*c^3+(-139)*b^7*c^2)*e^4" _
      "+((-279)*a^4*c^5+(-171)*a^3*b^2*c^4+148*a^2*b^4*c^3" _
      "+(-201)*a*b^6*c^2+174*b^8*c)*e^3+(369*a^4*b*c^4" _
      "+(-117)*a^3*b^3*c^3" _
      "+(-45)*a^2*b^5*c^2+35*a*b^7*c+(-40)*b^9)*e^2" _
      "+((-81)*a^5*c^4+63*a^4*b^2*c^3+63*a^3*b^4*c^2" _
      "+(-77)*a^2*b^6*c+23*a*b^8)*e+(9*a^4*b^3*c^2" _
      "+(-4)*a^2*b^7))*r^2+(((-9)*a^3*c^6+(-63)*a^2*b^2*c^5" _
      "+57*a*b^4*c^4+(-10)*b^6*c^3)*e^8+(189*a^3*b*c^5" _
      "+(-142)*a^2*b^3*c^4+35*a*b^5*c^3+(-7)*b^7*c^2)*e^7" _
      "+(252*a^4*c^5+(-171)*a^3*b^2*c^4+55*a^2*b^4*c^3" _
      "+(-39)*a*b^6*c^2+(-3)*b^8*c)*e^6+((-423)*a^4*b*c^4" _
      "+135*a^3*b^3*c^3+(-96)*a^2*b^5*c^2+134*a*b^7*c" _
      "+(-7)*b^9)*e^5+(162*a^5*c^4+(-108)*a^4*b^2*c^3" _
      "+(-72)*a^3*b^4*c^2+136*a^2*b^6*c+(-61)*a*b^8)*e^4" _
      "+((-27)*a^5*b*c^3+36*a^3*b^5*c+(-16)*a^2*b^7)*e^3" _
      "+((-27)*a^5*b^2*c^2+18*a^4*b^4*c)*e^2+((-27)*a^5*b^3*c" _
      "+18*a^4*b^5)*e)*r+((27*a^4*b*c^4+(-18)*a^3*b^3*c^3" _
      "+6*a^2*b^5*c^2+(-7)*a*b^7*c+2*b^9)*e^8+((-81)*a^5*c^4" _
      "+45*a^4*b^2*c^3+(-18)*a^3*b^4*c^2+13*a^2*b^6*c+2*a*b^8)*e^7" _
      "+(27*a^5*b*c^3+(-9)*a^4*b^3*c^2+18*a^3*b^5*c" _
      "+(-16)*a^2*b^7)*e^6+(27*a^5*b^2*c^2+9*a^4*b^4*c" _
      "+(-18)*a^3*b^6)*e^5+(27*a^5*b^3*c+(-18)*a^4*b^5)*e^4))" _
      "/(9*c^9*r^5+((-54)*a*b*c^7+18*b^3*c^6)*r^4" _
      "+(18*a^3*c^6+54*a^2*b^2*c^5+(-18)*b^6*c^3)*r^3" _
      "+((-27)*a^4*b*c^4+(-54)*a^2*b^5*c^2+54*a*b^7*c" _
      "+(-9)*b^9)*r^2+(27*a^4*b^4*c+(-18)*a^3*b^6)*r)");

    rp3s := str_to_expr( init_str _
      "((117*c^13*e^2+(-91)*b*c^12*e+(40*a*c^12" _
      "+31*b^2*c^11))*r^7+(363*c^13*e^5+(-946)*b*c^12*e^4" _
      "+(346*a*c^12+571*b^2*c^11)*e^3+((-1276)*a*b*c^11" _
      "+109*b^3*c^10)*e^2+(121*a^2*c^11+601*a*b^2*c^10" _
      "+(-76)*b^4*c^9)*e+((-300)*a^2*b*c^10+(-138)*a*b^3*c^9" _
      "+56*b^5*c^8))*r^6+(15*c^13*e^8+11*b*c^12*e^7" _
      "+((-404)*a*c^12+10*b^2*c^11)*e^6+((-1057)*a*b*c^11" _
      "+571*b^3*c^10)*e^5+((-248)*a^2*c^11+4303*a*b^2*c^10" _
      "+(-1462)*b^4*c^9)*e^4+((-1449)*a^2*b*c^10" _
      "+(-1857)*a*b^3*c^9+674*b^5*c^8)*e^3+(238*a^3*c^10" _
      "+3290*a^2*b^2*c^9+(-85)*a*b^4*c^8+(-425)*b^6*c^7)*e^2" _
      "+((-730)*a^3*b*c^9+(-566)*a^2*b^3*c^8+(-668)*a*b^5*c^7" _
      "+424*b^7*c^6)*e+(81*a^4*c^9+570*a^3*b^2*c^8" _
      "+384*a^2*b^4*c^7+(-179)*a*b^6*c^6+(-55)*b^8*c^5))*r^5" _
      "+(((-115)*a*b*c^11+40*b^3*c^10)*e^8+(136*a^2*c^11" _
      "+(-89)*a*b^2*c^10+35*b^4*c^9)*e^7+(1848*a^2*b*c^10" _
      "+(-759)*a*b^3*c^9+35*b^5*c^8)*e^6+(730*a^3*c^10" _
      "+(-2869)*a^2*b^2*c^9+2120*a*b^4*c^8" _
      "+(-767)*b^6*c^7)*e^5+((-763)*a^3*b*c^9+37*a^2*b^3*c^8" _
      "+(-3425)*a*b^5*c^7+2119*b^7*c^6)*e^4+(693*a^4*c^9" _
      "+435*a^3*b^2*c^8+(-27)*a^2*b^4*c^7+2878*a*b^6*c^6" _
      "+(-1711)*b^8*c^5)*e^3+((-1521)*a^4*b*c^8" _
      "+187*a^3*b^3*c^7+(-3949)*a^2*b^5*c^6+1834*a*b^7*c^5" _
      "+245*b^9*c^4)*e^2+(243*a^5*c^8+306*a^4*b^2*c^7" _
      "+443*a^3*b^4*c^6+1778*a^2*b^6*c^5+(-1060)*a*b^8*c^4" _
      "+(-56)*b^10*c^3)*e+((-243)*a^5*b*c^7" _
      "+(-108)*a^4*b^3*c^6+(-1146)*a^3*b^5*c^5" _
      "+678*a^2*b^7*c^4+(-30)*a*b^9*c^3+28*b^11*c^2))*r^4" _
      "+((31*a^3*c^10+209*a^2*b^2*c^9+(-100)*a*b^4*c^8" _
      "+(-5)*b^6*c^7)*e^8+((-613)*a^3*b*c^9+412*a^2*b^3*c^8" _
      "+(-128)*a*b^5*c^7+13*b^7*c^6)*e^7+((-828)*a^4*c^9" _
      "+183*a^3*b^2*c^8+(-1023)*a^2*b^4*c^7+658*a*b^6*c^6" _
      "+20*b^8*c^5)*e^6+(1215*a^4*b*c^8+(-1301)*a^3*b^3*c^7" _
      "+4085*a^2*b^5*c^6+(-2957)*a*b^7*c^5+584*b^9*c^4)*e^5" _
      "+((-522)*a^5*c^8+180*a^4*b^2*c^7+1481*a^3*b^4*c^6" _
      "+(-3307)*a^2*b^6*c^5+3599*a*b^8*c^4" _
      "+(-1433)*b^10*c^3)*e^4+(261*a^5*b*c^7" _
      "+(-657)*a^4*b^3*c^6+1293*a^3*b^5*c^5" _
      "+(-378)*a^2*b^7*c^4+(-1857)*a*b^9*c^3" _
      "+1156*b^11*c^2)*e^3+(9*a^5*b^2*c^6+1953*a^4*b^4*c^5" _
      "+(-1753)*a^3*b^6*c^4+2713*a^2*b^8*c^3" _
      "+(-1517)*a*b^10*c^2+14*b^12*c)*e^2" _
      "+((-180)*a^5*b^3*c^5+(-531)*a^4*b^5*c^4" _
      "+(-83)*a^3*b^7*c^3+(-775)*a^2*b^9*c^2+893*a*b^11*c" _
      "+(-141)*b^13)*e+(540*a^5*b^4*c^4+(-243)*a^4*b^6*c^3" _
      "+516*a^3*b^8*c^2+(-474)*a^2*b^10*c+73*a*b^12))*r^3" _
      "+(((-99)*a^4*b*c^8+7*a^3*b^3*c^7+(-91)*a^2*b^5*c^6" _
      "+88*a*b^7*c^5+(-10)*b^9*c^4)*e^8+(279*a^5*c^8" _
      "+(-81)*a^4*b^2*c^7+371*a^3*b^4*c^6" _
      "+(-235)*a^2*b^6*c^5+17*a*b^8*c^4+(-5)*b^10*c^3)*e^7" _
      "+(63*a^5*b*c^7+819*a^4*b^3*c^6+(-1713)*a^3*b^5*c^5" _
      "+1545*a^2*b^7*c^4+(-543)*a*b^9*c^3" _
      "+(-5)*b^11*c^2)*e^6+((-27)*a^5*b^2*c^6" _
      "+(-1854)*a^4*b^4*c^5+2705*a^3*b^6*c^4" _
      "+(-2738)*a^2*b^8*c^3+1228*a*b^10*c^2" _
      "+(-61)*b^12*c)*e^5+(54*a^6*b*c^6+387*a^5*b^3*c^5" _
      "+468*a^4*b^5*c^4+(-770)*a^3*b^7*c^3+458*a^2*b^9*c^2" _
      "+(-121)*a*b^11*c+(-18)*b^13)*e^4+(54*a^6*b^2*c^5" _
      "+(-1323)*a^5*b^4*c^4+630*a^4*b^6*c^3+12*a^3*b^8*c^2" _
      "+306*a^2*b^10*c+(-176)*a*b^12)*e^3+(54*a^6*b^3*c^4" _
      "+495*a^5*b^5*c^3+(-1188)*a^4*b^7*c^2+296*a^3*b^9*c" _
      "+178*a^2*b^11)*e^2+((-162)*a^6*b^4*c^3" _
      "+207*a^5*b^6*c^2+441*a^4*b^8*c+(-338)*a^3*b^10)*e" _
      "+((-243)*a^5*b^7*c+162*a^4*b^9))*r^2" _
      "+((18*a^5*b^2*c^6+63*a^4*b^4*c^5+(-142)*a^3*b^6*c^4" _
      "+178*a^2*b^8*c^3+(-107)*a*b^10*c^2+20*b^12*c)*e^8" _
      "+((-54)*a^6*b*c^6+(-207)*a^5*b^3*c^5+387*a^4*b^5*c^4" _
      "+(-470)*a^3*b^7*c^3+245*a^2*b^9*c^2+(-34)*a*b^11*c" _
      "+6*b^13)*e^7+((-54)*a^6*b^2*c^5+621*a^5*b^4*c^4" _
      "+(-819)*a^4*b^6*c^3+498*a^3*b^8*c^2" _
      "+(-138)*a^2*b^10*c+4*a*b^12)*e^6" _
      "+((-54)*a^6*b^3*c^4+(-531)*a^5*b^5*c^3" _
      "+1017*a^4*b^7*c^2+(-394)*a^3*b^9*c" _
      "+(-26)*a^2*b^11)*e^5+(270*a^6*b^4*c^3" _
      "+(-405)*a^5*b^6*c^2+(-108)*a^4*b^8*c" _
      "+172*a^3*b^10)*e^4+((-54)*a^6*b^5*c^2+468*a^5*b^7*c" _
      "+(-288)*a^4*b^9)*e^3+((-54)*a^6*b^6*c" _
      "+36*a^5*b^8)*e^2)*r+((36*a^5*b^5*c^3" _
      "+(-72)*a^4*b^7*c^2+44*a^3*b^9*c+(-8)*a^2*b^11)*e^8" _
      "+((-108)*a^6*b^4*c^3+198*a^5*b^6*c^2" _
      "+(-90)*a^4*b^8*c+4*a^3*b^10)*e^7+(54*a^6*b^5*c^2" _
      "+(-144)*a^5*b^7*c+72*a^4*b^9)*e^6+(54*a^6*b^6*c" _
      "+(-36)*a^5*b^8)*e^5))/(81*c^12*r^9+((-486)*a*b*c^10" _
      "+81*b^3*c^9)*r^8+(162*a^3*c^9+486*a^2*b^2*c^8" _
      "+486*a*b^4*c^7+(-324)*b^6*c^6)*r^7" _
      "+((-243)*a^4*b*c^7+(-162)*a^3*b^3*c^6" _
      "+(-972)*a^2*b^5*c^5+486*a*b^7*c^4+81*b^9*c^3)*r^6" _
      "+(486*a^4*b^4*c^4+(-162)*a^3*b^6*c^3" _
      "+486*a^2*b^8*c^2+(-486)*a*b^10*c+81*b^12)*r^5" _
      "+((-243)*a^4*b^7*c+162*a^3*b^9)*r^4)");

    rsimp1_gen_3(av : eI, bv : eI, cv : eI, rv : eI, pcu : SUP(eI),
                pd : eI, ps : eI) : Union(List(eI), "failed") ==
        -- print(message("rsimp1_gen_3")$OutputForm)$OutputForm
        el1 := [a = av, b = bv, c = cv, r = rv]$List(Equation(eI))
        -- print(message("el1 assigned")$OutputForm)$OutputForm
        pcue := map((c1 : eI) : eI +-> subst(c1, el1), pcu)
        -- print(message("after map")$OutputForm)$OutputForm
        -- print(pcue::OutputForm)
        fl := factorList(factor(pcue))$fRU
        -- print(fl::OutputForm)
        for fac in fl repeat
            fp := fac.factor
            if degree(fp) = 1 then
                -- print(message("found linear factor")$OutputForm)$OutputForm
                -- print(fp::OutputForm)$OutputForm
                ev := -coefficient(fp, 0)/leadingCoefficient(fp)
                el2 := cons('e::eI = ev, el1)
                dden := subst(denom(pd)::eI, el2)
                if dden = 0 then iterate
                dv := subst(numer(pd)::eI, el2)/dden
                el3 := cons('d::eI = dv, el2)
                sden := subst(denom(ps)::eI, el3)
                if sden = 0 then iterate
                sv := subst(numer(ps)::eI, el3)/sden
                return [sv, dv, ev, 1]
        "failed"

    rsimp1_gen_32(av : eI, bv : eI, cv : eI, rv : eI
             ) : Union(List(eI), "failed") ==
        -- check first for degenerate solution
        if not(cv = 0) then
            s := cv
            d := bv/(2::eI*s)
            if av = d*d*s then return [s, d, 1, 0]
        rsimp1_gen_3(av, bv, cv, rv, rp2u, rp2d, rp2s)

    rsimp_gen_3(av : eI, bv : eI, cv : eI, rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        bv = 0 and cv = 0 => [av, 1, 0, 0]
        k = 2 => rsimp1_gen_32(av, bv, cv, rv)
        k = 3 => rsimp1_gen_3(av, bv, cv, rv, rp3u, rp3d, rp3s)
        k = 4 =>
            res1 := rsimp1_gen_32(av, bv, cv, rv)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_32(r1l(2), r1l(3), r1l(4), rv)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [r1l(1)*r2l(1)^2, r2l(2), r2l(3), r2l(4)]
        k = 6 =>
            res1 := rsimp1_gen_32(av, bv, cv, rv)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_3(r1l(2), r1l(3), r1l(4), rv, rp3u, rp3d, rp3s)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [r1l(1)*r2l(1)^2, r2l(2), r2l(3), r2l(4)]
        k = 8 =>
            res1 := rsimp1_gen_32(av, bv, cv, rv)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_32(r1l(2), r1l(3), r1l(4), rv)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            res3 := rsimp1_gen_32(r2l(2), r2l(3), r2l(4), rv)
            res3 case "failed" => "failed"
            r3l := res3@List(eI)
            [r1l(1)*r2l(1)^2*r3l(1)^4, r3l(2), r3l(3), r3l(4)]
        k = 9 =>
            res1 := rsimp1_gen_3(av, bv, cv, rv, rp3u, rp3d, rp3s)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            s := r1l(1); av := r1l(2); bv := r1l(3); cv := r1l(4)
            res2 := rsimp1_gen_3(av, bv, cv, rv, rp3u, rp3d, rp3s)
            if res2 case "failed" then
                tmp := cv*rv
                s := s/rv; cv := bv; bv := av; av := tmp
                res2 := rsimp1_gen_3(av, bv, cv, rv, rp3u, rp3d, rp3s)
                if res2 case "failed" then
                    tmp := cv*rv
                    s := s/rv; cv := bv; bv := av; av := tmp
                    res2 := rsimp1_gen_3(av, bv, cv, rv, rp3u, rp3d, rp3s)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            [s*r2l(1)^3, r2l(2), r2l(3), r2l(4)]
        k = 12 =>
            res1 := rsimp1_gen_32(av, bv, cv, rv)
            res1 case "failed" => "failed"
            r1l := res1@List(eI)
            res2 := rsimp1_gen_32(r1l(2), r1l(3), r1l(4), rv)
            res2 case "failed" => "failed"
            r2l := res2@List(eI)
            res3 := rsimp1_gen_3(r2l(2), r2l(3), r2l(4), rv, rp3u, rp3d, rp3s)
            res3 case "failed" => "failed"
            r3l := res3@List(eI)
            [r1l(1)*r2l(1)^2*r3l(1)^4, r3l(2), r3l(3), r2l(4)]
        "failed"

    iE := IndexedExponents(K)
    sMp := SparseMultivariatePolynomial(Integer, K)
    pQf := PolynomialCategoryQuotientFunctions(iE, K, Integer, sMp, eI)
    uPe := SUP(eI)

    split_eval(la : List(eI), kf : eI, l : Integer, m : Integer
              ) : List(eI) ==
        r_vec := new(qcoerce(l), 0)$Vector(eI)
        for ll in 1..l repeat
            r_vec(ll) := first(la)
            la := rest(la)
        ki := 1; mm := l
        while mm < m repeat
            ki := ki*kf; mm := mm + l
            for ll in 1..l repeat
                r_vec(ll) := r_vec(ll) + first(la)*ki
                la := rest(la)
        entries(r_vec)

    -- give all coefficients (including zero coefficients)
    my_coeffs(p : uPe, k : Integer) : List(eI) ==
        res : List(eI) := []
        for i in k..0 by -1 repeat
            d := degree(p)
            if d < i then
                res := cons(0, res)
            else
                res := cons(leadingCoefficient(p), res)
                p := reductum(p)
        res

    rsimp_gen_4(cl : List(eI), rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        rr := sqrt(rv)
        krr := retract(rr)@K
        (a1, b1) := split_eval(cl, rr, 2, 4)
        res1 := rsimp_gen_2(a1, b1, rr, k)
        (res1 case "failed") => return "failed"
        r1l := res1@List(eI)
        s1 := r1l(1); c1 := r1l(2); d1 := r1l(3)
        su := univariate(s1, krr, minPoly(krr))$pQf
        a2 := coefficient(su, 0)
        b2 := coefficient(su, 1)
        res2 := rsimp_gen_2(a2, b2, rv, k)
        if res2 case "failed" and k rem 2 = 0 then
            kk := k quo 2
            for i in 1..kk repeat
                tmp := b2
                b2 := a2
                a2 := tmp*rv
            res2 := rsimp_gen_2(a2, b2, rv, k)
            res2 case "failed" => return "failed"
            tmp := d1
            d1 := c1/rr
            c1 := tmp
        res2 case "failed" => "failed"
        r2l := res2@List(eI)
        s2 := r2l(2) + r2l(3)*rr
        c1 := s2*c1
        d1 := s2*d1
        cu := univariate(c1, krr, minPoly(krr))$pQf
        du := univariate(d1, krr, minPoly(krr))$pQf
        [r2l(1), coefficient(cu, 0), coefficient(du, 0),
                 coefficient(cu, 1), coefficient(du, 1)]

    rsimp_gen_6(cl : List(eI), rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        rr := rv^(1/3)
        krr := retract(rr)@K
        (a1, b1) := split_eval(cl, rr, 2, 6)
        res1 := rsimp_gen_2(a1, b1, rr, k)
        (res1 case "failed") => return "failed"
        r1l := res1@List(eI)
        s1 := r1l(1); c1 := r1l(2); d1 := r1l(3)
        su := univariate(s1, krr, minPoly(krr))$pQf
        a2 := coefficient(su, 0)
        b2 := coefficient(su, 1)
        c2 := coefficient(su, 2)
        res2 := rsimp_gen_3(a2, b2, c2, rv, k)
        res2 case "failed" => "failed"
        r2l := res2@List(eI)
        s2 := r2l(2) + r2l(3)*rr + r2l(4)*rr^2
        c1 := s2*c1
        d1 := s2*d1
        cu := univariate(c1, krr, minPoly(krr))$pQf
        du := univariate(d1, krr, minPoly(krr))$pQf
        [r2l(1), coefficient(cu, 0), coefficient(du, 0),
                 coefficient(cu, 1), coefficient(du, 1),
             coefficient(cu, 2), coefficient(du, 2)]

    rsimp_gen_8(cl : List(eI), rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        rr := rv^(1/4)
        krr := retract(rr)@K
        (a1, b1) := split_eval(cl, rr, 2, 8)
        res1 := rsimp_gen_2(a1, b1, rr, k)
        (res1 case "failed") => return "failed"
        r1l := res1@List(eI)
        s1 := r1l(1); c1 := r1l(2); d1 := r1l(3)
        su := univariate(s1, krr, minPoly(krr))$pQf
        a2 := coefficient(su, 0) + coefficient(su, 2)*rr^2
        b2 := coefficient(su, 1) + coefficient(su, 3)*rr^2
        res2 := rsimp_gen_2(a2, b2, rr^2, k)
        if res2 case "failed" and k rem 2 = 0 then
            kk := k quo 2
            for i in 1..kk repeat
                tmp := b2
                b2 := a2
                a2 := tmp*rr^2
            res2 := rsimp_gen_2(a2, b2, rr^2, k)
            res2 case "failed" => return "failed"
            tmp := d1
            d1 := c1/rr
            c1 := tmp
        res2 case "failed" => "failed"
        r2l := res2@List(eI)
        s2 := r2l(1); c2 := r2l(2); d2 := r2l(3)
        su2 := univariate(s2, krr, minPoly(krr))$pQf
        a3 := coefficient(su2, 0)
        b3 := coefficient(su2, 2)
        res3 := rsimp_gen_2(a3, b3, rv, k)
        if res3 case "failed" and k rem 2 = 0 then
            kk := k quo 2
            for i in 1..kk repeat
                tmp := b3
                b3 := a3
                a3 := tmp*rv
            res3 := rsimp_gen_2(a3, b3, rv, k)
            res3 case "failed" => return "failed"
            tmp := d2
            d2 := c2/rr^2
            c2 := tmp
        res3 case "failed" => "failed"
        r3l := res3@List(eI)
        ss := r3l(2) + r3l(3)*rr^2
        ss := ss*(c2 + d2*rr)
        c1 := ss*c1
        d1 := ss*d1
        cu := univariate(c1, krr, minPoly(krr))$pQf
        du := univariate(d1, krr, minPoly(krr))$pQf
        [r3l(1), coefficient(cu, 0), coefficient(du, 0),
                 coefficient(cu, 1), coefficient(du, 1),
               coefficient(cu, 2), coefficient(du, 2),
                 coefficient(cu, 3), coefficient(du, 3)]

    rsimp_gen_9(cl : List(eI), rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        rr := rv^(1/3)
        krr := retract(rr)@K
        (a1, b1, c1) := split_eval(cl, rr, 3, 9)
        res1 := rsimp_gen_3(a1, b1, c1, rr, k)
        (res1 case "failed") => return "failed"
        r1l := res1@List(eI)
        s1 := r1l(1); d1 := r1l(2); e1 := r1l(3); f1 := r1l(4)
        su := univariate(s1, krr, minPoly(krr))$pQf
        a2 := coefficient(su, 0)
        b2 := coefficient(su, 1)
        c2 := coefficient(su, 2)
        res2 := rsimp_gen_3(a2, b2, c2, rv, k)
        if res2 case "failed" and k rem 3 = 0 then
            -- second try
            kk := k quo 3
            for i in 1..kk repeat
                tmp := c2
                c2 := b2
                b2 := a2
                a2 := tmp*rv
            res2 := rsimp_gen_3(a2, b2, c2, rv, k)
            tmp := d1
            d1 := e1
            e1 := f1
            f1 := tmp/rr
        if res2 case "failed" and k rem 3 = 0 then
            -- third try
            kk := k quo 3
            for i in 1..kk repeat
                tmp := c2
                c2 := b2
                b2 := a2
                a2 := tmp*rv
            res2 := rsimp_gen_3(a2, b2, c2, rv, k)
            res2 case "failed" => return "failed"
            tmp := d1
            d1 := e1
            e1 := f1
            f1 := tmp/rr
        res2 case "failed" => "failed"
        r2l := res2@List(eI)
        s2 := r2l(2) + r2l(3)*rr + r2l(4)*rr^2
        d1 := s2*d1
        e1 := s2*e1
        f1 := s2*f1
        du := univariate(d1, krr, minPoly(krr))$pQf
        eu := univariate(e1, krr, minPoly(krr))$pQf
        fu := univariate(f1, krr, minPoly(krr))$pQf
        [r2l(1), coefficient(du, 0), coefficient(eu, 0), coefficient(fu, 0),
                 coefficient(du, 1), coefficient(eu, 1), coefficient(fu, 1),
              coefficient(du, 2), coefficient(eu, 2), coefficient(fu, 2)]

    rsimp_gen_12(cl : List(eI), rv : eI, k : Integer
               ) : Union(List(eI), "failed") ==
        rr := rv^(1/6)
        krr := retract(rr)@K
        (a1, b1) := split_eval(cl, rr, 2, 12)
        res1 := rsimp_gen_2(a1, b1, rr, k)
        (res1 case "failed") => "failed"
        r1l := res1@List(eI)
        s1 := r1l(1); c1 := r1l(2); d1 := r1l(3)
        su := univariate(s1, krr, minPoly(krr))$pQf
        cl2 := my_coeffs(su, 5)
        (a2, b2) := split_eval(cl2, rr^2, 2, 6)
        res2 := rsimp_gen_2(a2, b2, rr^2, k)
        if res2 case "failed" and k rem 2 = 0 then
            kk := k quo 2
            for i in 1..kk repeat
                tmp := b2
                b2 := a2
                a2 := tmp*rr^2
            res2 := rsimp_gen_2(a2, b2, rr^2, k)
            res2 case "failed" => return "failed"
            tmp := d1
            d1 := c1/rr
            c1 := tmp
        res2 case "failed" => "failed"
        r2l := res2@List(eI)
        s2 := r2l(1); c2 := r2l(2); d2 := r2l(3)
        su2 := univariate(s2, krr, minPoly(krr))$pQf
        a3 := coefficient(su2, 0)
        b3 := coefficient(su2, 2)
        c3 := coefficient(su2, 4)
        res3 := rsimp_gen_3(a3, b3, c3, rv, k)
        res3 case "failed" => "failed"
        r3l := res3@List(eI)
        ss := r3l(2) + r3l(3)*rr^2 + r3l(4)*rr^4
        ss := ss*(c2 + d2*rr)
        cu := univariate(ss*c1, krr, minPoly(krr))$pQf
        du := univariate(ss*d1, krr, minPoly(krr))$pQf
        rl : List(eI) := []
        for ci in my_coeffs(cu, 5) for di in my_coeffs(du, 5) repeat
             rl := cons(ci, rl)
             rl := cons(di, rl)
        cons(r3l(1), reverse!(rl))

    -- Simple check for exact power
    rsimp1(av : eI, k : Integer) : Union(eI, "failed") ==
        pk := monomial(1, qcoerce(k)@NonNegativeInteger)$uPe - av::uPe
        fpk := factor(pk)
        for fac in factorList(fpk) repeat
            f1 := fac.factor
            if degree(f1) = 1 then
                return -coefficient(f1, 0)/leadingCoefficient(f1)
        "failed"

    my_root(s1 : eI, k : Integer, opr : BasicOperator) : eI ==
        n1 := numer(s1)::eI
        n1 = 1 => 1/kernel(opr, [1/s1, k::eI])
        d1 := denom(s1)::eI
        (nu1 := rsimp1(n1, k)) case eI =>
            nu1::eI/kernel(opr, [d1, k::eI])
        (du1 := rsimp1(d1, k)) case eI =>
            kernel(opr, [n1, k::eI])/du1::eI
        kernel(opr, [s1, k::eI])

    eval_rl(rl : List(eI), kf : eI, k : Integer) : eI ==
        res := first(rl)
        ki : eI := 1
        for i in 1..(k - 1) for ci in rest(rl) repeat
            ki := ki*kf
            res := ci*ki + res
        res

    rsimp2_gen(arg : eI, lk : List(K), k : Integer,
               opr : BasicOperator) : Union(eI, "failed") ==
        s1 := arg
        res : eI := 1
        for ker in lk repeat
            not(member?(ker, kernels(s1))) => iterate
            def_k := minPoly(ker)
            deg_k := degree(def_k)
            degree(reductum(def_k)) > 0 => return "failed"
            rv := -coefficient(def_k, 0)/leadingCoefficient(def_k)
            su := univariate(s1, ker, minPoly(ker))$pQf
            av := coefficient(su, 0)
            bv := coefficient(su, 1)
            deg_k = 2 =>
                res1 := rsimp_gen_2(av, bv, rv, k)
                (res1 case "failed") => return "failed"
                r1l := res1@List(eI)
                res := res*eval_rl(rest(r1l), ker::eI, 2)
                s1 := r1l(1)
            deg_k = 3 =>
                res1 := rsimp_gen_3(av, bv, coefficient(su, 2), rv, k)
                -- print(message("rsimp_gen_3 returned")$OutputForm)$OutputForm
                (res1 case "failed") => return "failed"
                r1l := res1@List(eI)
                res := res*eval_rl(rest(r1l), ker::eI, 3)
                s1 := r1l(1)
            if 12 < deg_k then return "failed"
            cl := my_coeffs(su, deg_k - 1)
            res1 :=
                deg_k = 4 => rsimp_gen_4(cl, rv, k)
                deg_k = 6 => rsimp_gen_6(cl, rv, k)
                deg_k = 8 => rsimp_gen_8(cl, rv, k)
                deg_k = 9 => rsimp_gen_9(cl, rv, k)
                deg_k = 12 => rsimp_gen_12(cl, rv, k)
                "failed"
            (res1 case "failed") => return "failed"
            r1l := res1@List(eI)
            res := res*eval_rl(rest(r1l), ker::eI, deg_k)
            s1 := r1l(1)
        su := rsimp1(s1, k)
        su case eI => res*su@eI
        res*my_root(s1, k, opr)

    rsimp(av : eI) : Union(eI, "failed") ==
        k0u := retractIfCan(av)@Union(K, "failed")
        k0u case "failed" => "failed"
        ker0 := k0u::K
        opr := operator(ker0)
        not(is?(opr, 'nthRoot)$BasicOperator) => "failed"
        args := argument(ker0)
        a1 := args(1)
        kke := args(2)
        k := retract(kke)@Integer
        res1 := rsimp1(a1, k)
        res1 case eI => res1
        lk := [ker for ker in kernels(a1) |
                 is?(operator(ker), 'nthRoot)$BasicOperator]
        rsimp2_gen(a1, lk, k, opr)

)boot $tryRecompileArguments := true
