# Simplifying elliptic functions

I am working with (long) elliptic functions, which are rational functions in WeierstrassP and WeierstrassPPrime. As expressed in my previous question, Mathematica isn't aware of the fact that

WeierstrassPPrime[z, {g2, g3}]^2 -
(4 WeierstrassP[z, {g2, g3}]^3 - g2 WeierstrassP[z, {g2, g3}] - g3)


vanishes. I tried to get around this by setting wp = WeierstrassP[_, _] and wpp=WeierstrassPPrime[_, _] and then, denoting my elliptic function to be simplified by f, I did

((Collect[Numerator[#], wpp]/Collect[Denominator[#], wpp] &) @
Together[f /. {WeierstrassP[_, _] -> wp,
WeierstrassPPrime[_, _] -> wpp}]) /.
wpp^n_ -> wpp^Mod[n, 2] * (4 wp^3 - g2 wp - g3)^Quotient[n, 2]


and simplified the result. This appears to work, but when my elliptic functions get too long the calculation takes too much time (it never ended actually).

I also tried fiddling around with PolynomialMod and PolynomialRemainder without success.

Is there an efficient way to reduce any elliptic function $$f$$, using the identity $$\wp'^2=4 \wp^3-g_2 \wp-g_3,$$ into the form $$f=\frac{A_0(\wp)+A_1(\wp) \wp'}{B_0(\wp)+B_1(\wp) \wp'},$$ where $$A_0,A_1,B_0,B_1$$ are all polynomials?

Thank you!

EDIT:

Here's an example:

g2 = 1/12 (x[1]^4 + 6 x[1]^2 (x[2] - x[3])^2 +
4 x[1]^3 (x[2] + x[3]) + (x[2] + x[3])^4 +
4 x[1] (x[2]^3 - 3 x[2]^2 x[3] - 3 x[2] x[3]^2 + x[3]^3));
g3=1/216 (-x[1]^6 - 6 x[1]^5 (x[2] + x[3]) - (x[2] + x[3])^6 -
6 x[1] (x[2] + x[3])^3 (x[2]^2 - 4 x[2] x[3] + x[3]^2) -
3 x[1]^4 (5 x[2]^2 - 2 x[2] x[3] + 5 x[3]^2) -
4 x[1]^3 (5 x[2]^3 - 12 x[2]^2 x[3] - 12 x[2] x[3]^2 + 5 x[3]^3) -
3 x[1]^2 (5 x[2]^4 - 16 x[2]^3 x[3] + 30 x[2]^2 x[3]^2 -
16 x[2] x[3]^3 + 5 x[3]^4));
f=(1728 x[1]^3 x[2]^3 x[
3]^3)/(((x[1] + x[2] + x[3])^2 -
12 (-wp + x[1] x[2] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -
x[1] x[2] (-x[1] + x[2]))^2/(
4 (wp + x[1] x[2] - 1/12 (x[1] + x[2] + x[3])^2)^2))) ((x[1] +
x[2] + x[3])^2 -
12 (-wp + x[1] x[3] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -
x[1] (x[1] - x[3]) x[3])^2/(
4 (wp + x[1] x[3] - 1/12 (x[1] + x[2] + x[3])^2)^2))) ((x[1] +
x[2] + x[3])^2 -
12 (-wp + x[2] x[3] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -
x[2] x[3] (-x[2] + x[3]))^2/(
4 (wp + x[2] x[3] - 1/12 (x[1] + x[2] + x[3])^2)^2))));


Simplify[f] doesn't do much, but running

(Collect[Numerator[#], wpp]/Collect[Denominator[#], wpp] &)@
Together[f] /.
wpp^n_ -> (4 wp^3 - g2 wp - g3)^Quotient[n, 2]*wpp^Mod[n, 2] // Simplify


results in x[1]x[2]x[3].

• Can you show one example? Commented Oct 31, 2018 at 9:18
• @AlexTrounev done. Commented Oct 31, 2018 at 9:49
• I'm not very comfortable with the need to use Sqrt[] in Alex's answer. I think there ought to be a way to use GroebnerBasis[] or Eliminate[], but I was unable to get them to work. Commented Mar 8, 2019 at 12:49

Very simple solution

g2 =
1/12 (x[1]^4 + 6 x[1]^2 (x[2] - x[3])^2 +
4 x[1]^3 (x[2] + x[3]) + (x[2] + x[3])^4 +
4 x[1] (x[2]^3 - 3 x[2]^2 x[3] - 3 x[2] x[3]^2 + x[3]^3));
g3 = 1/216 (-x[1]^6 - 6 x[1]^5 (x[2] + x[3]) - (x[2] + x[3])^6 -
6 x[1] (x[2] + x[3])^3 (x[2]^2 - 4 x[2] x[3] + x[3]^2) -
3 x[1]^4 (5 x[2]^2 - 2 x[2] x[3] + 5 x[3]^2) -
4 x[1]^3 (5 x[2]^3 - 12 x[2]^2 x[3] - 12 x[2] x[3]^2 +
5 x[3]^3) -
3 x[1]^2 (5 x[2]^4 - 16 x[2]^3 x[3] + 30 x[2]^2 x[3]^2 -
16 x[2] x[3]^3 + 5 x[3]^4));
f = (1728 x[1]^3 x[2]^3 x[3]^3)/(((x[1] + x[2] + x[3])^2 -
12 (-wp + x[1] x[2] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -
x[1] x[2] (-x[1] + x[2]))^2/(4 (wp + x[1] x[2] -
1/12 (x[1] + x[2] + x[3])^2)^2))) ((x[1] + x[2] +
x[3])^2 -
12 (-wp + x[1] x[3] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -
x[1] (x[1] - x[3]) x[3])^2/(4 (wp + x[1] x[3] -
1/12 (x[1] + x[2] + x[3])^2)^2))) ((x[1] + x[2] +
x[3])^2 -
12 (-wp + x[2] x[3] -
1/12 (x[1] + x[2] + x[3])^2 + (wpp -

x[2] x[3] (-x[2] + x[3]))^2/(4 (wp + x[2] x[3] -
1/12 (x[1] + x[2] + x[3])^2)^2))));

wpp = Sqrt[4 wp^3 - g2 wp - g3];

f // FullSimplify

Out[5]= x[1] x[2] x[3]

• Hmmm... Let me test this on my longer expressions. Commented Oct 31, 2018 at 10:14