Simplifying elliptic functions

Question

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].

Answer 1

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]