tests/rtest12.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 (kill(all),matchdeclare(a,true));
  10 done$
  11 (\^rule1_retval : tellsimp(sin(a)^2,1-cos(a)^2), 0);
  12 0;
  13 sin(y)^2;
  14 1-cos(y)^2$
  15 kill(rules);
  16 done$
  17 nonzeroandfreeof(x,e):=is(e # 0 and freeof(x,e));
  18 nonzeroandfreeof(x,e):=is(e # 0 and freeof(x,e))$
  19 matchdeclare(a,nonzeroandfreeof(x),b,freeof(x));
  20 done$
  21 defmatch(linear,a*x+b,x);
  22 linear$
  23 linear(3*z+(y+1)*z+y^2,z);
  24 [b = y^2,a = y+4,x = z]$
  25 matchdeclare([a,f],true);
  26 done$
  27 constinterval(l,h):=constantp(h-l);
  28 constinterval(l,h):=constantp(h-l)$
  29 matchdeclare(b,constinterval(a));
  30 done$
  31 matchdeclare(x,atom);
  32 done$
  33 block(remove(integrate,outative),defmatch(checklimits,'integrate(f,x,a,b)),
  34       declare(integrate,outative));
  35 done$
  36 'integrate(sin(t),t,x+%pi,x+2*%pi);
  37 'integrate(sin(t),t,x+%pi,x+2*%pi)$
  38 checklimits(%);
  39 [b = x+2*%pi,a = x+%pi,x = t,f = sin(t)]$
  40 'integrate(sin(t),t,0,x);
  41 'integrate(sin(t),t,0,t)$
  42 checklimits(%);
  43 false$
  44 (kill(all),matchdeclare(x,freeof(%i)));
  45 done$
  46 %iargs:false;
  47 false$
  48 (sinrule_retval : tellsimp(sin(%i*x),%i*sinh(x)), 0);
  49 0;
  50 trigexpand(sin(x+%i*y));
  51 sin(x)*cos(%i*y)+%i*cos(x)*sinh(y)$
  52 %iargs:true;
  53 true$
  54 errcatch(0^0);
  55 []$
  56 ev((\^rule2_retval : tellsimp(0^0,1), 0),simp:false);
  57 0;
  58 0^0;
  59 1$
  60 remrule ("^", first (\^rule2_retval));
  61 "^"$
  62 (\^rule3_retval : tellsimp(sin(x)^2,1-cos(x)^2), 0);
  63 0;
  64 (sin(x)+1)^2;
  65 (sin(x)+1)^2$
  66 expand(%);
  67 2*sin(x)-cos(x)^2+2$
  68 sin(x)^2;
  69 1-cos(x)^2$
  70 kill(rules);
  71 done$
  72 matchdeclare(a,true);
  73 done$
  74 (\^rule4_retval : tellsimp(sin(a)^2,1-cos(a)^2), 0);
  75 0;
  76 sin(y)^2;
  77 1-cos(y)^2$
  78 kill(rules);
  79 done$
  80 (kill(all),nonzeroandfreeof(x,e):=is(e # 0 and freeof(x,e)));
  81 nonzeroandfreeof(x,e):=is(e # 0 and freeof(x,e))$
  82 matchdeclare(a,nonzeroandfreeof(x),b,freeof(x));
  83 done$
  84 defmatch(linear,a*x+b,x);
  85 linear$
  86 linear(3*z+(y+1)*z+y^2,z);
  87 [b = y^2,a = y+4,x = z]$
  88 matchdeclare([a,f],true);
  89 done$
  90 constinterval(l,h):=constantp(h-l);
  91 constinterval(l,h):=constantp(h-l)$
  92 matchdeclare(b,constinterval(a));
  93 done$
  94 matchdeclare(x,atom);
  95 done$
  96 block(remove(integrate,outative),defmatch(checklimits,'integrate(f,x,a,b)),
  97       declare(integrate,outative));
  98 done$
  99 'integrate(sin(t),t,x+%pi,x+2*%pi);
 100 'integrate(sin(t),t,x+%pi,x+2*%pi)$
 101 checklimits(%);
 102 [b = x+2*%pi,a = x+%pi,x = t,f = sin(t)]$
 103 'integrate(sin(t),t,0,x);
 104 'integrate(sin(t),t,0,t)$
 105 checklimits(%);
 106 false$
 107 remvalue(a,b,f,x);
 108 [a,b,f,x]$
 109 (kill(all),matchdeclare([a,a1,a2],true));
 110 done$
 111 oneless(x,y):=is(x = y-1);
 112 oneless(x,y):=is(x = y-1)$
 113 let(a1*a2!,a1!,oneless,a2,a1);
 114 ?mtext(a1*a2!,?\ \-\-\>\ ,a1!,?\ where\ ,oneless(a2,a1))$
 115 ev(let(a1!/a1,(a1-1)!),letrat);
 116 ?mtext(a1!/a1,?\ \-\-\>\ ,(a1-1)!)$
 117 ev(letsimp(n*m!*(n-1)!/m),letrat);
 118 (m-1)!*n!$
 119 let(sin(a)^2,1-cos(a)^2);
 120 ?mtext(sin(a)^2,?\ \-\-\>\ ,1-cos(a)^2)$
 121 sin(x)^4;
 122 sin(x)^4$
 123 letsimp(%);
 124 cos(x)^4-2*cos(x)^2+1$
 125 matchdeclare([a,a1,a2],true);
 126 done$
 127 oneless(x,y):=is(x = y-1);
 128 oneless(x,y):=is(x = y-1)$
 129 let(a1*a2!,a1!,oneless,a2,a1);
 130 ?mtext(a1*a2!,?\ \-\-\>\ ,a1!,?\ where\ ,oneless(a2,a1))$
 131 ev(let(a1!/a1,(a1-1)!),letrat);
 132 ?mtext(a1!/a1,?\ \-\-\>\ ,(a1-1)!)$
 133 ev(letsimp(n*m!*(n-1)!/m),letrat);
 134 (m-1)!*n!$
 135 let(sin(a)^2,1-cos(a)^2);
 136 ?mtext(sin(a)^2,?\ \-\-\>\ ,1-cos(a)^2)$
 137 sin(x)^4;
 138 sin(x)^4$
 139 letsimp(%);
 140 cos(x)^4-2*cos(x)^2+1$
 141 pfeformat:true;
 142 true$
 143 poissimp(sin(x)^2);
 144 1/2-1/2*cos(2*x)$
 145 (2*a^2-b)*cos(x+2*y)-(a*b+5)*sin(u-4*x);
 146 (2*a^2-b)*cos(2*y+x)+(a*b+5)*sin(4*x-u)$
 147 exp1:outofpois(poisexpt(%,2));
 148 1/2*(2*a^2-b)^2*cos(4*y+2*x)-(2*a^2-b)*(-a*b-5)*sin(2*y+5*x-u)
 149                             +(2*a^2-b)*(-a*b-5)*sin(2*y-3*x+u)
 150                             -1/2*(-a*b-5)^2*cos(8*x-2*u)+1/2*(-a*b-5)^2
 151                             +1/2*(2*a^2-b)^2$
 152 printpois(%);
 153 done$
 154
 155 ratsimp(outofpois(poisint(exp1,y)));
 156 ''(ratsimp(((-1)*(2*a^2-b)*(-5-a*b)*cos(u-3*x+2*y))/2+((2*a^2-b)*(-5-a*b)*cos(-u+5*x+2*y))/2+((2*a^2-b)^2*sin(2*x+4*y))/8))$
 157
 158 ratsimp(outofpois(poissimp(%)));
 159 ''(ratsimp(1/8*(2*a^2-b)^2*sin(4*y+2*x)+1/2*(2*a^2-b)*(-a*b-5)*cos(2*y+5*x-u)
 160                             -1/2*(2*a^2-b)*(-a*b-5)*cos(2*y-3*x+u)))$
 161
 162 poissimp(sin(x)^5+cos(x)^5);
 163 1/16*sin(5*x)+1/16*cos(5*x)-5/16*sin(3*x)+5/16*cos(3*x)+5/8*sin(x)+5/8*cos(x)$
 164
 165 pfeformat:false;
 166 false$
 167
 168 /* test for bug #1097: rules and pattern bug */
 169
 170 (kill (foo, bar),
 171  matchdeclare (aa, true, gg, lambda([yy], evenp(yy) and (yy > 1))),
 172  let (foo(aa)^gg, (1 - bar(aa)^2)^(gg/2)),
 173  0);
 174 0;
 175
 176 letsimp (foo(x)^2);
 177 1 - bar(x)^2;
 178
 179 letsimp (foo(x)^3);
 180 foo(x)^3;
 181
 182 letsimp (foo(x)^4);
 183 bar(x)^4 - 2*bar(x)^2 + 1;
 184
 185 /* More tests for bug #1097: pattern variable appears in letsimp result */
 186
 187 (kill (f, g, x, y),
 188  matchdeclare ([arg1, arg2, exp], true),
 189  let (f(arg1, arg2)^exp, g(arg2, arg1)^exp), 0);
 190 0;
 191
 192 letsimp (f(x, y)); /* This used to yield g(arg2,arg1) */
 193 g(y, x);
 194
 195 letsimp (f(x, y)^2); /* This used to yield g(arg2,arg1)^2 */
 196 g(y, x)^2;
 197
 198 letsimp (f(x, y)^q); /* This used to yield g(arg2,arg1)^q */
 199 g(y, x)^q;
 200
 201 (remlet (f(arg1, arg2)^exp),
 202  remove ([arg1, arg2, exp], matchdeclare),
 203  0);
 204 0;
 205
 206 /* letsimp confused by debug stuff in expression car
 207  * mailing list 2012-12-23: "let(simp) behaves different when loaded from batch file"
 208  */
 209 (kill (test),
 210  test() := block([expr],
 211    local (F),
 212    expr : diff(f(x), x),
 213    F(xx) := at(expr, [x = xx]),
 214    let(at(diff(f(x),x),[x=0]),5),
 215    letsimp(F(0))),
 216  test ());
 217 5;
 218
 219 /* Bug #2709: `letsimp' is wrong if `ratexpand' is called */
 220
 221 (let (U, T), 0);
 222 0;
 223
 224 letsimp (U / n);
 225 T / n;
 226
 227 ratexpand (a * b * c);
 228 a * b * c;
 229
 230 letsimp (U / n); /* This used to yield 1 */
 231 T / n;
 232
 233 (remlet (U), 0);
 234 0;
 235
 236 /* Some basic letsimp tests, based on bug #3950 */
 237
 238 (let (f, g), 0);
 239 0;
 240
 241 letsimp (f);
 242 g;
 243
 244 letsimp (f ());
 245 f ();
 246
 247 letsimp (f (1));
 248 f (1);
 249
 250 letsimp (f (1, 2, 3));
 251 f (1, 2, 3);
 252
 253 (remlet (f), 0);
 254 0;
 255
 256 (let (f (1), g (1)), 0);
 257 0;
 258
 259 letsimp (f);
 260 f;
 261
 262 letsimp (f ());
 263 f ();
 264
 265 letsimp (f (1));
 266 g (1);
 267
 268 letsimp (f (1, 2, 3));
 269 f (1, 2, 3);
 270
 271 (remlet (f (1)), 0);
 272 0;
 273
 274 (let (f (1, 2, 3), g (1, 2, 3)), 0);
 275 0;
 276
 277 letsimp (f);
 278 f;
 279
 280 letsimp (f ());
 281 f ();
 282
 283 letsimp (f (1));
 284 f (1);
 285
 286 letsimp (f (1, 2, 3));
 287 g (1, 2, 3);
 288
 289 (remlet (f (1, 2, 3)), 0);
 290 0;
 291
 292 /* Bug #3950: letsimp confuses symbols and nullary applications */
 293
 294 (let (f (), g ()), 0);
 295 0;
 296
 297 /* This used to yield g() */
 298 letsimp (f);
 299 f;
 300
 301 /* This used to yield f() */
 302 letsimp (f ());
 303 g ();
 304
 305 letsimp (f (1));
 306 f (1);
 307
 308 letsimp (f (1, 2, 3));
 309 f (1, 2, 3);
 310
 311 (remlet (f ()), 0);
 312 0;
 313
 314 (matchdeclare (foo, true), 0);
 315 0;
 316
 317 (let (foo (), bar ()), 0);
 318 0;
 319
 320 /* This used to cause a stack overflow */
 321 letsimp (x);
 322 x;
 323
 324 /* This also used to cause a stack overflow */
 325 letsimp (foo ());
 326 bar ();
 327
 328 (remove (foo, matchdeclare),
 329  remlet (foo ()),
 330  0);
 331 0;
 332