tests/rtest_trig.mac

   1 (kill (all), 0);
   2 0;
   3
   4 (trig : [cos(x), sin(x), tan(x), csc(x), sec(x), cot(x)],0);
   5 0$
   6
   7 (htrig : [cosh(x), sinh(x), tanh(x), csch(x), sech(x), coth(x)],0);
   8 0$
   9
  10 (complexfloatp(x) := block([xr,xi],
  11   x : rectform(x),
  12   xr : realpart(x),
  13   xi : imagpart(x),
  14   (?floatp(xr) and (?floatp(xi) or integerp(xi))) or (?floatp(xi) and integerp(xr))), 0);
  15 0$
  16
  17 /*  Make sure that each trig function evaluates to a float for a float argument. */
  18
  19 (ok : true,0);
  20 0$
  21
  22 (for f in append(trig,htrig) do (
  23   ok : ok and complexfloatp(subst(x = 1.2 + %i,f)),
  24   ok : ok and complexfloatp(subst(x = 1 + %i/7.0,f)),
  25   ok : ok and complexfloatp(subst(x = -2.3 + %i/7.0,f)),
  26   ok : ok and complexfloatp(subst(x = -2.3 - %i,f))),0);
  27 0$
  28
  29 ok;
  30 true$
  31
  32 (complexbigfloatp(x) := block([xr,xi],
  33   x : rectform(x),
  34   xr : realpart(x),
  35   xi : imagpart(x),
  36   (bfloatp(xr) and (bfloatp(xi) or integerp(xi))) or (bfloatp(xi) and integerp(xr))), 0);
  37 0$
  38
  39 /*  Make sure that each trig function evaluates to a big float for a big float argument. */
  40
  41 (ok : true,0);
  42 0$
  43
  44 (for f in append(trig,htrig) do (
  45   ok : ok and complexbigfloatp(subst(x = 1.2b0,f))),0);
  46 0$
  47
  48 ok;
  49 true$
  50
  51 /*  Test %piargs  */
  52
  53 (maxerror : 0.0, %piargs : true, save_flags_names : '[%piargs, %iargs, trigsign, listarith, exponentialize, halfangles, trigexpand, trigexpandplus, trigexpandtimes, triginverses], save_flags_values : ev (save_flags_names), 0);
  54 0;
  55
  56 (for f in trig do (
  57    for i : -24 thru 24 do (
  58       z : errcatch(subst(x = %pi * i / 24, f)),
  59       if z # [ ] then maxerror : max(maxerror, abs(float(first(z) - subst(x = %pi * i / 24.0, f)))))),
  60  if is(maxerror < 1.0e-13) then true else maxerror);
  61 true$
  62
  63 /* Test %iargs   */
  64
  65 (%iargs : true, trigsign : true, 0);
  66 0$
  67
  68 subst(-%i*x,x, subst(%i*x,x,append(trig,htrig))) - append(trig,htrig);
  69 ''(makelist(0,i,1,length(append(trig,htrig))));
  70
  71 (itrig : subst(%i*x,x,append(trig,htrig)),0);
  72 0$
  73
  74 (%iargs : false, listarith : true,0);
  75 0$
  76
  77 (itrig : itrig - subst(%i*x,x,append(trig,htrig)),0);
  78 0$
  79
  80 ratsimp(taylor(itrig,x,0,5));
  81 ''(makelist(0,i,1,length(append(trig,htrig))))$
  82
  83 (exponentialize : false,0);
  84 0$
  85
  86 taylor(exponentialize(append(trig,htrig)) - append(trig,htrig),x,0,5);
  87 ''(makelist(taylor(0,x,0,5), i,1,length(append(trig,htrig))))$
  88
  89
  90 /*  Test reflection rules  */
  91
  92 (trigsign : true,0);
  93 0$
  94
  95 subst(-x,x, subst(-x,x, append(trig,htrig)));
  96 ''(append(trig,htrig))$
  97
  98 (mtrig : subst(x=5.6, subst(-x,x,append(trig,htrig))),0);
  99 0$
 100
 101 (trigsign : false,0);
 102 0$
 103
 104 mtrig - subst(x=-5.6, append(trig,htrig));
 105 ''(makelist(0.0,i,1,length(append(trig,htrig))))$
 106
 107 /* Test half angles */
 108
 109 /* Because we have generalized the half-angle-transformation, we have to
 110    restrict the arguments to a positive interval (0,%pi). We take not %pi
 111    but the number 3 as upper limit, because of problems with assume. */
 112
 113 (assume(x>0,x<3),halfangles : true, 0);
 114 0$
 115
 116 (xtrig : subst(x/2,x, append(trig,htrig)),0);
 117 0$
 118
 119 (halfangles : false, 0);
 120 0$
 121
 122 xtrig : taylor(xtrig - subst(x/2,x, append(trig, htrig)),x,0,5);
 123 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 124
 125 (forget(x>0,x<3),0);
 126 0;
 127
 128 /* Test trig expand */
 129
 130 (trigexpand : true, trigexpandplus : true, trigexpandtimes : true, 0);
 131 0$
 132
 133 (xtrig : subst(x=x+y, append(trig,htrig)),0);
 134 0$
 135
 136 (trigexpand : false,0);
 137 0$
 138
 139 xtrig : taylor(xtrig - subst(x=x+y, append(trig, htrig)),[x,y],0,5);
 140 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 141
 142 (trigexpand : true, trigexpandplus : true, trigexpandtimes : true, 0);
 143 0$
 144
 145 (xtrig : subst(x=x-y, append(trig,htrig)),0);
 146 0$
 147
 148 (trigexpand : false,0);
 149 0$
 150
 151 xtrig : taylor(xtrig - subst(x=x-y, append(trig, htrig)),[x,y],0,5);
 152 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 153
 154 (trigexpand : true, trigexpandplus : true, trigexpandtimes : true, 0);
 155 0$
 156
 157 (xtrig : subst(x = 2*x, append(trig,htrig)),0);
 158 0$
 159
 160 (trigexpand : false,0);
 161 0$
 162
 163 xtrig : taylor(xtrig - subst(x=2*x, append(trig, htrig)),[x,y],0,5);
 164 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 165
 166 (trigexpand : true, trigexpandplus : true, trigexpandtimes : true, 0);
 167 0$
 168
 169 (xtrig : subst(x = 3*x, append(trig,htrig)),0);
 170 0$
 171
 172 (trigexpand : false,0);
 173 0$
 174
 175 xtrig : taylor(xtrig - subst(x=3*x, append(trig, htrig)),[x,y],0,5);
 176 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 177
 178 (trigexpand : true, trigexpandplus : true, trigexpandtimes : true, 0);
 179 0$
 180
 181 (xtrig : subst(x = 7*x, append(trig,htrig)),0);
 182 0$
 183
 184 (trigexpand : false,0);
 185 0$
 186
 187 xtrig : taylor(xtrig - subst(x=7*x, append(trig, htrig)),[x,y],0,5);
 188 ''(makelist(taylor(0,x,0,5),i,1,length(append(trig,htrig))))$
 189
 190 /* Test triginverses  */
 191
 192 (invtrig : [acos(x), asin(x), atan(x), acsc(x), asec(x), acot(x)],0);
 193 0$
 194
 195 block ([buggy : []],
 196   for f in invtrig do (
 197     triginverses : true,
 198     xtrig : subst(f,x,trig),
 199     triginverses : false,
 200     xtrig : xtrig - subst(f,x,trig),
 201
 202     /* Paste expressions into a lambda to protect them from simplification and evaluation.
 203      * Evaluate the lambda (no arguments) to get the test result.
 204      */
 205     xtrig : buildq ([L : map (nounify (cabs), xtrig)], lambda ([], L)),
 206     for i : 1 thru 9 do block ([xi : i/10.0, xtrigi],
 207       xtrigi : apply (buildq, [[funmake (":", ['x, xi])], xtrig]),
 208       if apply ('max, ev (xtrigi(), nouns)) >= 1.0e-12
 209         then buggy : cons (xtrigi, buggy))),
 210
 211   buggy);
 212 []$
 213
 214 (invhtrig : [acosh(x), asinh(x), atanh(x), acsch(x), asech(x), acoth(x)],0);
 215 0$
 216
 217 block ([buggy : []],
 218   for f in invhtrig do (
 219     triginverses : true,
 220     xtrig : subst(f,x,htrig),
 221     triginverses : false,
 222     xtrig : xtrig - subst(f,x,htrig),
 223
 224     /* Paste expressions into a lambda to protect them from simplification and evaluation.
 225      * Evaluate the lambda (no arguments) to get the test result.
 226      */
 227     xtrig : buildq ([L : map (nounify (cabs), xtrig)], lambda ([], L)),
 228     for i : 1 thru 9 do block ([xi : i/10.0, xtrigi],
 229       xtrigi : apply (buildq, [[funmake (":", ['x, xi])], xtrig]),
 230       if apply ('max, ev (xtrigi(), nouns)) >= 1.0e-12
 231         then buggy : cons (xtrigi, buggy))),
 232
 233   buggy);
 234 []$
 235
 236 (alltrig : append(trig, htrig, invtrig, invhtrig),0);
 237 0$
 238
 239 (pts : [2,2+%i, 2-%i,-2,-2+%i,-2-%i,1/2,1/2 +%i/2,1/2-%i/2,-1/2,-1/2+%i/2,-1/2-%i/2],0);
 240 0$
 241
 242 block ([buggy : []],
 243   for f in alltrig do
 244     for p in pts do block ([e, fop : op(f)],
 245       e : buildq ([p, fop], lambda ([], cabs (float (rectform (fop (p))) - fop (float (p))))),
 246       if e() > 1.0e-13
 247         then buggy : cons (e, buggy)), buggy);
 248 []$
 249
 250 /* Like above, but for big floats.  We expect to be within 3 digits of the answer.
 251
 252    Note that we might fail because the rectform and the function might
 253    produce answers because of the branch cut!
 254  */
 255 block ([buggy : []],
 256   for f in alltrig do
 257     for p in pts do block ([e, fop : op(f)],
 258       e : buildq ([p, fop], lambda ([], cabs (bfloat (rectform (fop (p))) - fop (bfloat (p))))),
 259       if e() > 10b0^(3-fpprec)
 260         then buggy : cons (e, buggy)), buggy);
 261 []$
 262
 263
 264 /*  Numerically check some identities  */
 265
 266 (float_trig_test(id, threshold) :=
 267   block([maxerror : 0],
 268     for p in pts do block([numer : true],
 269       maxerror : max(maxerror, cabs(expand(rectform(subst(x = p, id)))))),
 270     if is(maxerror < threshold) then true else maxerror),
 271  bfloat_trig_test(id, threshold) :=
 272   block([maxerror : 0],
 273     for p in pts do block([numer : true],
 274       maxerror : max(maxerror, cabs(expand(subst(x = bfloat(p), id))))),
 275     if is(maxerror < threshold) then true else maxerror),
 276  0);
 277 0;
 278
 279 float_trig_test(cos(x)^2 + sin(x)^2 - 1, 1.0e-15);
 280 true$
 281
 282 float_trig_test(cot(2*x) - (cot(x)^2-1)/(2*cot(x)), 1.0e-15);
 283 true$
 284
 285 bfloat_trig_test(asin(x) + acos(x) - %pi/2, 1.0e-15);
 286 true$
 287
 288 (declare(n,integer),0);
 289 0$
 290
 291 /* see SF bug 1754072 */
 292
 293 subst(n = 1, cos(%pi * n * 31 / 37));
 294 cos(%pi * 31 / 37);
 295
 296 subst(n = 1, sin(%pi * n * 31 / 37));
 297 sin(%pi * 31 / 37);
 298
 299 subst(n = 1, tan(%pi * n * 31 / 37));
 300 tan(%pi * 31 / 37);
 301
 302 /* [ 580721 ] trigexpand bug */
 303 tan(%pi*x+%pi/2),trigexpand;
 304 -cot(%pi*x);
 305
 306 tan(n*2*%pi);
 307 0;
 308
 309 /* tan(%pi*integer) simplification - ID: 3058290 */
 310 tan(n*%pi);
 311 0;
 312
 313 (kill(n,declare),0);
 314 0$
 315
 316 /* [ 1553866 ] %piargs inconsistent behavior */
 317 cos(%pi*x + %pi);
 318 -cos(%pi*x);
 319
 320 (remfunction(complexfloatp, complexbigfloatp),0);
 321 0$
 322
 323 /* Probably we should beef up reset slightly to handle this, but for now this is OK. */
 324 (map (lambda ([a, b], a :: b), save_flags_names, save_flags_values), 0);
 325 0;
 326
 327 /* [ 1644575 ] acot(0.0) vs acot(0) */
 328 acot(0.0);
 329 1.570796326794897;
 330
 331 /* [ 620246 ] carg(complex) */
 332 (declare(u, complex),0);
 333 0;
 334
 335 rectform(log(u));
 336 log(abs(u)) + %i*carg(u);
 337
 338 cabs(u);
 339 abs(u); /* for a symbol we get a noun form with abs */
 340 /*sqrt(?%realpart(u)^2+?%imagpart(u)^2);*/
 341
 342 /* [ 617699 ] carg([1]) is bogus */
 343 carg([1]);
 344 [0];
 345
 346 /* Tests for half-angles simplification */
 347
 348 kill(all);
 349 done;
 350
 351 (old_halfangles:halfangles,halfangles:true,old_%iargs:%iargs,%iargs:false,done);
 352 done;
 353
 354 /* Sin function: The general result for real argument */
 355
 356 sin(x/2);
 357 (-1)^floor(x/(2*%pi))*sqrt(1-cos(x))/sqrt(2);
 358
 359 /* The square simplifies correctly */
 360
 361 sin(x/2)^2;
 362 (1-cos(x))/2;
 363
 364 /* Correct sign for negative and positive real argument */
 365
 366 (assume(x1>0,x1<2*%pi),done);
 367 done;
 368
 369 sin(x1/2);
 370 sqrt(1-cos(x1))/sqrt(2);
 371
 372 (assume(x2>-2*%pi,x2<0),done);
 373 done;
 374
 375 sin(x2/2);
 376 -sqrt(1-cos(x2))/sqrt(2);
 377
 378 /* Correct sign for pure imaginary argument
 379    and complex argument with realpart a multiple of 2*%pi */
 380
 381 (assume(y1>0,y2<0),done);
 382 done;
 383
 384 sin(%i*y1/2);
 385 sqrt(1-cos(%i*y1))/sqrt(2);
 386
 387 sin(%i*y2/2);
 388 -sqrt(1-cos(%i*y2))/sqrt(2);
 389
 390 sin((2*%pi+%i*y2)/2);
 391 sqrt(1-cos(2*%pi+%i*y2))/sqrt(2);
 392
 393 sin((2*%pi+%i*y1)/2);
 394 -sqrt(1-cos(2*%pi+%i*y1))/sqrt(2);
 395
 396 /* Simplification for negative or positive imaginary part */
 397 (assume(yneg<0,ypos>0),done);
 398 done;
 399
 400 sin((x1+%i*yneg)/2);
 401 sqrt(1-cos(x1+%i*yneg))/sqrt(2);
 402
 403 sin((2*%pi+%i*yneg)/2);
 404 sqrt(1-cos(2*%pi+%i*yneg))/sqrt(2);
 405
 406 sin((x1+%i*ypos)/2);
 407 sqrt(1-cos(x1+%i*ypos))/sqrt(2);
 408
 409 sin((2*%pi+%i*ypos)/2);
 410 -sqrt(1-cos(2*%pi+%i*ypos))/sqrt(2); /* for this case an -1 */
 411
 412 /* Cos function: The general result for real argument */
 413
 414 cos(x/2);
 415 (-1)^floor((x+%pi)/(2*%pi))*sqrt(1+cos(x))/sqrt(2);
 416
 417 /* The square simplifies correctly */
 418
 419 cos(x/2)^2;
 420 (1+cos(x))/2;
 421
 422 /* Correct sign for real argument in (-%pi,%pi) */
 423
 424 (forget(x1<2*%pi,x1>0),assume(x1>-%pi,x1<%pi),done);
 425 done;
 426
 427 cos(x1/2);
 428 sqrt(1+cos(x1))/sqrt(2);
 429
 430 /* Correct sign for pure imaginary argument
 431    and complex argument with realpart a multiple of %pi */
 432
 433 cos(%i*y1/2);
 434 sqrt(1+cos(%i*y1))/sqrt(2);
 435
 436 cos(%i*y2/2);
 437 sqrt(1+cos(%i*y2))/sqrt(2);
 438
 439 cos((%pi+%i*y2)/2);
 440 sqrt(1+cos(%pi+%i*y2))/sqrt(2);
 441
 442 cos((%pi+%i*y1)/2);
 443 -sqrt(1+cos(%pi+%i*y1))/sqrt(2);
 444
 445 /* Simplification for negative or positive imaginary part */
 446 (assume(yneg<0,ypos>0),done);
 447 done;
 448
 449 cos((x1+%i*yneg)/2);
 450 sqrt(1+cos(x1+%i*yneg))/sqrt(2);
 451
 452 cos((%pi+%i*yneg)/2);
 453 sqrt(1+cos(%pi+%i*yneg))/sqrt(2);
 454
 455 cos((x1+%i*ypos)/2);
 456 sqrt(1+cos(x1+%i*ypos))/sqrt(2);
 457
 458 cos((%pi+%i*ypos)/2);
 459 -sqrt(1+cos(%pi+%i*ypos))/sqrt(2); /* for this case an -1 */
 460
 461 /* Sinh function with Real arguments */
 462
 463 (assume(xpos>0,xneg<0),done);
 464 done;
 465
 466 sinh(x/2);
 467 abs(x)/x*sqrt((cosh(x)-1)/2);
 468
 469 sinh(x/2)^2;
 470 (cosh(x)-1)/2;
 471
 472 sinh(xpos/2);
 473 sqrt((cosh(xpos)-1)/2);
 474
 475 sinh(xneg/2);
 476 -sqrt((cosh(xneg)-1)/2);
 477
 478 /* Sinh function with Complex arguments */
 479
 480 /* x1 is in (-%pi,%pi) */
 481 sinh(%i*x1/2);
 482 abs(x1)/x1*sqrt((cosh(%i*x1)-1)/2);
 483
 484 sinh((xpos+%i*x1)/2);
 485 sqrt((xpos+%i*x1)^2)/(xpos+%i*x1)*sqrt((cosh(xpos+%i*x1)-1)/2);
 486
 487 sinh((xneg+%i*x1)/2);
 488 sqrt((xneg+%i*x1)^2)/(xneg+%i*x1)*sqrt((cosh(xneg+%i*x1)-1)/2);
 489
 490 /* Cosh function with Real arguments */
 491
 492 cosh(x/2);
 493 sqrt((cosh(x)+1)/2);
 494
 495 cosh(x/2)^2;
 496 (cosh(x)+1)/2;
 497
 498 cosh(xpos/2);
 499 sqrt((cosh(xpos)+1)/2);
 500
 501 cosh(xneg/2);
 502 sqrt((cosh(xneg)+1)/2);
 503
 504 /* Cosh function with Complex arguments */
 505
 506 /* x1 is in (-%pi,%pi) */
 507 cosh(%i*x1/2);
 508 sqrt((cosh(%i*x1)+1)/2);
 509
 510 cosh((xpos+%i*x1)/2);
 511 sqrt((cosh(xpos+%i*x1)+1)/2);
 512
 513 cosh((xneg+%i*x1)/2);
 514 sqrt((cosh(xneg+%i*x1)+1)/2);
 515
 516 /* two tests for atan2(sqrt(1-u)*(u-1),1) - ID: 3521596 */
 517 atan2(sqrt(1-u)*(u-1),1);
 518 atan2(sqrt(1-u)*(u-1),1)$
 519
 520 atan2((1-u)^(1/2^10)*(u-1),1);
 521 atan2((1-u)^(1/2^10)*(u-1),1)$
 522
 523 /* adding tests for some previously uncovered code in trigi.lisp and trigo.lisp */
 524
 525 block([triginverses : true], [sin(atan2(y,x)), cos(atan2(y,x)),tan(atan2(y,x)), cot(atan2(y,x)), csc(atan2(y,x)), sec(atan2(y,x))]);
 526 [y/sqrt(y^2+x^2), x/sqrt(y^2+x^2),  y/x, x/y, sqrt(y^2+x^2)/y, sqrt(y^2+x^2)/x]$
 527
 528 block([exponentialize : true], [sec(x),csch(x), sech(x)]);
 529 [2/(%e^(%i*x)+%e^-(%i*x)), 2/(%e^x-%e^-x), 2/(%e^x+%e^-x)]$
 530
 531 [atan(inf), atan(-minf), atan(minf), atan(-inf)];
 532 [%pi/2, %pi/2, -%pi/2, -%pi/2]$
 533
 534 block([%piargs : true], [atan(-1 + sqrt(2)), atan(1+sqrt(2))]);
 535 [%pi/8, 3*%pi/8]$
 536
 537 block([%iargs : true], atan(%i*x));
 538 %i*atanh(x)$
 539
 540 [atan(tan(2015)), atan(tan(-2014)),  atan(cot(-2014)), atan(cot(2015))];
 541 [2015-641*%pi,641*%pi-2014,2014-1283*%pi/2,1283*%pi/2-2015]$
 542
 543 asin(sqrt(3)/2);
 544 %pi/3$
 545
 546 asin(-sqrt(3)/2);
 547 -%pi/3$
 548
 549 map(lambda([x], asin(sin(x)) - (-min(2*%pi*floor(x/(2*%pi))-x+%pi,-2*%pi*floor(x/(2*%pi))+x-2*%pi)-max(x-2*%pi*floor(x/(2*%pi)),2*%pi*floor(x/(2*%pi))-x+%pi)-2*%pi*floor(x/(2*%pi))+x-%pi)), makelist(i/3,i,0,43));
 550 ''(makelist(0,i,0,43))$
 551
 552 map(lambda([x], asec(sec(x)) - (%pi-abs(2*%pi*floor(x/(2*%pi))-x+%pi))), makelist(i/19,i,0,25));
 553 ''(makelist(0,i,0,25))$
 554
 555 sin(641*%pi-2015);
 556 sin(2015)$
 557
 558 asin(cos(2015));
 559 2015-1283*%pi/2$
 560
 561 block([triginverses : true], asin(sin(1/5)));
 562 1/5$
 563
 564 acos(sin(1066));
 565 1066-677*%pi/2$
 566
 567 acot(cot(42));
 568 42-13*%pi$
 569
 570 acsc(csc(191/8));
 571 191/8-8*%pi$
 572
 573 block([triginverses : all],
 574    [acsc(csc(x)), acot(cot(x)), acos(cos(x)), asinh(sinh(x)), acosh(cosh(x)), atanh(tanh(x)),acoth(coth(x)), acsch(csch(x)), asech(sech(x))]);
 575 [x,x, x, x, x, x, x, x, x]$
 576
 577 [acot(0), acot(1),acot(-1),acot(1/sqrt(3)), acot(sqrt(3))];
 578 [%pi/2,%pi/4,-%pi/4,%pi/3,%pi/6]$
 579
 580 [atan(inf), atan(1),atan(-1),atan(sqrt(3)), atan(1/sqrt(3))];
 581 [%pi/2,%pi/4,-%pi/4,%pi/3,%pi/6]$
 582
 583 [acos(sqrt(3)/2), acos(-sqrt(3)/2)];
 584 [%pi/6,5*%pi/6]$
 585
 586 [acsc(1), acsc(-1), acsc(sqrt(2)), acsc(2/sqrt(3))];
 587  [%pi/2,-%pi/2,%pi/4,%pi/3]$
 588
 589 [asec(-1),asec(sqrt(2)), 2/sqrt(3)];
 590 [%pi,%pi/4,2/sqrt(3)]$
 591
 592 /* end of tests for some previously uncovered code in trigi.lisp and trigo.lisp */
 593
 594 /* Restore global flags */
 595 (halfangles:old_halfangles,%iargs:old_%iargs,done);
 596 done;
 597
 598 /* SF bug # 2570: "Make acos(cos(x)) simplify to x when on correct interval" */
 599
 600 (kill (foo),
 601  acos (cos (foo)));
 602 acos (cos (foo));
 603
 604 (ctxt : newcontext (),
 605  assume (0 <= foo and foo <= %pi),
 606  acos (cos (foo)));
 607 foo;
 608
 609 killcontext (ctxt);
 610 done;
 611
 612 /* mailing list 2015-08-25: "Strange symmetry of acoth(x), area cotangens hyperbolicus function (#552)" */
 613
 614 (kill (x), - acoth (- x));
 615 acoth (x);
 616
 617 /* SF bug #2620: "atan2(y,x)+atan2(-y,x) doesn't always return 0 " */
 618
 619 (kill (x, y), atan2(y,x)+atan2(-y,x));
 620 0;
 621
 622 (assume (y > 0), atan2(y,x)+atan2(-y,x));
 623 0;
 624
 625 (kill (n, p, r), forget (y > 0), assume(n<0,p>0), atan2 (- x, r));
 626 - atan2 (x, r);
 627
 628 atan2 (-n, r);
 629 - atan2 (n, r);
 630
 631 atan2 (-p, r);
 632 - atan2 (p, r);
 633
 634 forget (n < 0, p > 0);
 635 [n < 0, p > 0];
 636
 637 /* mailing list 2017-11-27: "trigsimp fails with pderivop" */
 638
 639 (load (pdiff),
 640  kill (f, y),
 641  expr:pderivop(f,1)((y))^2);
 642 pderivop(f,1)(y)^2;
 643
 644 trigsimp (expr);
 645 pderivop(f,1)(y)^2;
 646
 647 (reset (use_pdiff), 0); /* disables pdiff */
 648 0;
 649
 650 (kill (foo, x),
 651  trigsimp (foo(1)(x)^3));
 652 foo(1)(x)^3;
 653
 654 /* maxima-discuss 2023-02-17: "acos(1) works; acos(1.0) doesn't !"
 655  * bug appears to be specific to GCL versions < 2.14.
 656  * more extensive tests for special cases would be terrific.
 657  */
 658
 659 [acos(1), acos(1.0), acos(1b0)];
 660 [0, 0.0, 0b0];
 661