/* Tests of Jacobi elliptic functions and elliptic integrals */

kill(all);
done$

/* derivatives */
diff(jacobi_sn(u,m),u);
jacobi_cn(u,m)*jacobi_dn(u,m);

diff(jacobi_sn(u,m),m);
jacobi_cn(u,m)*jacobi_dn(u,m)*(u-elliptic_e(asin(jacobi_sn(u,m)),m)/(1-m))
  /(2*m)
 +jacobi_cn(u,m)^2*jacobi_sn(u,m)/(2*(1-m));

diff(jacobi_cn(u,m),u);
-jacobi_dn(u,m)*jacobi_sn(u,m);

diff(jacobi_cn(u,m),m);
-(jacobi_dn(u,m)*jacobi_sn(u,m)*(u-elliptic_e(asin(jacobi_sn(u,m)),m)/(1-m))/(2*m))
  -(jacobi_cn(u,m)*jacobi_sn(u,m)^2/(2*(1-m)));

diff(jacobi_dn(u,m),u);
-m*jacobi_cn(u,m)*jacobi_sn(u,m);

diff(jacobi_dn(u,m),m);
-(jacobi_cn(u,m)*jacobi_sn(u,m)*(u-elliptic_e(asin(jacobi_sn(u,m)),m)/(1-m))/2)
  -(jacobi_dn(u,m)*'jacobi_sn(u,m)^2/(2*(1-m)));

diff(inverse_jacobi_sn(u,m),u);
1/(sqrt(1-u^2)*sqrt(1-m*u^2));

diff(inverse_jacobi_sn(u,m),m);
((elliptic_e(asin(u),m)-(1-m)*elliptic_f(asin(u),m))/m-(u*sqrt(1-u^2)/sqrt(1-m*u^2)))/(1-m);

diff(inverse_jacobi_cn(u,m),u);
-(1/(sqrt(1-u^2)*sqrt(m*u^2-m+1)));

diff(inverse_jacobi_cn(u,m),m);
((elliptic_e(asin(sqrt(1-u^2)),m)-(1-m)*elliptic_f(asin(sqrt(1-u^2)),m))/m
   -(sqrt(1-u^2)*abs(u)/sqrt(1-m*(1-u^2))))/(1-m);

diff(inverse_jacobi_dn(u,m),u);
1/(sqrt(1-u^2)*sqrt(u^2+m-1));

diff(inverse_jacobi_dn(u,m),m);
((elliptic_e(asin(sqrt(1-u^2)/sqrt(m)),m)-(1-m)*elliptic_f(asin(sqrt(1-u^2)/sqrt(m)),m))/m
  -sqrt(1-(1-u^2)/m)*sqrt(1-u^2)/(sqrt(m)*abs(u)))/(1-m)
-(sqrt(1-u^2)/(2*m^(3/2)*sqrt(1-(1-u^2)/m)*abs(u)));

diff(elliptic_e(phi,m),phi);
sqrt(1-m*sin(phi)^2);

diff(elliptic_e(phi,m),m);
(elliptic_e(phi,m)-elliptic_f(phi,m))/(2*m);

diff(elliptic_f(phi,m),phi);
1/sqrt(1-m*sin(phi)^2);

diff(elliptic_f(phi,m),m);
((elliptic_e(phi,m)-(1-m)*elliptic_f(phi,m))/m
   -(cos(phi)*sin(phi)/sqrt(1-m*sin(phi)^2)))
 /(2*(1-m));

diff(elliptic_pi(n,phi,m),n);
((-(n*sqrt(1-m*sin(phi)^2)*sin(2*phi))/(2*(1-n*sin(phi)^2)))
 +((m-n)*elliptic_f(phi,m))/n+elliptic_e(phi,m)
 +((n^2-m)*elliptic_pi(n,phi,m))/n)
 /(2*(m-n)*(n-1));

diff(elliptic_pi(n,phi,m),phi);
1/(sqrt(1-m*sin(phi)^2)*(1-n*sin(phi)^2));

diff(elliptic_pi(n,phi,m),m);
((-(m*sin(2*phi))/(2*(m-1)*sqrt(1-m*sin(phi)^2)))
 +elliptic_e(phi,m)/(m-1)+elliptic_pi(n,phi,m))
 /(2*(n-m));

diff(elliptic_kc(m),m);
(elliptic_ec(m)-(1-m)*elliptic_kc(m))/(2*(1-m)*m);

diff(elliptic_ec(m),m);
(elliptic_ec(m)-elliptic_kc(m))/(2*m);

/* Integrals */

integrate(jacobi_sn(u,m),u); /* A&S 16.24.1 */
log(jacobi_dn(u,m)-sqrt(m)*jacobi_cn(u,m))/sqrt(m);

integrate(jacobi_cn(u,m),u); /* A&S 16.24.2 */
acos(jacobi_dn(u,m))/sqrt(m);

integrate(jacobi_dn(u,m),u); /* A&S 16.24.3 */
asin(jacobi_sn(u,m));

integrate(jacobi_cd(u,m),u); /* A&S 16.24.4 */
log(sqrt(m)*jacobi_sd(u,m)+jacobi_nd(u,m))/sqrt(m);

/* Use functions.wolfram.com 09.35.21.001.01, not A&S 16.24.5 */
integrate(jacobi_sd(u,m),u);
-(sqrt(1-m*jacobi_cd(u,m)^2)*jacobi_dn(u,m)*asin(sqrt(m)*jacobi_cd(u,m))
  /((1-m)*sqrt(m)));

/* Use functions.wolfram.com 09.32.21.0001.01, not A&S 16.24.6 */
integrate(jacobi_nd(u,m),u); 
sqrt(1-jacobi_cd(u,m)^2)*acos(jacobi_cd(u,m))/((1-m)*jacobi_sd(u,m));

integrate(jacobi_dc(u,m),u); /* A&S 16.24.7 */
log(jacobi_sc(u,m)+jacobi_nc(u,m));

integrate(jacobi_nc(u,m),u); /* A&S 16.24.8 */
log(sqrt(1-m)*jacobi_sc(u,m)+jacobi_dc(u,m))/sqrt(1-m);

integrate(jacobi_sc(u,m),u); /* A&S 16.24.9 */
log(sqrt(1-m)*jacobi_nc(u,m)+jacobi_dc(u,m))/sqrt(1-m);

integrate(jacobi_ns(u,m),u); /* A&S 16.24.10 */
log(jacobi_ds(u,m)-jacobi_cs(u,m));

/* Use functions.wolfram.com 09.30.21.0001.01, not A&S 16.24.11 */
integrate(jacobi_ds(u,m),u);
log((1-jacobi_cn(u,m))/jacobi_sn(u,m));

integrate(jacobi_cs(u,m),u); /* A&S 16.24.12 */
log(jacobi_ns(u,m)-jacobi_ds(u,m));

/* Check the integrals and derivatives by confirming

       f(x,m)-diff(integral(x,m),x),x) = constant

  Look at Taylor expansion about zero, rather than messing about with 
  elliptic function.  This was sufficient to find several errors  */
(te(f,n):=ratsimp(
           taylor(f(x,m)
           -diff(integrate(f(x,m),x),x),x,0,n)),
ti(f,n):=ratsimp(
           taylor(integrate(f(x,m),x),x,0,n)
            -integrate(taylor(f(x,m),x,0,n-1),x)),
td(f,n):=ratsimp(
           taylor(diff(f(x,m),x),x,0,n)
            -diff(taylor(f(x,m),x,0,n+1),x)),
/* Compare analytic and numerical integral */
ni(f,x1,x2,m):= block(
  [x,n,I,In,Ia,key:1,eps:1.0e-14],
  I:integrate(f(x,n),x),
  In:quad_qag(f(x,m),x,x1,x2,key),
  Ia:subst([x=float(x2),n=float(m)],I)-subst([x=float(x1),n=float(m)],I),
  if ( abs(Ia-In[1]) < eps ) then
    true
  else
    [Ia,In[1]]
),
done);
done;

te(jacobi_sn,4);
0;

te(jacobi_cn,4);
0;

te(jacobi_dn,4);
0;

te(jacobi_cd,4);
0;

assume(m>0,m<1); /* also ok for m<0 and m>0 */
[m > 0, m < 1];
te(jacobi_sd,4);
0;
forget(m>0,m<1);
[m > 0, m < 1];

te(jacobi_nd,4);
0;

te(jacobi_dc,4);
0;

te(jacobi_nc,4);
0;

te(jacobi_sc,4);
0;

/* jacobi_ns, jacobi_ds and jacobi_cs are singular at x=0 
   Compare numerical and analytic integrals for a single case.
*/

ni(jacobi_ns,1,2,1/2);
true;

ni(jacobi_ds,1,2,1/2);
true;

ni(jacobi_cs,1,2,1/2);
true;

kill(te,ti,td,ni);
done;

/* Slightly modified version of test_table taken from rtest_expintegral.mac */

(test_table(func,table,eps) :=
block([badpoints : [],
       abserr    : 0,
       maxerr    : -1],
  for entry in table do
    block([z : entry[1],
	   result, answer],
      z : expand(rectform(bfloat(entry[1]))),
      result : rectform(apply(func, z)),
      answer : expand(rectform(bfloat(entry[2]))),
      abserr : abs(result-answer),
      maxerr : max(maxerr,abserr),
      if abserr > eps then
	badpoints : cons ([z,result,answer,abserr],badpoints)
    ),
  if badpoints # [] then
    cons(maxerr,reverse(badpoints))
  else
    badpoints
),done);
done;

/* These test values come from http://getnet.net/~cherry/testrf.mac */

/*
 * rf(1,2,0) = (gamma(1/4)^2/4/sqrt(2*%pi)
 * rf(%i,-%i,0) = 1/2*integrate(1/sqrt(t^2+1)/sqrt(t),t,0,inf) = beta(1/4,1/4)/4;
 * rf(1/2,1,0) = 1/sqrt(1/2)*rf(1,2,0) (See https://dlmf.nist.gov/19.20.E1)
 */
(mrf:[[[1,2,0], gamma(1/4)^2/4/sqrt(2*%pi)],
     [[0.5,1,0], gamma(1/4)^2/(4*sqrt(%pi))]],
done);
done;

(mrf2:[[[%i,-%i,0], beta(1/4,1/4)/4],
     [[%i-1,%i,0],0.79612586584234b0-%i*(1.2138566698365b0)],
     [[%i,-%i,2],1.0441445654064b0],
     [[2,3,4],0.58408284167715b0],
     [[%i-1,%i,1-%i],0.93912050218619b0-%i*(0.53296252018635b0)]],
done);
done;

test_table('carlson_rf, mrf, 8.3267b-17);
[];

test_table('carlson_rf, mrf2, 1.2102b-8);
[];

/*
 * rc(0,1/4) = 1/2*integrate(1/sqrt(t)/(t+1/4), t, 0, inf)
 *           = %pi
 *
 * rc(9/4,2) = 1/2*integrate(1/sqrt(t+9/4)/(t+2), t, 0, inf)
 *           = log(2)
 * After doing a logcontract.
 *
 * rc(0,%i) = 1/2*integrate(1/sqrt(t)/(t+%i), t, 0, inf);
 *          = (1-%i)*%pi/2^(3/2)
 *
 * rc(2,1) = 1/2*integrate(1/sqrt(t+2)/(t+1), t, 0, inf)
 *         = (log(sqrt(2)+1)-log(sqrt(2)-1))/2
 *         = -log(sqrt(2)-1)
 *
 * After doing a logcontract, ratsimp/algebraic, and logcontract with
 *  logconcoeffp, and a sqrtdenest
 *
 * rc(0,1) = 1/2*integrate(1/sqrt(t)/(t+1), t, 0, inf)
 *         = %pi/2
 * rc(%i, %i+1) = 1/2*integrate(1/sqrt(t+%i)/(t+%i+1), t, 0, inf)
 *     = (%pi-2*atan((-1)^(1/4)))/2
 *     = %pi/4+%i/2*log(sqrt(2)-1)
 *
 * After applying rectform, ratsimp, logcontract, then another
 * logcontract with logconcoeffp set to featurep(m) or ratnump(m).
 *
 */
(mrc:[[[0b0,1/4],bfloat(%pi)],
      [[9/4,2b0],log(2b0)],
      [[0b0,%i],(1-%i)*%pi/2^(3/2)],
      [[-%i,%i],1.2260849569072b0-%i*(0.34471136988768b0)],
      [[1/4,-2],log(2b0)/3],
      [[%i,-1],0.77778596920447b0+%i*(0.19832484993429b0)],
      [[0,1/4],%pi],
      [[9/4,2],log(2)],
      [[2,1],-log(sqrt(2)-1)],
      [[-%i,%i],-log(sqrt(2)-1)/2+ %pi/4-%i*(log(sqrt(2)-1)/2+%pi/4)],
      [[1/4,-2],log(2)/3],
      [[%i,-1],sqrt(sqrt(2)/4-1/4)*atan(sqrt(sqrt(2)-1))-
               sqrt(sqrt(2)/16+1/16)*log(-sqrt(2*sqrt(2)+2)+sqrt(2)+1)+
               %i*(sqrt(sqrt(2)/4+1/4)*atan(sqrt(sqrt(2)-1))+sqrt(sqrt(2)/16-
               1/16)*log(-sqrt(2*sqrt(2)+2)+sqrt(2)+1))],
      [[0,1],%pi/2],
      [[%i,%i+1],%pi/4+%i*log(sqrt(2)-1)/2]],
done);
done;

test_table('carlson_rc, mrc, 2.5b-14);
[];

(mrj:[[[0,1,2,3],0.77688623778582b0],
      [[2,3,4,5],0.14297579667157b0],
      [[2,3,4,-1+%i],0.13613945827771b0-%i*(0.38207561624427b0)],
      [[-1+%i,-1-%i,1,2],0.9414835884122b0],
      [[-1+%i,-1-%i,1,-3+%i],-0.61127970812028b0-%i*(1.0684038390007b0)],
      [[-1+%i,-2-%i,-%i,-1+%i],1.8249027393704b0-%i*(1.2218475784827b0)],
      [[2,3,4,-0.5],0.24723819703052b0],
      [[2,3,4,-5],-0.12711230042964b0]],
done);
done;

(mrj2:[[[%i,-%i,0,2],1.6490011662711b0],
      [[%i,-%i,0,1-%i],1.8260115229009b0+%i*(1.2290661908643b0)]],
done);
done;

test_table('carlson_rj, mrj, 1b-13);
[];

test_table('carlson_rj, mrj2, 2.3452b-8);
[];

/*
 * rd(0,2,1) = (3*gamma(3/4)^2)/(sqrt(2)*sqrt(%pi))
*/
(mrd:[[[0,2,1],(3*gamma(3/4)^2)/(sqrt(2)*sqrt(%pi))],
      [[2,3,4],0.16510527294261b0],
      [[-2-%i,-%i,-1+%i],1.8249027393704b0-%i*(1.2218475784827b0)]],
done);
done;

(mrd2:[[[%i,-%i,2],0.6593385415422b0],
      [[0,%i,-%i],1.270819627191b0+%i*(2.7811120159521b0)],
      [[0,%i-1,%i],-1.8577235439239b0-%i*(0.96193450888839b0)]],
done);
done;

test_table('carlson_rd, mrd, 6e-14);
[];

test_table('carlson_rd, mrd2, 4.7818b-8);
[];

/* Some tests of the Jacobian elliptic functions.  
 * Just some tests at random points, to verify that we are accurate.
 * The reference values were obtained from Mathematica, but we could 
 * also just compute the values using a much larger fpprec.
 */

test_table('jacobi_sn,
           [[[1b0+%i*1b0, .7b0], 1.134045971912365274954b0 + 0.352252346922494477621b0*%i],
            [[1b0+%i*1b0, 2b0], 0.98613318109123804740b0 + 0.09521910819727230780b0*%i],
            [[1b0+%i*1b0, 2b0+3b0*%i], 0.94467077879445294981b0 - 0.19586410083100945528b0* %i],
            [[1.785063352082689082581887b0 *%i + 8.890858759528509578661528b-1,
              9.434463451695984398149033b-1 - 1.476052973708684178844821b-1 * %i],
             1.345233534539675700312281b0 - 7.599023926615176284214056b-2 * %i]],
           1b-15);
[];

test_table('jacobi_cn,
           [[[1b0+%i*1b0, .7b0], 0.571496591371764254029b0 - 0.698989917271916772991b0*%i ],
            [[1b0+%i*1b0, 2b0], 0.33759463268642431412b0 - 0.27814044708010806377b0*%i],
            [[1b0+%i*1b0, 2b0+3b0*%i], -0.52142079485827170824b0 - 0.35485177134179601850b0*%i],
            [[100b0, .7b0], 0.93004753815774770476196b0]], 
           6b-14);
[];

test_table('jacobi_dn,
           [[[1b0+%i*1b0, .7b0], 0.62297154372331777630564880787568b0 - 0.448863598031509643267241389621738b0 *%i ],
            [[1b0+%i*1b0, 2b0], 0.1913322443206041462495606602242b0 - 0.9815253294150083432282549919753b0 * %i],
            [[1b0+%i*1b0, 2b0+3b0*%i], 0.6147387452173944656984656771134b0 - 1.4819401302071697495918834416787b0 * %i],
            [[100b0, .7b0], 0.95157337933724324055428565654872978b0],
            [[1.785063352082689082581887b0 *%i + 8.890858759528509578661528b-1,
              9.434463451695984398149033b-1 - 1.476052973708684178844821b-1 * %i],
             -8.617730683333292717095686b-1 *%i - 2.663978258141280808361839b-1]], 
           2b-15);
[];

/* These routines for cn and dn work well for small (<= 1?) values of
 * u and m.  They have known issues for large real values of u.
 */
(ascending_transform(u,m) :=
  block([root_m : expand(rectform(sqrt(m))), mu, root_mu1, v],
    mu : expand(rectform(4*root_m/(1+root_m)^2)),
    root_mu1 : expand(rectform((1-root_m)/(1+root_m))),
    v : expand(rectform(u/(1+root_mu1))),
    [v, mu, root_mu1]),
 elliptic_dn_ascending(u,m) :=
  if is(abs(m-1) < 4*10^(-fpprec)) then sech(u)
  else
    block([v, mu, root_mu1, new],
      [v, mu, root_mu1] : ascending_transform(u,m),
      new : elliptic_dn_ascending(v, mu),
      expand(rectform((1-root_mu1)/mu*(new^2 + root_mu1)/new))),
 elliptic_cn_ascending(u,m) :=
  if is(abs(m-1) < 4*10^(-fpprec)) then sech(u)
  else
    block([v, mu, root_mu1, new],
      [v, mu, root_mu1] : ascending_transform(u,m),
      new : elliptic_dn_ascending(v, mu),
      expand(rectform((1+root_mu1)/mu*(new^2-root_mu1)/new))),
 done);
done;

/* Test with random values for the argument and parameter. */
(test_random(n, eps, testf, truef) :=
  block([badpoints : [], maxerr : -1],
    for k : 1 thru n do
      block([z : bfloat(1-2*random(1d0) + %i * (1-2*random(1d0))),
             m : bfloat(1-2*random(1d0) + %i * (1-2*random(1d0))),
             ans, expected, abserr],
        ans : testf(z, m),
        expected : truef(z, m),
        abserr : abs(ans-expected),
        maxerr : max(maxerr, abserr),
        if abserr > eps then
          badpoints : cons([[z,m], ans, expected, abserr], badpoints)),
    if badpoints # [] then
      cons(maxerr, badpoints)
    else
      badpoints),
 done);
done;

test_random(50, 2b-15, 'jacobi_dn, 'elliptic_dn_ascending);
[];

test_random(50, 2b-15, 'jacobi_cn, 'elliptic_cn_ascending);
[];

/* Test elliptic_f by using the fact that

inverse_jacobi_sn(x,m) = elliptic_f(asin(x), m)

*/
(test_ef(x,m) := jacobi_sn(elliptic_f(asin(x),m), m), id(x,m):=x, done);
done;

test_random(100, 6b-13, 'test_ef, 'id);
[];

/* Test elliptic_kc These values are from 
 *
 * http://functions.wolfram.com/EllipticIntegrals/EllipticK/03/01/
 */

block([oldfpprec : fpprec, fpprec:100],
  test_table('elliptic_kc,
	     [[[1/2], 8*%pi^(3/2)/gamma(-1/4)^2],
	      [[17-12*sqrt(2)], 2*(2+sqrt(2))*%pi^(3/2)/gamma(-1/4)^2],
	      [[-1], gamma(1/4)^2/4/sqrt(2*%pi)]],
	     2b-100));
[];

/* Some tests for specific values */
inverse_jacobi_sn(1,m);
elliptic_kc(m);

inverse_jacobi_sn(x,0);
asin(x);

inverse_jacobi_sn(x,1);
log(tan(asin(x)/2 + %pi/4));

inverse_jacobi_sd(1/sqrt(1-m),m);
elliptic_kc(m);

inverse_jacobi_ds(sqrt(1-m),m);
elliptic_kc(m);

/* elliptic_kc(1) is undefined */
errcatch(elliptic_kc(1));
[];
errcatch(elliptic_kc(1.0));
[];
errcatch(elliptic_kc(1.0b0));
[];

/* Test noun/verb results from elliptic functions */
diff(inverse_jacobi_sn(x,0),x);
1/sqrt(1-x^2);

diff(elliptic_pi(4/3,phi,0),phi);
sec(phi)^2/(1-tan(phi)^2/3);

diff(elliptic_pi(3/4,phi,0),phi);
sec(phi)^2/(1+tan(phi)^2/4);

diff(elliptic_pi(1,phi,0),phi);
sec(phi)^2;

/* signbfloat:false provokes "Is 0 positive, negative, or zero?" */
(signbfloat:false, 
 diff(elliptic_pi(1,phi,0),phi));
sec(phi)^2;

(reset (signbfloat), 0);
0;

/* Special values */
elliptic_ec(1);
1;

elliptic_ec(0);
%pi/2;

elliptic_ec(1/2);
gamma(3/4)^2/(2*sqrt(%pi))+%pi^(3/2)/(4*gamma(3/4)^2);

elliptic_ec(-1);
sqrt(2)*elliptic_ec(1/2);

/* Test periodicity of elliptic_e */
elliptic_e(x, 1);
2*round(x/%pi)+sin(x-%pi*round(x/%pi));

elliptic_e(3,1/3);
elliptic_e(3-%pi,1/3)+2*elliptic_ec(1/3);

/* Bug #2629: elliptic_kc(3.0) not accurate */
test_table('elliptic_kc, [[[3.0], elliptic_kc(3b0)]], 1b-15);
[];

/* Bug #2630: inverse_jacobi_cn(-2.0, 3.0) generates an error */
test_table('inverse_jacobi_cn, [[[-2.0, 3.0], 2.002154760912212-3.202503914656527*%i]],
  1b-15);
[];

/* Bug #2615: Numeric evaluation of inverse Jacobi elliptic functions is wrong for some inputs 
*/
is(abs(jacobi_dn(inverse_jacobi_dn(-2.0,3.0), 3.0) + 2) < 1d-14);
true;

/* elliptical functions handling of non-rectangular complex numbers
 * mailing list 2016-07-14 "Jacobi elliptic functions, maxima 5.38.1"
 * mailing list 2020-05-28 "Unexpected result from ev"
 */

/* list of functions here is everything that has a SIMP-[$%](ELLIPTIC|JACOBI)_FOO in sr/ellipt.lisp */
/*
elliptic_fcns :
  [ elliptic_e, elliptic_ec, elliptic_eu, elliptic_f, elliptic_kc, elliptic_pi,
    inverse_jacobi_cd, inverse_jacobi_cn, inverse_jacobi_cs, inverse_jacobi_dc,
    inverse_jacobi_dn, inverse_jacobi_ds, inverse_jacobi_nc, inverse_jacobi_nd,
    inverse_jacobi_ns, inverse_jacobi_sc, inverse_jacobi_sd, inverse_jacobi_sn,
    jacobi_am,
    jacobi_cd, jacobi_cn, jacobi_cs, jacobi_dc, jacobi_dn, jacobi_ds,
    jacobi_nc, jacobi_nd, jacobi_ns, jacobi_sc, jacobi_sd, jacobi_sn ];
 */

/* code to generate test cases below

elliptic_fcns_1 : sublist (elliptic_fcns, lambda ([f], errcatch(f('a)) # []));
elliptic_fcns_2 : sublist (elliptic_fcns, lambda ([f], errcatch(f('a, 'b)) # []));
elliptic_fcns_3 : sublist (elliptic_fcns, lambda ([f], errcatch(f('a, 'b, 'c)) # []));

kill (u1, k1, n1);

with_stdout ("/tmp/foo.mac",

  for f in elliptic_fcns_1
    do block ([a : f('rectform(u1))],
        print ('complex_floatp(a), ";"),
        print (true, ";"),
        print ("")),
  
  for f in elliptic_fcns_2
    do block ([a : f('rectform(u1), k1)],
        print ('complex_floatp(a), ";"),
        print (true, ";"),
        print ("")),
  
  for f in elliptic_fcns_3
    do block ([a : f(n1, 'rectform(u1), k1)],
        print ('complex_floatp(a), ";"),
        print (true, ";"),
        print ("")));
 */

(u1 : 0.5*(1.0 - 0.25*%i)^2,
 k1 : 0.775,
 n1 : -1.375,
 complex_floatp(e) := floatnump(realpart(e)) and floatnump(imagpart(e)),
 0);
0;

complex_floatp(elliptic_ec(rectform(u1))) ; 
true ; 
 
complex_floatp(elliptic_kc(rectform(u1))) ; 
true ; 
 
complex_floatp(elliptic_e(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(elliptic_eu(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(elliptic_f(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_cd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_cn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_cs(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_dc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_dn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_ds(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_nc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_nd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_ns(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_sc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_sd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(inverse_jacobi_sn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_am(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_cd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_cn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_cs(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_dc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_dn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_ds(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_nc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_nd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_ns(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_sc(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_sd(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(jacobi_sn(rectform(u1), k1)) ; 
true ; 
 
complex_floatp(elliptic_pi(n1, rectform(u1), k1)) ; 
true ; 
 
/*
with_stdout ("/tmp/bar.mac",

  for f in elliptic_fcns_1
    do block ([a : f('rectform(u1))],
        print ('complex_bfloatp(a), ";"),
        print (true, ";"),
        print ("")),

  for f in elliptic_fcns_2
    do block ([a : f('rectform(u1), k1)],
        print ('complex_bfloatp(a), ";"),
        print (true, ";"),
        print ("")),

  for f in elliptic_fcns_3
    do block ([a : f(n1, 'rectform(u1), k1)],
        print ('complex_bfloatp(a), ";"),
        print (true, ";"),
        print ("")));
 */

(u1 : 0.5b0*(1.0b0 - 0.25b0*%i)^2,
 k1 : 0.775b0,
 n1 : -1.375b0,
 complex_bfloatp(e) := bfloatp(realpart(e)) and bfloatp(imagpart(e)),
 0);
0;

complex_bfloatp(elliptic_ec(rectform(u1))) ; 
true ; 
 
complex_bfloatp(elliptic_kc(rectform(u1))) ; 
true ; 
 
complex_bfloatp(elliptic_e(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(elliptic_eu(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(elliptic_f(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_cd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_cn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_cs(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_dc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_dn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_ds(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_nc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_nd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_ns(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_sc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_sd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(inverse_jacobi_sn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_am(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_cd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_cn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_cs(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_dc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_dn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_ds(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_nc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_nd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_ns(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_sc(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_sd(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(jacobi_sn(rectform(u1), k1)) ; 
true ; 
 
complex_bfloatp(elliptic_pi(n1, rectform(u1), k1)) ; 
true ; 
 
/* Test derivatives at a few random points using numerical differentiation
   
   func  - a function
   df - deriviative of func wrt p-th argument
   p - derivative wrt p-th argument 
   vars - variables in expression deriv
   table - table of points to evaluate
   eps - report errors > eps
   delta - offset for numerical derivative
*/
(test_deriv(func,df,vars,p,table,eps,delta) :=
block([badpoints : [],
       abserr    : 0,
       maxerr    : -1],
  for %z in table do
    block([%z0, %z1, deriv, nderiv],
      %z1:makelist(if i=p then %z[i]+delta else %z[i],i,1,length(%z)),
      %z0:makelist(if i=p then %z[i]-delta else %z[i],i,1,length(%z)),
      nderiv: float((apply(func,%z1)-apply(func,%z0))/(2*delta)),
      deriv : float(subst(maplist("=",vars,%z),df)),
      abserr : abs(nderiv-deriv),
      maxerr : max(maxerr,abserr),
      if abserr > eps then
	badpoints : cons ([%z,deriv,nderiv,abserr],badpoints)
    ),
  if badpoints # [] then
    cons(maxerr,badpoints)
  else
    badpoints
    ),done);
done;

/* test points for two-arg functions */
(l2: [[0.2, 0.3], [0.2, 0.5], [1.5, 0.7], [0.5, 0.99], [1.5, 0.8],
    [1.57, 0.8], [1.5707, 0.8], [-1.0, 0.8], [2.0, 0.8]],done);
done;

/* test points for three-arg functions */
/* bug #3221 elliptic_pi() wrong for 2nd arg > float(%pi/2) */
(l3: [[0.1,0.2,0.3],[0.1,0.2,0.5],[0.2,1.5,0.7],[0.001,0.5,0.99],
    [0.2,1.5,0.8],[0.2,1.57,0.8],[0.2,1.5707,0.8]],done);
done;

test_deriv('elliptic_f,diff(elliptic_f(z,m),z),[z,m],1,l2,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_f,diff(elliptic_f(z,m),m),[z,m],2,l2,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_e,diff(elliptic_e(z,m),z),[z,m],1,l2,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_e,diff(elliptic_e(z,m),m),[z,m],2,l2,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_pi,diff(elliptic_pi(n,z,m),n),[n,z,m],1,l3,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_pi,diff(elliptic_pi(n,z,m),z),[n,z,m],2,l3,2.0e-7,1.0e-8);
[];

test_deriv('elliptic_pi,diff(elliptic_pi(n,z,m),m),[n,z,m],3,l3,2.0e-7,1.0e-8);
[];

closeto(e,tol):=block([numer:true,abse],abse:abs(e),if(abse<tol) then true else abse);
closeto(e,tol):=block([numer:true,abse],abse:abs(e),if(abse<tol) then true else abse);

/*
 * Some additional tests for complex values. Use the fact that
 * elliptic_pi(0, phi, m) = elliptic_f(phi,m);
 */
closeto(elliptic_pi(0, 0.5, 0.25)- elliptic_f(0.5, 0.25), 1e-15);
true;
closeto(elliptic_pi(0, 0.5*%i, 0.25)- elliptic_f(0.5*%i, 0.25), 1e-15);
true;

closeto(elliptic_pi(0, 0.5b0, 0.25b0)- elliptic_f(0.5b0, 0.25b0), 1e-15);
true;
closeto(elliptic_pi(0, 0.5b0*%i, 0.25b0)- elliptic_f(0.5b0*%i, 0.25b0), 1e-15);
true;

/* Test for Bug 3221 */

closeto(elliptic_pi(0.2,1.57,0.8) - 2.5770799919605668, 1e-14);
true;
closeto(elliptic_pi(0.2,1.58,0.8) - 2.60502920656026151, 1e-14);
true;
closeto(elliptic_pi(0.20,2.00,0.80) - 3.6543835090829025, 7.47e-11);
true;

(oldfpprec:fpprec,fpprec:32);
32;
closeto(elliptic_pi(0.2b0,1.57b0,0.8b0) - 2.5770799919605668058849721013196b0, 3.09b-32);
true;
closeto(elliptic_pi(0.2b0,1.58b0,0.8b0) - 2.6050292065602615145481924917132b0, 1.24b-32);
true;
closeto(elliptic_pi(0.2b0,2.0b0,0.8b0) - 3.6543835090082902501670624830938b0, 1b-32);
true;

/* Test for #3733 $gamma vs %gamma confusion */
elliptic_ec(1/2) - gamma(3/4)^2/(2*sqrt(%pi))- %pi^(3/2)/(4*gamma(3/4)^2);
0$

/* #3745 Quoting either elliptic_f [or elliptic_e] inhibits simplification */
'elliptic_f(5,0);
5$

'elliptic_e(5,0);
5$

/* #3967 elliptic_e(5*%pi/4,1) inconsistent with numerical evaluation */
elliptic_e(5*%pi/4, 1);
1/sqrt(2) + 2;

closeto(elliptic_e(5*%pi/4,1) - elliptic_e(float(5*%pi/4),1), 1e-16);
true;

/* #3746 derivative of inverse_jacobi_sn is noun/verb confused. 
   The same is true for inverse_jacobi_cn and inverse_jacobi_dn, but the 
   remaining nine inverse Jacobi functions ns, nc, nd, sc, cs, sd, ds, cd, 
   and dc don't have defined m derivatives.*/
subst(u=0, diff(inverse_jacobi_sn(u,m),m));
0$

subst(u=1, diff(inverse_jacobi_cn(u,m),m));
0$

subst(u=1, diff(inverse_jacobi_dn(u,m),m));
0$

/* Carlson's integrals */

(assume(xp > 0), done);
done$

carlson_rc(xp,xp);
1/sqrt(xp)$

carlson_rc(0,1);
%pi/2$

carlson_rc(0, 1/4);
%pi$

carlson_rc(2, 1);
log(sqrt(2)+1)$

carlson_rc(%i, %i+1);
%pi/4 + %i*log(sqrt(2)-1)/2$

carlson_rc(0, %i);
((1-%i)*%pi)/2^(3/2)$

carlson_rc(((1+xp)/2)^2, xp);
log(xp)/(xp-1)$

/* log(x) = (x-1)*carlson_rc(((1+x)/2)^2,x) */
closeto((2-1)*carlson_rc(((1+2)/2)^2,2.0) - log(2.0), 1e-16);
true$

/* asin(x) = x*carlson_rc(1-x^2,1) */
closeto(1/2*carlson_rc(1-1/4,1.0) - asin(0.5), 2.2205e-16);
true$

/* acos(x) = sqrt(1-x^2)*carlson_rc(x^2,1) */
closeto(sqrt(1.0-1/4)*carlson_rc(1/4,1.0) - acos(0.5), 2.2205e-16);
true$

/* atan(x) = x*carlson_rc(1,1+x^2) */
closeto(1*carlson_rc(1.0,1+1^2) - atan(1.0), 1.1103e-16);
true$

/* asinh(x) = x*carlson_rc(1+x^2,1) */
closeto(1*carlson_rc(1+1^2,1.0) - asinh(1.0), 2.2205e-16);
true$

/* acosh(x) = sqrt(x^2-1)*carlson_rc(x^2,1) */
closeto(sqrt(2^2-1.0)*carlson_rc(2^2,1.0) - acosh(2.0), 2.2205e-16);
true$

/* atanh(x) = x*carlson_rc(1,1-x^2) */
closeto(1/2*carlson_rc(1.0,1-(1/2)^2) - atanh(0.5), 1.1103e-16);
true$

carlson_rd(x, x, x);
1/x^(3/2)$

carlson_rd(0,2,1);
3*sqrt(%pi)*gamma(3/4)/gamma(1/4)$

carlson_rd(2,0,1);
3*sqrt(%pi)*gamma(3/4)/gamma(1/4)$

closeto(carlson_rd(0, 2, 1.0) - float(3*sqrt(%pi)*gamma(3/4)/gamma(1/4)), 6.66134e-16);
true$

carlson_rf(x,x,x);
1/sqrt(x)$

/*
 * Rf(1,2,0) has an analytic solution.  Check some of the permutations too.
 */
carlson_rf(1,2,0);
gamma(1/4)^2/(4*sqrt(2*%pi))$

carlson_rf(2,1,0);
gamma(1/4)^2/(4*sqrt(2*%pi))$

carlson_rf(0, 1,2);
gamma(1/4)^2/(4*sqrt(2*%pi))$

/* Check permutations of Rf(%i, -%i, 0) too */
carlson_rf(%i,-%i,0);
gamma(1/4)^2/(4*sqrt(%pi))$

carlson_rf(-%i,%i,0);
gamma(1/4)^2/(4*sqrt(%pi))$

carlson_rf(0, %i,-%i);
gamma(1/4)^2/(4*sqrt(%pi))$


carlson_rj(x,x,x,x);
1/x^(3/2)$

carlson_rj(x,y,z,z);
carlson_rd(x,y,z)$

(assume(pp>0,yp>0), done);
done$

carlson_rj(xp,xp,xp,pp);
3*(1/sqrt(xp)-carlson_rc(xp,pp))/(pp-xp)$

carlson_rj(0,yp,yp,pp);
3*%pi/(2*(yp*sqrt(pp)+pp*sqrt(yp)))$

carlson_rj(x,yp,yp,pp);
3/(pp-yp)*(carlson_rc(x,yp) - carlson_rc(x,pp))$

carlson_rj(x,yp,yp,yp);
(3*(carlson_rc(x,yp)-sqrt(x)/yp))/(2*(yp-x))$

(fpprec:oldfpprec,kill(l2,l3,test_deriv,oldfpprec),done);
done;
