tests/rtest3.mac

   1 /*************** -*- Mode: MACSYMA; Package: MAXIMA -*-  ******************/
   2 /***************************************************************************
   3 ***                                                                    *****
   4 ***     Copyright (c) 1984 by William Schelter,University of Texas     *****
   5 ***     All rights reserved                                            *****
   6 ***************************************************************************/
   7
   8
   9 /* rtest3 */
  10 kill(all);
  11 done;
  12 for a from -3 step 7 thru 26 do ldisplay(a);
  13 done$
  14 s:0;
  15 0$
  16 for i while i <= 10 do s:s+i;
  17 done$
  18 s;
  19 55$
  20 series:1;
  21 1$
  22 term:exp(sin(x));
  23 %e^sin(x)$
  24 for p unless p > 7 do
  25     (term:diff(term,x)/p,series:series+subst(x = 0,term)*x^p);
  26 done$
  27 series;
  28 x^7/90-x^6/240-x^5/15-x^4/8+x^2/2+x+1$
  29 poly:0;
  30 0$
  31 for i thru 5 do (for j from i step -1 thru 1 do poly:poly+i*x^j);
  32 done$
  33 poly;
  34 5*x^5+9*x^4+12*x^3+14*x^2+15*x$
  35 guess:-3.0;
  36 -3.0$
  37 for i thru 10 do
  38     (guess:subst(guess,x,0.5*(x+10/x)),
  39      if abs(guess^2-10) < 5.0e-5 then return(guess));
  40 -3.162280701754386;
  41 /* -3.1622806$ */
  42 for count from 2 next 3*count thru 20 do ldisplay(count);
  43 done$
  44 x:1000;
  45 1000$
  46 thru 10 while x # 0 do x:0.5*(x+5/x);
  47 done$
  48 x;
  49 2.282429035887867$
  50 remvalue(x);
  51 [x]$
  52 newton(f,guess):=block([numer,y],local(f,df,x,guess),numer:true,
  53        define(df(x),diff(f(x),x)),
  54        do (y:df(guess),if y = 0 then error("derivative at",guess,"is zero"),
  55            guess:guess-f(guess)/y,
  56            if abs(f(guess)) < 5.0e-6 then return(guess)));
  57 newton(f,guess):=block([numer,y],local(f,df,x,guess),numer:true,
  58        define(df(x),diff(f(x),x)),
  59        do (y:df(guess),if y = 0 then error("derivative at",guess,"is zero"),
  60            guess:guess-f(guess)/y,
  61            if abs(f(guess)) < 5.0e-6 then return(guess)))$
  62 sqr(x):=x^2-5.0;
  63 sqr(x):=x^2-5.0$
  64 newton(sqr,1000);
  65 2.236068027062195;
  66 for f in [log,rho,atan] do ldisp(f(1.0));
  67 done$
  68 ev(concat(e,linenum-1),numer);
  69 e10$
  70 kill(functions,values,arrays);
  71 done$
  72 done;
  73 done$
  74 exp:diff(x*f(x),x);
  75 x*'diff(f(x),x,1)+f(x)$
  76 f(x):=sin(x);
  77 f(x):=sin(x)$
  78 ev(exp,diff);
  79 sin(x)+x*cos(x)$
  80 x;
  81 x$
  82 x:3;
  83 3$
  84 x;
  85 3$
  86 'x;
  87 x$
  88 f(x):=x^2;
  89 f(x):=x^2$
  90 'f(2);
  91 'f(2)$
  92 ev(%,f);
  93 4$
  94 '(f(2));
  95 f(2)$
  96 f(2);
  97 4$
  98 sum(i!,i,1,4);
  99 33$
 100 'sum(i!,i,1,4);
 101 'sum(i!,i,1,4)$
 102 remvalue(x);
 103 [x]$
 104 'integrate(f(x),x,a,b);
 105 'integrate(x^2,x,a,b)$
 106 for i thru 5 do s:s+i^2;
 107 done$
 108 exp:s;
 109 s+55$
 110 ev(%,s:0);
 111 55$
 112 ev(exp);
 113 s+110$
 114 exp:'sum(g(i),i,0,n);
 115 'sum(g(i),i,0,n)$
 116 z*%e^z;
 117 z*%e^z$
 118 ev(%,z:x^2);
 119 x^2*%e^x^2$
 120 subst(x^2,z,exp);
 121 'sum(g(i),i,0,n)$
 122 a:%;
 123 'sum(g(i),i,0,n)$
 124 a+1;
 125 'sum(g(i),i,0,n)+1$
 126 kill(a,y);
 127 done$
 128 a;
 129 a$
 130 declare(integrate,noun);
 131 done$
 132 integrate(y^2,y);
 133 integrate(y^2,y)$
 134 ''integrate(y^2,y);
 135 y^3/3$
 136 f(y):=diff(y*log(y),y,2);
 137 f(y):=diff(y*log(y),y,2)$
 138 f(y):=1/y;
 139 f(y):=1/y$
 140 c10;
 141 c10$
 142 (x+y)^3;
 143 (y+x)^3$
 144 diff(%,x);
 145 3*(y+x)^2$
 146 y:x^2+1;
 147 x^2+1$
 148
 149 /* begin fix */
 150 kill(all);
 151 done;
 152  ev(%e^x*sin(x)^2,exponentialize);
 153  -%e^x*(%e^(%i*x)-%e^-(%i*x))^2/4;
 154   integrate(%,x);
 155 -((%e^((2*%i+1)*x)/(2*%i+1)+%e^((1-2*%i)*x)/(1-2*%i)-2*%e^x)/4);
 156  ev(%,demoivre);
 157  -((%e^x*(%i*sin(2*x)+cos(2*x))/(2*%i+1)
 158       +%e^x*(cos(2*x)-%i*sin(2*x))/(1-2*%i)-2*%e^x)
 159       /4);
 160  ans:ev(%,ratexpand);
 161  -%e^x*sin(2*x)/5-%e^x*cos(2*x)/10+%e^x/2;
 162  ev(ans,x:1,numer)-ev(ans,x:0,numer);
 163  0.5779160182042402;
 164  (fpprec : 35, 0);
 165  0;
 166  ev(ans,x:1,bfloat)-ev(ans,x:0,bfloat);
 167  5.7791601820424019599988308251707781b-1;
 168  integrate(%e^x*sin(x)^2,x);
 169  -(((2*%e^x*sin(2*x)+%e^x*cos(2*x)-5*%e^x)/10));
 170  trigreduce(%);
 171  -((2*%e^x*sin(2*x)+%e^x*cos(2*x)-5*%e^x)/10);
 172  % - ans,ratsimp;
 173  0 ;
 174  reset (fpprec);
 175  [fpprec];
 176
 177 /* end fix*/
 178
 179 ev(sin(x),%emode);
 180 sin(x)$
 181 sin(%pi/12)+tan(%pi/6);
 182 sin(%pi/12)+1/sqrt(3)$
 183 ev(%,numer);
 184 0.8361693142921465;
 185 /* tops 20 : 0.83616931$ */
 186 sin(1);
 187 sin(1)$
 188 ev(sin(1),numer);
 189 0.8414709848078965$
 190 beta(1/2,2/5);
 191 beta(1/2,2/5)$
 192 ev(%,numer);
 193 3.679093980405881;
 194 /* tops 20: 3.67909265$ */
 195 diff(atanh(sqrt(x)),x);
 196 1/(2*(1-x)*sqrt(x))$
 197 fpprec:25;
 198 25$
 199 sin(5.0b-1);
 200 4.794255386042030002732879b-1$
 201 (reset (fpprec), 0);
 202 0;
 203 /*begin fix */
 204  exp:cos(x)^2-sin(x)^2;
 205  cos(x)^2-sin(x)^2$
 206  ev(%,x:%pi/3);
 207  -1/2$
 208  diff(exp,x);
 209  -4*cos(x)*sin(x)$
 210  integrate(exp,x);
 211  (sin(2*x)/2+x)/2-(x-sin(2*x)/2)/2$
 212  expand(%);
 213  sin(2*x)/2$
 214  trigexpand(%);
 215  cos(x)*sin(x)$
 216  trigreduce(%);
 217  sin(2*x)/2$
 218  diff(%,x);
 219  cos(2*x)$
 220  %-exp,trigreduce,ratsimp;
 221   0;
 222 /*end fix*/
 223 sech(x)^2*sinh(x)*tanh(x)/coth(x)^2+cosh(x)^2*sech(x)^2*tanh(x)/coth(x)^2
 224                                    +sech(x)^2*tanh(x)/coth(x)^2;
 225 sech(x)^2*sinh(x)*tanh(x)/coth(x)^2+cosh(x)^2*sech(x)^2*tanh(x)/coth(x)^2
 226                                    +sech(x)^2*tanh(x)/coth(x)^2$
 227 trigsimp(%);
 228 (sinh(x)^5+sinh(x)^4+2*sinh(x)^3)/cosh(x)^5$
 229 /* These are from the trgsmp.dem file.
 230  * I (rtoy) hand-verified these results (using maxima, of course)
 231  */
 232 (1-sin(x)^2)*cos(x)/cos(x)^2+tan(x)*sec(x)^2;
 233 (1-sin(x)^2)*cos(x)/cos(x)^2+tan(x)*sec(x)^2$
 234 trigsimp(%);
 235 (sin(x)+cos(x)^4)/cos(x)^3$
 236
 237 tan(x)^2+sec(x)^2/(1-tan(x)*sec(x));
 238 tan(x)^2+sec(x)^2/(1-tan(x)*sec(x))$
 239 trigsimp(%);
 240 (sin(x)^4+sin(x)^3-1)/(cos(x)^2*sin(x)-cos(x)^4)$
 241
 242 (sin(x)^4-6*cos(x)^2*sin(x)^2+4*(cos(x)^2-sin(x)^2)+8*sin(x)+cos(x)^4+3)/(8*cos(x)^3);
 243 (sin(x)^4-6*cos(x)^2*sin(x)^2+4*(cos(x)^2-sin(x)^2)+8*sin(x)+cos(x)^4+3)/(8*cos(x)^3)$
 244 trigsimp(%);
 245 (sin(x)+cos(x)^4)/cos(x)^3$
 246
 247
 248 sech(x)^2*sinh(x)*tanh(x)/coth(x)^2+cosh(x)^2*sech(x)^2*tanh(x)/coth(x)^2+sech(x)^2*tanh(x)/coth(x)^2;
 249 sech(x)^2*sinh(x)*tanh(x)/coth(x)^2+cosh(x)^2*sech(x)^2*tanh(x)/coth(x)^2+sech(x)^2*tanh(x)/coth(x)^2$
 250 trigsimp(%);
 251 (sinh(x)^5+sinh(x)^4+2*sinh(x)^3)/cosh(x)^5$
 252
 253 -sech(x)^5*(sinh(x)^5+2*(sinh(x)^4+6*cosh(x)^2*sinh(x)^2+cosh(x)^4)-13*(sinh(x)^3+3*cosh(x)^2*sinh(x))+10*cosh(x)^2*sinh(x)^3-8*(sinh(x)^2+cosh(x)^2)+5*cosh(x)^4*sinh(x)+34*sinh(x)+6)/16;
 254 -sech(x)^5*(sinh(x)^5+2*(sinh(x)^4+6*cosh(x)^2*sinh(x)^2+cosh(x)^4)-13*(sinh(x)^3+3*cosh(x)^2*sinh(x))+10*cosh(x)^2*sinh(x)^3-8*(sinh(x)^2+cosh(x)^2)+5*cosh(x)^4*sinh(x)+34*sinh(x)+6)/16$
 255 trigsimp(%);
 256 -((sinh(x)^5+sinh(x)^4-2*sinh(x)^3)/cosh(x)^5)$
 257
 258 cos(x)*(sec(x)^2*tan(x)+1)-sec(x)^2*sin(x)-cos(x);
 259 cos(x)*(sec(x)^2*tan(x)+1)-sec(x)^2*sin(x)-cos(x)$
 260 trigsimp(%);
 261 0$
 262
 263 v*cos(x)*sec(x)^2*tan(x)+(-v*sec(x)^2-2*'diff(v,x))*sin(x)+'diff(v,x)*cos(x)*sec(x)+'diff(v,x,2)*cos(x);
 264 v*cos(x)*sec(x)^2*tan(x)+(-v*sec(x)^2-2*'diff(v,x))*sin(x)+'diff(v,x)*cos(x)*sec(x)+'diff(v,x,2)*cos(x)$
 265 trigsimp(%);
 266 -2*'diff(v,x,1)*sin(x)+'diff(v,x,2)*cos(x)+'diff(v,x,1)$
 267
 268 triginverses : all;
 269 all;
 270
 271 sinh(acosh(x));
 272 sqrt(x-1)*sqrt(x+1);
 273
 274 sinh(atanh(x));
 275 x/(sqrt(1-x)*sqrt(x+1));
 276
 277 cosh(asinh(x));
 278 sqrt(x^2+1);
 279
 280 cosh(atanh(x));
 281 1/(sqrt(1-x)*sqrt(x+1));
 282
 283 tanh(asinh(x));
 284 x/sqrt(x^2+1);
 285
 286 tanh(acosh(x));
 287 sqrt(x-1)*sqrt(x+1)/x;
 288
 289 /* A few checks to see that triginverses false disables the above transformations */
 290 triginverses: false;
 291 false;
 292
 293 cos(acosh(x));
 294 cos(acosh(x));
 295
 296 triginverses : all;
 297 all;
 298
 299 /* SF bug # 1981518, Calling desolve inside a "for...do" makes it loop endlessly
 300  * (protect against endless loop by throw--catch in case bug is triggered)
 301  */
 302 catch (block ([foo:1],
 303  for i thru 3 do (ilt (1/s, s, t),
 304  if foo > 3 then throw ('i = i) else foo : foo + 1)));
 305 done;
 306
 307 /* bug reported to mailing list 2009-05-09
 308  * unexpected behavior in for loop with variable step
 309  */
 310
 311 block ([L : []], for r:0 thru 7 step +2 do L : cons (r, L), L);
 312 [6, 4, 2, 0];
 313
 314 block ([L : []], for r:7 thru 0 step -2 do L : cons (r, L), L);
 315 [1, 3, 5, 7];
 316
 317 block ([L : [], r0 : 0, r1 : 7, s : +2], for r:r0 thru r1 step s do L : cons (r, L), L);
 318 [6, 4, 2, 0];
 319
 320 block ([L : [], r0 : 7, r1 : 0, s : -2], for r:r0 thru r1 step s do L : cons (r, L), L);
 321 [1, 3, 5, 7];
 322
 323 /* step is evaluated once at start of loop, so these loops are defined */
 324
 325 block ([L : [], s : +2], for i:1 thru 10 step s do L : cons (s : -s, L), L);
 326 [-2, 2, -2, 2, -2];
 327
 328 block ([L : [], s : -2], for i:10 thru 1 step s do L : cons (s : -s, L), L);
 329 [2, -2, 2, -2, 2];
 330
 331 /* bug reported to mailing list 2009-05-13 "reset ( radexpand,  domain )"
 332  *
 333  * display2d is a resettable option variable. We save the value of display2d
 334  * and restore it after the reset. This allows to run the testsuite in both
 335  * display modes.
 336  */
 337 (save:display2d, done);
 338 done$
 339 (reset (), [radexpand, domain]);
 340 [true, real];
 341 (display2d:save, done);
 342 done$
 343
 344 [radexpand, domain] : [all, complex];
 345 [all, complex];
 346
 347 reset (radexpand, domain);
 348 [radexpand, domain];
 349
 350 [radexpand, domain];
 351 [true, real];
 352
 353 ([foo, bar, baz] : [1, 2, 3],
 354  /* should ignore these non-defmvar's */
 355  reset (foo, bar, baz));
 356 [];
 357
 358 /* verify that ORDFNA can handle CRE.
 359  */
 360 (kill (a, b), [doallmxops, doscmxops] : [false, false], 0);
 361 0;
 362
 363 b*matrix([rat(a)]);
 364 b*matrix([''(rat(a))]);
 365
 366 (reset (doallmxops, doscmxops), 0);
 367 0;
 368
 369 /* SF bug #2936: stack overflow in integrate */
 370
 371 kill (x, A, B, MU, SIGMA);
 372 done;
 373
 374 trigsimp (gamma_incomplete (1, log (x)));
 375 gamma_incomplete (1, log (x));
 376
 377 trigsimp ((%i*gamma_incomplete(1,(1-2*log(x))^2/4)*(1-2*log(x))^2)
 378            /(2*log(x)-1)^2);
 379 %i*gamma_incomplete(1,(4*log(x)^2-4*log(x)+1)/4)$
 380
 381 trigsimp (integrate (%e^((-log(x)^2)-1)*log(x),x));
 382 -(%e^-(3/4)*(2*gamma_incomplete(1,(4*log(x)^2-4*log(x)+1)/4)*abs(2*log(x)-1)
 383             +2*gamma_incomplete(1/2,(4*log(x)^2-4*log(x)+1)/4)*log(x)
 384             -gamma_incomplete(1/2,(4*log(x)^2-4*log(x)+1)/4)))
 385  /(4*abs(2*log(x)-1))$
 386
 387 /* throw away results of integrate, just make sure it runs without crashing */
 388 block ([foo, bar, ctxt, domain : 'complex],
 389   foo : exp(-(log(x) - MU)*(log(x) - MU)/(2*SIGMA*SIGMA))/(x*SIGMA*sqrt(2*%pi)),
 390   bar : (log(B) - log(x*SIGMA) + ((x-A)*(x-A)/(2*B*B) - (log(x) -MU)*(log(x) -MU)/(2*SIGMA*SIGMA))),
 391   [foo, bar] : subst ([A=2, MU=3], [foo, bar]),
 392   ctxt : newcontext (),
 393   assume (SIGMA > 0, B > 0),
 394   integrate (expand (foo*bar), x),
 395   integrate (expand (foo*bar), x, 2, inf),
 396   killcontext (ctxt),
 397   remvalue(ctxt),
 398   0);
 399 0;
 400
 401 /* mailing list 2015-09-07: How can I catch this error? "errcatch" doesn't do the trick. */
 402
 403 /* result for this test will change if ever "quotient by zero" bug is fixed */
 404 errcatch (integrate(ev(ratsimp(1/(x^(5/2)+3*x^(1/3))),algebraic),x));
 405 [];
 406
 407 (kill (foo, bar, baz), foo () := bar (), bar () := (errcatch (integrate(ev(ratsimp(1/(x^(5/2)+3*x^(1/3))),algebraic),x)), throw ('baz)), catch (foo ()));
 408 baz;
 409
 410 /* This bug can be fixed by changing simplus to simplify 2^(3/2)*x^2 - sqrt(2)*x^2
 411 to sqrt(2)*x^2. Until this bug is fixed, we'll errcatch this test. */
 412 errcatch (integrate (exp(2^(3/2)*x^2 - sqrt(2)*x^2), x));
 413 [-((sqrt(%pi)*%i*erf(2^(1/4)*%i*x))/2^(5/4))];
 414
 415 (kill (quux), bar () := (errcatch (integrate (exp(2^(3/2)*x^2 - sqrt(2)*x^2), x)), throw ('quux)), catch (foo ()));
 416 quux;
 417
 418 /* result for this test will change if ever "quotient by zero" bug is fixed */
 419 errcatch (taylor(coth(x), x, %i*%pi, 0));
 420 [];
 421
 422 (kill (mumble), bar () := (errcatch (taylor(coth(x), x, %i*%pi, 0)), throw ('mumble)), catch (foo ()));
 423 mumble;
 424
 425 /* Verify that some special variables that were recently given DEFMVAR's are now resettable.
 426  * If ever the default values of these variables are changed,
 427  * some of the following tests will fail.
 428  * In that case just update these tests to use the new default value.
 429  */
 430
 431 (kill(mydefaults),
 432  mydefaults['verbose] : false,
 433  mydefaults['exptsubst] : false,
 434  mydefaults['partswitch] : false,
 435  mydefaults['inflag] : false,
 436  mydefaults['derivsubst] : false,
 437  mydefaults['opsubst] : true,
 438  mydefaults['demoivre] : false,
 439  mydefaults['nointegrate] : false,
 440  mydefaults['tlimswitch] : true,
 441  mydefaults['limsubst] : false,
 442  mydefaults['packagefile] : false,
 443  mydefaults['factlim] : 100000,
 444  mydefaults['cflength] : 1,
 445  mydefaults['taylordepth] : 3,
 446  mydefaults['maxtaydiff] : 4,
 447  mydefaults['lhospitallim] : 4,
 448  mydefaults['linel] : 79,
 449  0);
 450 0;
 451
 452 (reset (),
 453  every (lambda ([v], is(mydefaults[v] = ev(v))), flatten (rest (arrayinfo (mydefaults), 2))));
 454 true;
 455
 456 (myflags : '[verbose, exptsubst, partswitch, inflag, derivsubst, opsubst, demoivre,
 457              nointegrate, tlimswitch, limsubst, packagefile],
 458  /* "not" causes an extra evaluation of its argument,
 459   * so this next line won't work as expected if "not" ever becomes
 460   * simplifying operator; update this test case as needed if that
 461   * ever comes to pass.
 462   */
 463  myflags :: map ("not", myflags),
 464  ev (myflags));
 465 [true, true, true, true, true, false, true, true, false, true, true];
 466
 467 map (reset, myflags);
 468 [[verbose], [exptsubst], [partswitch], [inflag], [derivsubst], [opsubst], [demoivre],
 469  [nointegrate], [tlimswitch], [limsubst], [packagefile]];
 470
 471 ev (myflags);
 472 [false, false, false, false, false, true, false, false, true, false, false];
 473
 474 (myvals : '[factlim, cflength, taylordepth, maxtaydiff, lhospitallim, linel],
 475  myvals :: makelist (99, v, myvals),
 476  ev (myvals));
 477 [99, 99, 99, 99, 99, 99];
 478
 479 map (reset, myvals);
 480 [[factlim], [cflength], [taylordepth], [maxtaydiff], [lhospitallim], [linel]];
 481
 482 ev (myvals);
 483 [100000, 1, 3, 4, 4, 79];
 484
 485 declare_index_properties
 486  (A, [],
 487   B, [postsubscript],
 488   C, [postsubscript, postsuperscript],
 489   D, [postsubscript, postsuperscript, presuperscript],
 490   E, [postsubscript, postsuperscript, presuperscript, presubscript],
 491   F, [postsubscript, postsuperscript, presuperscript, presubscript,
 492       postsubscript, postsuperscript, presuperscript, presubscript],
 493   G, [postsubscript, postsuperscript, presuperscript, presubscript,
 494       postsuperscript, presubscript]);
 495 done;
 496
 497 map (get_index_properties, '[A, B, C, D, E, F, G]);
 498 [[],
 499  [postsubscript],
 500  [postsubscript, postsuperscript],
 501  [postsubscript, postsuperscript, presuperscript],
 502  [postsubscript, postsuperscript, presuperscript, presubscript],
 503  [postsubscript, postsuperscript, presuperscript, presubscript,
 504   postsubscript, postsuperscript, presuperscript, presubscript],
 505  [postsubscript, postsuperscript, presuperscript, presubscript,
 506   postsuperscript, presubscript]];
 507
 508 kill (a, b, c, d, w, x, y, z);
 509 done;
 510
 511 /* This business about capturing the output to a string and comparing that
 512  * is a little fragile in the sense that changing invisible stuff (trailing
 513  * spaces, newline character) can make these tests fail.
 514  * But the pretty printer code changes very infrequently,
 515  * and also I believe that these tests should work the same on Windows as
 516  * on Unix-like platforms, because TERPRI (according to CLHS) just outputs #\Newline.
 517  * Changing this file from NL to CR-NL line endings will presumably
 518  * make these tests fail.
 519  */
 520
 521 with_default_2d_display ([S: make_string_output_stream ()],
 522   with_stdout (S, ?terpri (), print (A[x])),
 523   get_output_stream_string (S));
 524 "
 525 A
 526  x
 527 ";
 528
 529 with_default_2d_display ([S: make_string_output_stream ()],
 530   with_stdout (S, ?terpri (), print (B[x])),
 531   get_output_stream_string (S));
 532 "
 533 B
 534  x
 535 ";
 536
 537 with_default_2d_display ([S: make_string_output_stream ()],
 538   with_stdout (S, ?terpri (), print (C[x, y])),
 539   get_output_stream_string (S));
 540 "
 541  y
 542 C
 543  x
 544 ";
 545
 546 with_default_2d_display ([S: make_string_output_stream ()],
 547   with_stdout (S, ?terpri (), print (D[x, y, z])),
 548   get_output_stream_string (S));
 549 "
 550 z y
 551  D
 552   x
 553 ";
 554
 555 with_default_2d_display ([S: make_string_output_stream ()],
 556   with_stdout (S, ?terpri (), print (E[w, x, y, z])),
 557   get_output_stream_string (S));
 558 "
 559 y x
 560  E
 561 z w
 562 ";
 563
 564 with_default_2d_display ([S: make_string_output_stream ()],
 565   with_stdout (S, ?terpri (), print (F[a, b, c, d, w, x, y, z])),
 566   get_output_stream_string (S));
 567 "
 568 c, y b, x
 569     F
 570 d, z a, w
 571 ";
 572
 573 with_default_2d_display ([S: make_string_output_stream ()],
 574   with_stdout (S, ?terpri (), print (G[a, b, c, d, w, x])),
 575   get_output_stream_string (S));
 576 "
 577    c b, w
 578     G
 579 d, x a
 580 ";
 581
 582 with_default_2d_display ([S: make_string_output_stream ()],
 583   with_stdout (S, ?terpri (), print (G[a, B[a], C[a, b], D[a, b, c], E[a, b, c, d], F[a, b, c, d, w, x, y, z]])),
 584   get_output_stream_string (S));
 585 "
 586              b     c b
 587             C  B ,  E
 588              a  a  d a
 589               G
 590 c b  c, y b, x a
 591  D ,     F
 592   a  d, z a, w
 593 ";
 594
 595 with_default_2d_display ([S: make_string_output_stream ()],
 596   with_stdout (S, ?terpri (), print (sqrt (G[a, b, c, d, w, x]))),
 597   get_output_stream_string (S));
 598 "
 599         c b, w
 600 sqrt(    G    )
 601      d, x a
 602 ";
 603
 604 block ([display2d_unicode: false], with_default_2d_display ([S: make_string_output_stream ()],
 605   with_stdout (S, ?terpri (), print ((1 - G[a, b, c, d, w, x])/E[1, 1/2, 2/3, 17/29])),
 606   get_output_stream_string (S)));
 607 "
 608        c b, w
 609 1 -     G
 610     d, x a
 611 -------------
 612     2/3 1/2
 613        E
 614   17/29 1
 615 ";
 616
 617 remove_index_properties (A, B, C, D, E, F, G);
 618 done;
 619
 620 map (get_index_properties, '[A, B, C, D, E, F, G]);
 621 [[], [], [], [], [], [], []];
 622
 623 /* email from Oleg Nesterov 2020-05-21: "maxima: bug in dsumprod() ?" */
 624
 625 (print_string_2d (e) := with_default_2d_display (printf (false, "~m", e)), 0);
 626 0;
 627
 628 block ([display2d_unicode: false], print_string_2d (lsum(1/f(g(x)/h(x)), x, LOOOOOOOOONG_EXPR)));
 629 "____
 630 \\                         1
 631  >                     -------
 632 /                        g(x)
 633 ----                   f(----)
 634 x in LOOOOOOOOONG_EXPR   h(x)
 635 "$
 636
 637 /* other examples which call DSUMPROD in test suite */
 638
 639 block ([display2d_unicode: false], print_string_2d ('sum(x^k / k,k,1,inf)));
 640 "inf
 641 ____   k
 642 \\     x
 643  >    --
 644 /     k
 645 ----
 646 k = 1
 647 "$
 648
 649 block ([display2d_unicode: false], print_string_2d (subst (k = \*index, 'sum(x^k / k,k,1,inf))));
 650 "inf
 651 ____        *index
 652 \\          x
 653  >         -------
 654 /          *index
 655 ----
 656 *index = 1
 657 "$
 658
 659 block ([display2d_unicode: false], print_string_2d ('sum(i!,i,1,4)));
 660 " 4
 661 ____
 662 \\
 663  >    i!
 664 /
 665 ----
 666 i = 1
 667 "$
 668
 669 block ([display2d_unicode: false], print_string_2d ('sum(g(i),i,0,n)));
 670 " n
 671 ____
 672 \\
 673  >    g(i)
 674 /
 675 ----
 676 i = 0
 677 "$
 678
 679 block ([display2d_unicode: false], print_string_2d ('sum(g(i),i,0,n) + 1));
 680 " n
 681 ____
 682 \\
 683  >    g(i) + 1
 684 /
 685 ----
 686 i = 0
 687 "$
 688
 689 block ([display2d_unicode: false], print_string_2d (foo: unsum(product(i^2,i,1,n),n)));
 690 " n - 1
 691  _____
 692  |   |  2
 693 (|   | i ) (n - 1) (n + 1)
 694  |   |
 695  i = 1
 696 "$
 697
 698 block ([display2d_unicode: false], print_string_2d (nusum(foo,n,1,n)));
 699 "  n
 700 _____
 701 |   |  2
 702 |   | i  - 1
 703 |   |
 704 i = 1
 705 "$
 706
 707 block ([display2d_unicode: false], print_string_2d (powerseries(log(sin(x)/x),x,0)));
 708 "inf
 709 ____        i2  2 i2 - 1             2 i2
 710 \\      (- 1)   2         bern(2 i2) x
 711  >     ----------------------------------
 712 /                  i2 (2 i2)!
 713 ----
 714 i2 = 1
 715 "$
 716
 717 block ([display2d_unicode: false], print_string_2d (product((x^i+1)^2.5,i,1,inf)/(x^2+1)));
 718 " inf
 719 _____
 720 |   |   i     2.5
 721 |   | (x  + 1)
 722 |   |
 723 i = 1
 724 -----------------
 725       2
 726      x  + 1
 727 "$
 728
 729 /* additional DSUMPROD examples */
 730
 731 block ([display2d_unicode: false], print_string_2d ('lsum(1/(1+f(x)/2), kskdsksdkkdksdksd, w999393293923939losl)));
 732 "____
 733 \\                                            1
 734  >                                        --------
 735 /                                         f(x)
 736 ----                                      ---- + 1
 737 kskdsksdkkdksdksd in w999393293923939losl  2
 738 "$
 739
 740 block ([display2d_unicode: false], print_string_2d ('lsum(1/(1+f(x)/2), kskdsksdkkdksdksd, w999393293923939losl^2)));
 741 "____
 742 \\                                             1
 743  >                                         --------
 744 /                                          f(x)
 745 ----                                       ---- + 1
 746                                          2  2
 747 kskdsksdkkdksdksd in w999393293923939losl
 748 "$
 749
 750 block ([display2d_unicode: false], print_string_2d ('lsum(1/(1+f(x)/2), kskdsksdkkdksdksd, w999393293923939losl^skdkskdsk)));
 751 "____
 752 \\                                                     1
 753  >                                                 --------
 754 /                                                  f(x)
 755 ----                                               ---- + 1
 756                                          skdkskdsk  2
 757 kskdsksdkkdksdksd in w999393293923939losl
 758 "$
 759
 760 /* ensure that nounified operators are displayed same as verbs
 761  * follow-on work for bug reported to mailing list 2020-09-13: "Function name for matrix/vector dot product?"
 762  */
 763
 764 kill (foo, x, y, z, a, b, c);
 765 done;
 766
 767 print_string_2d (' "'"(foo));
 768 "'foo
 769 ";
 770
 771 print_string_2d (' ":"(foo, 123));
 772 "foo : 123
 773 ";
 774
 775 print_string_2d (' "::"(foo, 123));
 776 "foo :: 123
 777 ";
 778
 779 print_string_2d (' ":="(foo(a, b), [x, y, z]));
 780 "foo(a, b) := [x, y, z]
 781 ";
 782
 783 print_string_2d (' "::="(foo(a, b), [x, y, z]));
 784 "foo(a, b) ::= [x, y, z]
 785 ";
 786
 787 print_string_2d (' "!"(4));
 788 "4!
 789 ";
 790
 791 print_string_2d (' "^"(2, x));
 792 " x
 793 2
 794 ";
 795
 796 print_string_2d (' "^^"(a, b));
 797 " <b>
 798 a
 799 ";
 800
 801 print_string_2d (' "."(a, b, c));
 802 "a . b . c
 803 ";
 804
 805 block ([display2d_unicode: false], print_string_2d (' ?rat(a, b)));
 806 "a
 807 -
 808 b
 809 ";
 810
 811 block ([display2d_unicode: false], print_string_2d (' "/"(a, b)));
 812 "a
 813 -
 814 b
 815 ";
 816
 817 print_string_2d (' "*"(a, b, c));
 818 "a b c
 819 ";
 820
 821 print_string_2d (' "+"(a, b, c));
 822 "a + b + c
 823 ";
 824
 825 print_string_2d (' "-"(a));
 826 "- a
 827 ";
 828
 829 print_string_2d ('?marrow(a, b));
 830 "a -> b
 831 ";
 832
 833 print_string_2d (' ">"(a, b));
 834 "a > b
 835 ";
 836
 837 print_string_2d (' ">="(a, b));
 838 "a >= b
 839 ";
 840
 841 print_string_2d (' "="(a, b));
 842 "a = b
 843 ";
 844
 845 print_string_2d (' "#"(a, b));
 846 "a # b
 847 ";
 848
 849 print_string_2d (' "<="(a, b));
 850 "a <= b
 851 ";
 852
 853 print_string_2d (' "<"(a, b));
 854 "a < b
 855 ";
 856
 857 print_string_2d (' "not"(a));
 858 "not a
 859 ";
 860
 861 print_string_2d (' "and"(a, b));
 862 "a and b
 863 ";
 864
 865 print_string_2d (' "or"(a, b));
 866 "a or b
 867 ";
 868
 869 print_string_2d ('?mprogn(a, b, c));
 870 "(a, b, c)
 871 ";
 872
 873 print_string_2d ('?mlist(a, b, c));
 874 "[a, b, c]
 875 ";
 876
 877 /* example from mailing list 2019-04-02: "maxima lists" */
 878 print_string_2d ('[x][1]);
 879 "[x]
 880    1
 881 ";
 882
 883 print_string_2d ('?mangle(a, b, c));
 884 "<a, b, c>
 885 ";
 886
 887 print_string_2d ('?mcomma(a, b, c));
 888 "a, b, c
 889 ";
 890
 891 print_string_2d ('?mabs(a));
 892 "abs(a)
 893 ";
 894
 895 block ([display2d_unicode: false], print_string_2d ('matrix([a, b, c])));
 896 "[ a  b  c ]
 897 ";
 898
 899 block ([display2d_unicode: false], print_string_2d ('?mbox(a)));
 900 "\"\"\"
 901 \"a\"
 902 \"\"\"
 903 ";
 904
 905 block ([display2d_unicode: false], print_string_2d ('?mlabox (a, b)));
 906 "b\"\"
 907 \"a\"
 908 \"\"\"
 909 ";
 910
 911 print_string_2d ('?mtext ("hello"));
 912 "hello
 913 ";
 914
 915 block ([linel: 65], print_string_2d ('?mlabel (a, b)));
 916 "(a)                             b
 917 ";
 918
 919 /* SF bug #3301: "fpprintprec do not round bfloat correctly(another case)"
 920  * Test exponent of printed bigfloat is correct when number is rounded.
 921  */
 922
 923 (fpprec:64, fpprintprec:16, done);
 924 done;
 925
 926 print_string_2d(0.99999999999999999999b0);
 927 "1.0b0
 928 ";
 929
 930 print_string_2d(1.99999999999999999999b0);
 931 "2.0b0
 932 ";
 933
 934 bftrunc:false;
 935 false;
 936
 937 print_string_2d(0.99999999999999999999b0);
 938 "1.000000000000000b0
 939 ";
 940
 941 print_string_2d(1.99999999999999999999b0);
 942 "2.000000000000000b0
 943 ";
 944
 945 bftrunc: true;
 946 true;
 947
 948 block([fpprintprec:4],string(0.9999499999b0));
 949 "9.999b-1";
 950 block([fpprintprec:4],string(0.99995b0));
 951 "1.0b0";
 952 block([fpprintprec:4],string(0.99999b0));
 953 "1.0b0";
 954 block([fpprintprec:4],string(1.0005b0));
 955 "1.0b0";
 956 block([fpprintprec:4],string(1.000499999b0));
 957 "1.0b0";
 958 block([fpprintprec:4],string(1.00050001b0));
 959 "1.001b0";
 960
 961 block([fpprintprec:10],string(0.9999999999499b0));
 962 "9.999999999b-1";
 963 block([fpprintprec:10],string(0.99999999999b0));
 964 "1.0b0";
 965 block([fpprintprec:10],string(0.999999999995b0));
 966 "1.0b0";
 967 block([fpprintprec:10],string(1.0000000005b0));
 968 "1.0b0";
 969 block([fpprintprec:10],string(1.00000000051b0));
 970 "1.000000001b0";
 971
 972 block( [ bad: [], str],
 973   for fpprintprec:4 thru 15 do
 974     for a in [1,5,50,-1,-5] do
 975        if parse_string(str: string(1+bfloat(a*10^(-fpprintprec-1)))) # 1.0b0
 976        then push([fpprintprec,a,str],bad),
 977   reverse(bad));
 978  [];
 979
 980 (reset(fpprec, fpprintprec), done);
 981 done;
 982
 983 /* SF bug report #4287: "2d pretty printer ignores successive empty lines"
 984  *
 985  * Note that in the following examples, an empty line is displayed with one space on it,
 986  * so the expected results have a space on lines that are entirely empty in the input.
 987  * This is a consequence of the particular bug fix that was devised;
 988  * if ever the display code is modified again so that the place-holding space
 989  * becomes unnecessary, the expected results will have to be adjusted.
 990  */
 991
 992 print_string_2d ("aaa");
 993 "aaa
 994 ";
 995
 996 print_string_2d ("aaa
 997 bbb");
 998 "aaa
 999 bbb
1000 ";
1001
1002 print_string_2d ("aaa
1003
1004 bbb");
1005 "aaa
1006
1007 bbb
1008 ";
1009
1010 print_string_2d ("aaa
1011
1012
1013 bbb");
1014 "aaa
1015
1016
1017 bbb
1018 ";
1019
1020 print_string_2d ("aaa
1021
1022
1023
1024 bbb
1025
1026
1027
1028
1029 ccc");
1030 "aaa
1031
1032
1033
1034 bbb
1035
1036
1037
1038
1039 ccc
1040 ";
1041
1042 print_string_2d ("
1043
1044
1045
1046 aaa
1047
1048
1049 ");
1050 "
1051
1052
1053
1054 aaa
1055
1056
1057 ";
1058
1059 print_string_2d ("
1060
1061    With longing comes loss,
1062
1063   and the presence of absence:
1064
1065     \"'My Novel' not found.\"
1066
1067 ");
1068 "
1069
1070    With longing comes loss,
1071
1072   and the presence of absence:
1073
1074     \"'My Novel' not found.\"
1075
1076 ";