share/multiadditive/rtest_opproperties.mac

   1 (kill(all), load(multiadditive), 0);
   2 0$
   3
   4 (declare(f,threadable),0);
   5 0$
   6
   7 f(a=b);
   8 f(a) = f(b)$
   9
  10 f([]);
  11 []$
  12
  13 f([a]);
  14 [f(a)]$
  15
  16 f([[a]]);
  17 [[f(a)]]$
  18
  19 f([[a], b]);
  20 [[f(a)], f(b)]$
  21
  22 f(set());
  23 set()$
  24
  25 f(set(x));
  26 set(f(x))$
  27
  28 f(set(set()));
  29 set(set())$
  30
  31 f(set(x,y));
  32 set(f(x), f(y))$
  33
  34 f(matrix());
  35 matrix()$
  36
  37 f(matrix([]));
  38 matrix([])$
  39
  40 f(matrix([1]));
  41 matrix([f(1)])$
  42
  43 is(op(f(a < b)) = f);
  44 true$
  45
  46 is(op(f(4.5)) = f);
  47 true$
  48
  49 is(args(f(4.5)) = [4.5]);
  50 true$
  51
  52 is(args(f(4.5b0, x, a=b)) = [4.5b0, x, a=b]);
  53 true$
  54
  55 is(op(f(rat(x))) = f);
  56 true$
  57
  58 is(args(f(rat(x)))= [x])$
  59 true$
  60
  61 is(args(f(false)) = [false]);
  62 true$
  63
  64 (matchdeclare(x, mapatom),0);
  65 0$
  66
  67 (tellsimpafter(f(x),5),0);
  68 0$
  69
  70 f([x,x + y]);
  71 [5,f(x+y)]$
  72
  73 (declare(g,multiadditive, f, multiadditive),0);
  74 0$
  75
  76 is(op(g(x)) = g);
  77 true$
  78
  79 is(op(g(false)) = g);
  80 true$
  81
  82 is(op(g()) = g);
  83 true$
  84
  85 is(args(g(4.5)) = [4.5])$
  86 true$
  87
  88 g(a + b);
  89 g(a) + g(b)$
  90
  91 g(a+b,c);
  92 g(a,c) + g(b,c)$
  93
  94 g(a,b+c);
  95 g(a,b) + g(a,c)$
  96
  97 g(a+b,c+d);
  98 g(a,c) + g(a,d) + g(b,c) + g(b,d)$
  99
 100 is(op(g(a*b)) = g) and is(args(g(a*b)) = [a*b]);
 101 true$
 102
 103 f([x,x + y]);
 104 [5,10]$
 105
 106 f([x*z]);
 107 [f(x*z)]$
 108
 109 (declare([f,g],multiplicative),0);
 110 0$
 111
 112 g(a+b*c);
 113 g(a) + g(b) * g(c)$
 114
 115 f(a+b*c);
 116 30$
 117
 118 f([a+b*c]);
 119 [30]$
 120
 121 f(set(a+b*c,x,x^^2));
 122 set(30,5,f(x^^2))$
 123
 124 (declare(h,involution),0);
 125 0$
 126
 127 h(h(x));
 128 x$
 129
 130 h(h(a+b));
 131 a+b$
 132
 133 h(h([]));
 134 []$
 135
 136 h(h(false));
 137 false$
 138
 139 h(h(true));
 140 true$
 141
 142 h(h(h(x)));
 143 h(x)$
 144
 145 is(op(h()) = h);
 146 true$
 147
 148 is(args(h()) = []);
 149 true$
 150
 151 is(args(h(8)) = [8]);
 152 true$
 153
 154 is(op(h(8)) = h);
 155 true$
 156
 157 h(h(f(a+b)));
 158 f(a) + f(b)$
 159
 160 9 + h(h(x));
 161 9 + x$
 162
 163 (matchfix("{{","}}"),0);
 164 0$
 165
 166 (declare("{{",multiadditive),0);
 167 0$
 168
 169 {{a+b}};
 170 {{a}} + {{b}}$
 171
 172 {{a, b + c}};
 173 {{a,b}} + {{a,c}}$
 174
 175 (declare(p, idempotent),0);
 176 0$
 177
 178 p(p());
 179 p()$
 180
 181 p(p(7));
 182 p(7)$
 183
 184 p(p(x));
 185 p(x)$
 186
 187 p(p(p(x)));
 188 p(x)$
 189
 190 (mypos(e) := block([prederror : false], sign(e) = 'pos),0);
 191 0$
 192
 193 (declare(myabs, idempotent, myabs, multiplicative),0);
 194 0$
 195
 196 (declare(myabs, evenfun),0);
 197 0$
 198
 199 (matchdeclare(e, mypos),0);
 200 0$
 201
 202 (tellsimpafter(myabs(e),e),0);
 203 0$
 204
 205 myabs(x*y);
 206 myabs(x) * myabs(y)$
 207
 208 (assume(xp > 0),0);
 209 0$
 210
 211 myabs(xp);
 212 xp$
 213
 214 myabs(xp * myabs(z));
 215 xp * myabs(z)$
 216
 217 myabs(x) - myabs(-x);
 218 0$
 219
 220 (remove(f,threadable, f, multiadditive, g, multiadditive, h,involution, p,idempotent),0);
 221 0$
 222
 223 (remove(myabs,[idempotent, multiplicative,evenfun]),0);
 224 0$
 225
 226 (forget(xp > 0),0);
 227 0$
 228
 229 (declare(f, symmetric),0);
 230 0$
 231
 232 f(x,y) - f(y,x);
 233 0$
 234
 235 29 * f(-a,b) - 29 * f(b,-a);
 236 0$
 237
 238 f(a,b,c) + f(c,b,a) + f(a,c,b) + f(a,c,b) + f(b,a,c) + f(c,b,a);
 239 6 * f(a,b,c)$
 240
 241 f(a,b) / f(b,a);
 242 1$
 243
 244 (declare(g, antisymmetric),0);
 245 0$
 246
 247 g(x,y,z) + g(x,z,y);
 248 0$
 249
 250 s * g(z,y,x) + s * g(x,y,z);
 251 0$
 252
 253 g(x,y) / g(y,x);
 254 -1$
 255
 256 (remove(f, symmetric, g, antisymmetric),0);
 257 0$
 258
 259 (define_opproperty (identity, simplify_identity),
 260  simplify_identity(e) := first(e),
 261  kill(f, g),
 262  declare ([f, g], identity));
 263 done;
 264
 265 f(t + 10);
 266 t + 10;
 267
 268 g(3*u) - f(2*u);
 269 u;
 270
 271 /* same as identity property, but with lambda expression */
 272 define_opproperty (identity1, lambda ([e], first(e)));
 273 done;
 274
 275 (kill (f1, g1), declare ([f1, g1], identity1));
 276 done;
 277
 278 [f1(t + 10), g1(3*u) - f1(2*u)];
 279 [t + 10, u];
 280
 281 /* tests for bilinear declaration */
 282
 283 kill("foo");
 284 done;
 285
 286 (kill(foo),
 287  infix(foo),
 288  if not member (bilinear, opproperties) then load (bilinear),
 289  declare ("foo", bilinear));
 290 done;
 291
 292 (kill(a, b, c, d, e, f),
 293  (a + b) foo (c + d));
 294 a foo c + a foo d + b foo c + b foo d;
 295
 296 (%pi*a - c/2) foo (d - 2*e - f^^2);
 297 %pi*(a foo d) - 2*%pi*(a foo e) - %pi*(a foo (f^^2)) - (c foo d)/2 + (c foo e) + (c foo (f^^2))/2;
 298
 299 declare ("foo", symmetric);
 300 done;
 301
 302 b foo a;
 303 a foo b;
 304
 305 declare ("foo", scalar);
 306 done;
 307
 308 ((a foo b)*c) foo ((c foo d)*e);
 309 (a foo b)*(c foo d)*(c foo e);
 310
 311 /* verify later declarations don't interfere with earlier ones */
 312
 313 (%pi*a - c/2) foo (d - 2*e - f^^2);
 314 %pi*(a foo d) - 2*%pi*(a foo e) - %pi*(a foo (f^^2)) - (c foo d)/2 + (c foo e) + (c foo (f^^2))/2;
 315
 316 b foo a;
 317 a foo b;
 318
 319 /* bilinear, symmetric, scalar all together */
 320
 321 (c/(a foo f)) foo ((c foo (a + b))*e);
 322 ((a foo c) + (b foo c))*(c foo e)/(a foo f);
 323
 324 (3*a - c/(a foo f)) foo ((c foo (a + b))*e);
 325 3*((a foo c) + (b foo c))*(a foo e) - ((a foo c) + (b foo c))*(c foo e)/(a foo f);
 326
 327 (3*a + c/(a foo f)) foo (d + (c foo (a + b))*e);
 328 3*(a foo d) + (c foo d)/(a foo f) + 3*((a foo c) + (b foo c))*(a foo e) + ((a foo c) + (b foo c))*(c foo e)/(a foo f);
 329
 330 (kill (S), declare (S, scalar));
 331 done;
 332
 333 /* I want to test 1234 + 5*(3*a - c/(a foo f)) foo (d - (c foo (a + b))*e)
 334  * Work up to it step by step.
 335  */
 336
 337 /* F */
 338 (3*a) foo d;
 339 3*(a foo d);
 340
 341 /* O */
 342 (3*a) foo (S*((c foo (a + b))*e));
 343 3*S*(c foo a + c foo b)*(a foo e);
 344
 345 /* F + O */
 346 (3*a) foo (d + S*((c foo (a + b))*e));
 347 3*(a foo d) + 3*S*(c foo a + c foo b)*(a foo e);
 348
 349 /* I */
 350 (S*(c/(a foo f))) foo d;
 351 S*(c foo d)/(a foo f);
 352
 353 /* L */
 354 (S*(c/(a foo f))) foo (S*((c foo (a + b))*e));
 355 S^2*(c foo a + c foo b)*(c foo e)/(a foo f);
 356
 357 /* I + L */
 358
 359 (S*(c/(a foo f))) foo (d + (S*((c foo (a + b))*e)));
 360 S*(c foo d)/(a foo f) + S^2*(c foo a + c foo b)*(c foo e)/(a foo f);
 361
 362 /* F + O + I + L */
 363
 364 (3*a + (S*(c/(a foo f)))) foo (d + (S*((c foo (a + b))*e)));
 365 3*(a foo d) + 3*S*(c foo a + c foo b)*(a foo e) + S*(c foo d)/(a foo f) + S^2*(c foo a + c foo b)*(c foo e)/(a foo f);
 366
 367 /* same as preceding, but with fewer parentheses */
 368 (3*a + S*c/(a foo f)) foo (d + S*(c foo (a + b))*e);
 369 3*(a foo d) + 3*S*(c foo a + c foo b)*(a foo e) + S*(c foo d)/(a foo f) + S^2*(c foo a + c foo b)*(c foo e)/(a foo f);
 370
 371 /* same as preceding, now let S = -1 */
 372 subst (S = -1, (3*a + S*c/(a foo f)) foo (d + S*(c foo (a + b))*e));
 373 ''(myfoilsubst : subst (S = -1, 3*(a foo d) + 3*S*(c foo a + c foo b)*(a foo e) + S*(c foo d)/(a foo f) + S^2*(c foo a + c foo b)*(c foo e)/(a foo f)));
 374
 375 /* same as preceding, rewrite with minus signs;
 376  * test via ratsimp since I can't get simplified forms to agree
 377  */
 378 ratsimp ((3*a - c/(a foo f)) foo (d - (c foo (a + b))*e) - myfoilsubst);
 379 0;
 380
 381 /* what I was trying to test to start with */
 382 ratsimp (1234 + 5*(3*a - c/(a foo f)) foo (d - (c foo (a + b))*e) - (1234 + 5*myfoilsubst));
 383 0;