4 /* Test ability of parser to recognize curly braces notation on input.
14 [set (b, c), set (a)];
17 [set (a, b, c), set ()];
20 set (set (set (set (a, b, c))));
22 {a, b, 2^{c, d, e}, mogrify ({x, y, [{}]}, {[]})};
23 set (a, b, 2^set (c, d, e), mogrify (set (x, y, [set ()]), set ([])));
25 /* 1-d output should contain curly braces.
31 string (set (a, b, set (c, d, set (e))));
73 adjoin(false,set(false));
76 adjoin(false,set(true));
79 adjoin(a, set(set()));
85 adjoin(set(a),set(a));
97 errcatch(adjoin(a,b));
109 disjoin(0,set(0,1,2));
112 disjoin(1,set(0,1,2));
115 disjoin(2,set(0,1,2));
127 set(set(a,b),set(a,b),z);
139 union(set(false),set());
145 union(set(8,8,1932));
148 union(set(a),set(a,b),set(a,b,c));
154 union(set(a),set(b),set(c));
157 union(set(set(a)),set(a))$
160 errcatch(union(set(a),set(b),x));
166 union(set(),set(set()));
169 setdifference(set(a,b),set());
172 setdifference(set(a,b),set(a));
175 setdifference(set(a,b),set(b));
178 setdifference(set(a,b),set(x));
181 setdifference(set(a,b),set());
184 setdifference(set(),set(x));
187 setdifference(set(a),set(x));
190 setdifference(set(a,b),set(x));
193 errcatch(setdifference(a,b));
196 errcatch(setdifference(set(a),b));
199 errcatch(setdifference(a,set(b)));
202 errcatch(intersection());
205 intersection(set(x));
208 intersection(set(),set());
211 intersection(set(set()),set());
214 intersection(set(set()),set(set(),set(set())));
217 intersection(set(a,b),set(a,b,c));
220 intersection(set(a,b),set(x,y,z));
223 intersection(set(a,b,c),set(a,y,x),set(z,a),set(p,q,a));
226 errcatch(intersect());
232 intersect(set(),set());
235 intersect(set(set()),set());
238 intersect(set(set()),set(set(),set(set())));
241 intersect(set(a,b),set(a,b,c));
244 intersect(set(a,b),set(x,y,z));
247 intersect(set(a,b,c),set(a,y,x),set(z,a),set(p,q,a));
251 subsetp(set(),set());
254 subsetp(set(),set(a));
257 subsetp(set(a),set())$
260 subsetp(set(),set(set()));
263 subsetp(set(set()),set(set()));
266 subsetp(set(a,b),set(a,b,c));
269 subsetp(set(a,b,c),set(a,b));
272 errcatch(subsetp(a,b));
275 errcatch(subsetp(a,set(b)));
278 errcatch(subsetp(set(a),b));
281 disjointp(set(),set());
284 disjointp(set(set()),set());
287 errcatch(disjointp(a,a+b));
290 errcatch(disjointp(set(a),a+b));
293 errcatch(disjointp(a,set(a+b)));
296 disjointp(set(a),set(b));
299 disjointp(set(b,a),set(a));
305 subset(set(3,5,8),evenp);
308 errcatch(subset(a,oddp));
311 subset(set(a,b,4,sin(x)), evenp);
317 symmdifference(set());
320 symmdifference(set(1));
323 symmdifference(set(1,2,3));
326 symmdifference(set(a),set(b),set(c));
329 symmdifference(set(a),set(a,b),set(a,b,c));
332 symmdifference(set(a,b,c),set(a,b),set(a));
335 symmdifference(set(a,b,c),set(),set(1,2,3));
338 symmdifference(set(), set(1,2,3),set(a,b,c));
341 symmdifference(set(1,2,3),set(a,b,c),set());
344 symmdifference(set(), set(1,2,3),set(a,b,c),set(),set());
347 symmdifference(set(),set());
350 symmdifference(set(set()),set());
353 symmdifference(set(i,s,t,j), set(i,n,t,p));
356 errcatch(symmdifference(a,set(b)));
359 errcatch(symmdifference(set(a),b));
362 errcatch(symmdifference(a,set(b)));
365 symmdifference(set(a,b),set(a));
369 subsetp(set(),set());
372 subsetp(set(set()),set());
375 subsetp(set(),set(set()));
378 subsetp(set(x),set(set(x)));
381 subsetp(set(a,b),set(a,y));
384 subsetp(set(a,b),set(a,b));
387 subsetp(set(set(a)),set(x,y,set(a)));
390 subsetp(set(rat(x)),set(x));
393 subsetp(set(a,a,a,x),set(a,x));
409 union(set(1932),set());
412 union(set(set(8)),set(8));
415 is(union(set(a),set(b),set(c))= set(a,b,c));
418 is(union(set(set()),set(b),set()) = set(b,set()));
421 is(union(set(x=6),set(y=3),set(z=-8)) = set(z=-8,y=3,x=6));
439 setify([false,false]);
442 setify([false,false,true]);
451 listify(set(set(a)));
460 full_listify(set(false));
463 full_listify(set(set));
466 full_listify(set(x));
469 full_listify(set(set()));
472 full_listify(set(set(false)));
475 full_listify(set(a,set(b),set(set(c))));
481 full_listify(matrix([1,2],[3,4]));
484 full_listify(f(set(a)));
487 full_listify(f(set(set(a))));
490 full_listify(f(a,set(a), [a+b]));
502 full_listify(sin(x+7));
505 full_listify(7.8e-4);
511 full_listify(set + 7);
514 full_listify(a^b + 1/set + set^z);
526 full_listify(set(a,a,b));
529 full_listify(set(a,a,b,set()));
541 subst([a=x,b=x,c=x],set(a,b,c));
544 union(set(x),set(y));
550 errcatch(intersect());
556 intersect(set(a),set(a,b));
562 elementp(false, set());
565 elementp(false, set(false));
568 elementp(set(),set());
571 elementp(set(),set(set()));
577 elementp(rat(x),set(x));
580 elementp(x,set([x]));
583 union(set(false),set(true));
586 union(setify([true,false]), set(x));
610 fullsetify(matrix([1,2],[3,4]));
613 (remfunction(f,g),0);
684 flatten(f(g(f(f(x)))));
687 flatten(f(f(g(f(x)))));
690 /* Examples from Macsyma 422 */
692 flatten([a,b,[c,[d]],e,[[f],g,h]]);
695 flatten([a,b([c]),[d]]);
698 flatten(f(f(a,b), f(c,d)));
701 flatten(f[1](f[1](a,b), f[1](c,d)));
704 elementp(false,set());
707 elementp(false,set(1));
710 elementp(false,set(false));
725 elementp(1,set(0,2));
731 adjoin(false,set(1));
734 adjoin(false,set(false));
755 cardinality(set([]));
758 cardinality(set(8,8,1932));
761 errcatch(cardinality(x+y));
782 setp(set(set(a+b=c)));
794 listify(adjoin(-1,set(2,4,6)));
797 listify(adjoin(2,set(2,4,6)));
800 listify(adjoin(3,set(2,4,6)));
803 listify(adjoin(6,set(2,4,6)));
806 listify(adjoin(7,set(2,4,6)));
821 (s : listify(permutations([0,1,2,3,4])),0);
827 (s : listify(permutations([a,b,b,a])),0);
836 (s : permutations(q),0);
839 is(cardinality(s) = length(q)!);
842 elementp([5,3,2,1,4],s);
845 elementp([5,3,2,1,0],s);
848 (p : map(setify,s),0);
851 is(p = set(setify(q)));
864 set(set(),set(x),set(y),set(x,y))$
866 errcatch(powerset(a+b=c));
869 errcatch(powerset(rat(a)));
881 powerset(set(false));
882 set(set(),set(false))$
884 powerset(set(a+b=c),1);
887 powerset(set(1,2,3),2);
888 set(set(1,2),set(1,3),set(2,3))$
890 errcatch(powerset(a+b=c));
893 is(subset(powerset(set(a,b,c,d,e)),lambda([x],is(cardinality(x)=3))) = powerset(set(a,b,c,d,e),3));
896 is(subset(powerset(set(a,b,c,d,e)),lambda([x],is(cardinality(x)=5))) =
897 powerset(set(a,b,c,d,e),5));
900 is(subset(powerset(set(a,b,c,d,e)),lambda([x],is(cardinality(x)=7))) =
901 powerset(set(a,b,c,d,e),7));
904 extremal_subset(set(),lambda([x],x^2), max);
907 extremal_subset(set(-1,0,1),lambda([x],x^2), max);
910 extremal_subset(set(1,sqrt(2),3,%pi),log, max);
913 /* quote exp because some other tests assign a value to exp,
914 and kill refuses to kill the assigned value ... (sigh)
916 extremal_subset(set(sqrt(2),sqrt(3),sqrt(5)), 'exp, max);
919 extremal_subset(set(1+%i,sqrt(2),1-%i),abs, max);
920 set(1+%i,sqrt(2),1-%i)$
922 extremal_subset(set(a,a+b,1.4b0,sqrt(28)),lambda([x],if atom(x) then 0 else 1), max);
925 /* Bug #3410: extremal_subset gives bogus result with undefined predicate */
926 errcatch(extremal_subset({a, b, c}, abs, max));
932 cartesian_product(set());
935 cartesian_product(set(a));
938 cartesian_product(set(),set(),set());
941 cartesian_product(set(a),set(b));
944 cartesian_product(set(u,n,k),set());
947 cartesian_product(set(), set(u,n,k));
950 cartesian_product(set(u,n,k),set(1));
951 set([u,1],[n,1],[k,1])$
953 cartesian_product(set(a,b),set(1,2));
954 set([a,1],[a,2],[b,1],[b,2])$
956 cartesian_product_list();
959 cartesian_product_list([]);
962 cartesian_product_list([a]);
965 cartesian_product_list([], [], []);
968 cartesian_product_list([a], [b]);
971 cartesian_product_list([u,n,k], []);
974 cartesian_product_list([], [u, n, k]);
977 cartesian_product_list([u,n,k], [1]);
980 cartesian_product_list([a, b], [1, 2]);
981 [[a,1],[a,2],[b,1],[b,2]]$
983 cartesian_product ({11, 22, 33, 11, 11, 22}, {}, {a, a, b, b});
986 cartesian_product_list([11, 22, 33, 11, 11, 22], [], [a, a, b, b]);
989 cartesian_product ({11, 22, 33, 11, 11, 22}, {u}, {a, a, b, b});
990 {[11, u, a], [11, u, b],
991 [22, u, a], [22, u, b],
992 [33, u, a], [33, u, b]};
994 cartesian_product_list([11, 22, 33, 11, 11, 22], [u], [a, a, b, b]);
995 [[11, u, a], [11, u, a], [11, u, b], [11, u, b],
996 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
997 [33, u, a], [33, u, a], [33, u, b], [33, u, b],
998 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
999 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1000 [22, u, a], [22, u, a], [22, u, b], [22, u, b]];
1002 cartesian_product ({11, 22, 33, 11, 11, 22}, {u, u, n, u, k, u}, {a, a, b, b});
1003 {[11, u, a], [11, u, b], [11, n, a], [11, n, b], [11, k, a], [11, k, b],
1004 [22, u, a], [22, u, b], [22, n, a], [22, n, b], [22, k, a], [22, k, b],
1005 [33, u, a], [33, u, b], [33, n, a], [33, n, b], [33, k, a], [33, k, b]};
1007 cartesian_product_list([11, 22, 33, 11, 11, 22], [u, u, n, u, k, u], [a, a, b, b]);
1008 [[11, u, a], [11, u, a], [11, u, b], [11, u, b],
1009 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1010 [11, n, a], [11, n, a], [11, n, b], [11, n, b],
1011 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1012 [11, k, a], [11, k, a], [11, k, b], [11, k, b],
1013 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1014 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1015 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1016 [22, n, a], [22, n, a], [22, n, b], [22, n, b],
1017 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1018 [22, k, a], [22, k, a], [22, k, b], [22, k, b],
1019 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1020 [33, u, a], [33, u, a], [33, u, b], [33, u, b],
1021 [33, u, a], [33, u, a], [33, u, b], [33, u, b],
1022 [33, n, a], [33, n, a], [33, n, b], [33, n, b],
1023 [33, u, a], [33, u, a], [33, u, b], [33, u, b],
1024 [33, k, a], [33, k, a], [33, k, b], [33, k, b],
1025 [33, u, a], [33, u, a], [33, u, b], [33, u, b],
1026 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1027 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1028 [11, n, a], [11, n, a], [11, n, b], [11, n, b],
1029 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1030 [11, k, a], [11, k, a], [11, k, b], [11, k, b],
1031 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1032 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1033 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1034 [11, n, a], [11, n, a], [11, n, b], [11, n, b],
1035 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1036 [11, k, a], [11, k, a], [11, k, b], [11, k, b],
1037 [11, u, a], [11, u, a], [11, u, b], [11, u, b],
1038 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1039 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1040 [22, n, a], [22, n, a], [22, n, b], [22, n, b],
1041 [22, u, a], [22, u, a], [22, u, b], [22, u, b],
1042 [22, k, a], [22, k, a], [22, k, b], [22, k, b],
1043 [22, u, a], [22, u, a], [22, u, b], [22, u, b]];
1045 equiv_classes(set(),"=");
1048 equiv_classes(set(),"#");
1051 equiv_classes(set(a,b,c),"=");
1052 set(set(a),set(b),set(c))$
1054 equiv_classes(set(a,b,c),"#");
1057 equiv_classes(set(1,2,3,4,5),lambda([x,y],remainder(x-y,2)=0));
1058 set(set(1,3,5),set(2,4))$
1060 partition_set(set(),evenp);
1063 partition_set(set(9),evenp);
1066 partition_set(set(2,4),evenp);
1069 partition_set(set(a,b,c),lambda([x],false));
1070 [set(a,b,c), set()]$
1072 partition_set(set(a,b,c),lambda([x],true));
1075 partition_set(set(a,b,c),lambda([x],orderlessp(x,b)));
1078 set_partitions(set());
1081 set_partitions(set(),1);
1084 set_partitions(set(),2);
1087 set_partitions(set(u,n,k),1);
1088 set(set(set(u,n,k)))$
1090 set_partitions(set(u,n,k),2);
1091 set(set(set(u),set(n,k)),set(set(n),set(u,k)), set(set(k),set(u,n)))$
1093 makelist(stirling1(i,0),i,0,5);
1096 makelist(stirling1(i,i),i,0,5);
1099 factor(sum(stirling1(3,i)*x^i,i,0,3));
1102 makelist(stirling1(i,1) - (-1)^(i-1)*(i-1)!,i,1,5);
1105 sum(stirling1(8,k),k,1,8); /* A & S 24.1.3 */
1108 sum(stirling1(3,k),k,1,3);
1111 sum(stirling1(5,k)*(-1)^(5-k),k,0,5);
1114 sum(stirling1(2,k)*(-1)^(2-k),k,0,2);
1117 (declare([a,b],integer),0);
1120 (assume(a>0,b>0),0);
1129 (forget(a>0,b>0),0);
1132 (remove(a,integer), remove(b,integer),0);
1150 stirling2(10,5) - 5 * stirling2(9,5) - stirling2(9,4);
1153 sum((-1)^(12-m) * m! * stirling2(12,m),m,0,12);
1156 /* test stirling2 simplification rules */
1161 (e : stirling2(n,0),0);
1164 makelist(subst(n=i,e) - stirling2(i,0),i,-5,5);
1165 ''(makelist(0,i,-5,5))$
1167 (e : stirling2(n,1),0);
1170 makelist(subst(n=i,e) - stirling2(i,1),i,-5,5);
1171 ''(makelist(0,i,-5,5))$
1173 (e : stirling2(n,2),0);
1176 makelist(subst(n=i,e) - stirling2(i,2),i,-5,5);
1177 ''(makelist(0,i,-5,5))$
1179 (e : stirling2(n,n),0);
1182 makelist(subst(n=i,e) - stirling2(i,i),i,-5,5);
1183 ''(makelist(0,i,-5,5))$
1185 (assume(n >=0), declare(n,integer), declare(k,integer), declare(kk,integer), assume(k >=0),0);
1245 (forget(n>=0), forget(k >=0), remove(n,integer),remove(k,integer),remove(kk,integer),0);
1251 is(cardinality(set_partitions(set())) = belln(0));
1254 is(cardinality(set_partitions(set(1))) = belln(1));
1257 is(cardinality(set_partitions(set(1,2))) = belln(2));
1260 is(cardinality(set_partitions(set(1,2,3))) = belln(3));
1264 [belln(5),belln(6)]$
1266 integer_partitions(0);
1269 integer_partitions(1);
1272 integer_partitions(2);
1275 is(cardinality(integer_partitions(25)) = 1958)$
1278 map(lambda([x], apply("+",x)), integer_partitions(25));
1281 integer_partitions(2,1);
1284 integer_partitions(2,2);
1287 integer_partitions(5,3);
1288 set([5,0,0],[4,1,0],[3,1,1],[3,2,0],[2,2,1])$
1290 multinomial_coeff(0);
1293 multinomial_coeff(1);
1296 multinomial_coeff(5);
1299 multinomial_coeff(2,3,4);
1300 (2+3+4)! / (2! * 3! * 4!)$
1302 factor(sum(multinomial_coeff(i,5-i) * x^(5-i) * y^i,i,0,5));
1305 diff((x+y+z)^9,x,3,y,6);
1306 ''(multinomial_coeff(3,6,0) * 3! * 6!)$
1308 kron_delta(false,false);
1311 /* need to have true and false sysconsts (not standard) for this to work
1312 kron_delta(false,true);
1316 kron_delta(true,true);
1322 kron_delta(a+b,a+b);
1325 kron_delta(rat(x), x);
1328 kron_delta(x,y) - kron_delta(y,x);
1331 kron_delta(x,y) / 42 - kron_delta(y,x) / 42;
1334 kron_delta(%i*x,%i*y) - kron_delta(%i*y,%i*x);
1337 kron_delta(0.42,0.42);
1340 kron_delta(0.42, 42/100);
1341 kron_delta(0.42, 42/100)$
1352 kron_delta(%i*x,%i*y);
1353 kron_delta(%i*x,%i*y)$
1355 kron_delta(%i*x,%i*x);
1358 ratsimp(kron_delta(%i*(x+1)^2,%i*(x^2+2*x+1)));
1367 kron_delta(%i*a,%i*b);
1373 (assume(a < 1, b >= 3/2),0);
1382 kron_delta(5+%i,5+%i);
1385 kron_delta(5-%i,5+%i);
1388 kron_delta(3 + %i/7,1 + %i/7);
1391 kron_delta(1 + %i/5,1 + %i/7);
1394 /* new kronecker delta tests for multivariable version */
1396 (map('forget, facts()),0);
1399 errcatch(kron_delta(x));
1405 kron_delta(sqrt(2), 1/sqrt(2), %pi);
1411 subst(a=c, kron_delta(a,b,rat(c)));
1414 kron_delta(a,b)-kron_delta(-a,-b);
1417 kron_delta(a,-b)-kron_delta(-a,b);
1420 kron_delta(a,b,-c)-kron_delta(-a,-b,c);
1423 kron_delta(-a,b,-c)-kron_delta(a,-b,c);
1426 conjugate(kron_delta(a+%i,b,c));
1427 kron_delta(a+%i,b,c)$
1429 cabs(kron_delta(a,b,23 +%i));
1430 kron_delta(a,b,23 + %i)$
1432 abs(kron_delta(l,s,s));
1435 sign(kron_delta(u,n,k,1));
1438 featurep(kron_delta(a+%i, cos(x - %i), 42/19),'integer);
1441 /* end new kronecker delta tests */
1452 every(evenp,set(2));
1455 every(evenp,set(%pi));
1458 every(evenp,set(2,4,6,%pi));
1461 every(evenp,set(1,2,4,6));
1467 every("=",[1,2],[2,1]);
1470 every("#",[a,b],[b,a]);
1485 some(oddp,set(%i,1));
1491 some("<",[a,1],[4,2]);
1494 some("=",[a,4],[a,5]);
1497 some("<=",[5,a],[6,a]);
1509 rreduce(adjoin, [1,2,3,4], set());
1512 rreduce(lambda([x,y],x),[a,b,c,d]);
1515 rreduce(lambda([x,y],y),[a,b,c,d]);
1518 rreduce(concat,["a","m","h"],"");
1521 flatten(rreduce(f,[1,2,3,4]));
1533 lreduce(lambda([x,y],x),[a,b,c,d]);
1536 lreduce(lambda([x,y],y),[a,b,c,d]);
1539 lreduce(concat,["a","m","h"],"");
1542 flatten(lreduce(f,[1,2,3,4]));
1551 xreduce('max,[0,1]);
1554 xreduce('min,[0,1]);
1569 xreduce("and",[true]);
1572 xreduce("and",[false]);
1575 xreduce("and",[true,true],false)$
1578 xreduce("or",[true]);
1581 xreduce("or",[false]);
1584 xreduce("or",[true,true],false)$
1593 xreduce("and",[true]);
1596 xreduce("and",[false]);
1599 xreduce("and",[true,true],false)$
1602 xreduce("or",[true]);
1605 xreduce("or",[false]);
1608 xreduce("or",[true,true],false)$
1611 (nary ("@@@"), declare ("@@@", nary), "@@@" ([L]) := apply (FOO, L), kill (FOO));
1614 xreduce ("@@@", [a, e, c, b, d]);
1615 FOO (a, e, c, b, d);
1617 xreduce ("@@@", {a, e, c, b, d});
1618 FOO (a, b, c, d, e);
1620 (infix ("%%%"), "%%%" (aa, bb) := BAR (aa, bb), kill (BAR));
1623 xreduce ("%%%", [a, e, c, b, d]);
1624 BAR (BAR (BAR (BAR (a, e), c), b), d);
1626 xreduce ("%%%", {a, e, c, b, d});
1627 BAR (BAR (BAR (BAR (a, b), c), d), e);
1629 makeset(i,[i],set());
1632 makeset(i,[i],[[1]]);
1635 makeset(i,[i],[[true],[false]]);
1638 makeset(i/j,[i,j],[[2,6],[6,28]]);
1644 every(is, makelist(num_partitions(i)=cardinality(integer_partitions(i)),i,1,15));
1647 num_partitions(16,'list);
1648 [1,2,3,5,7,11,15,22,30,42,56,77,101,135,176,231]$
1650 map(num_partitions,makelist(2^i,i,1,12));
1651 [2,5,22,231,8349,1741630,4351078600,365749566870782,
1652 4453575699570940947378,61847822068260244309086870983975,
1653 18116048323611252751541173214616030020513022685,
1654 6927233917602120527467409170319882882996950147283323368445315320451]$
1656 /* SF bug #2975: "number of distinct partitions gives wroing result" */
1659 makelist (num_partitions (n, 'list), n, 1, 10),
1660 makelist (makelist (num_partitions (m), m, 1, n), n, 1, 10));
1664 makelist (num_distinct_partitions (n, 'list), n, 1, 10),
1665 makelist (makelist (num_distinct_partitions (m), m, 1, n), n, 1, 10));
1668 (distinctp(l) := is(cardinality(setify(l)) = length(l)),0);
1671 (chk(n) := cardinality(subset(integer_partitions(n),distinctp)), 0);
1674 every(is, makelist(num_distinct_partitions(i)=chk(i),i,0,10));
1677 (remfunction(chk,distinctp),0);
1690 [set(1,2,4,7,14,28)]$
1693 divisors(a) = divisors(b)$
1695 every(is, makelist(divsum(i) = xreduce("+",divisors(i)),i,1,100));
1708 [moebius(3),moebius(4)]$
1710 /* See A & S 24.3.1 */
1712 every(is, makelist(xreduce("+", map(moebius, divisors(i))) = 0,i,2,100));
1715 (rprimep(i,j) := block([ ],
1716 if integerp(i) and integerp(j) then if gcd(i,j) > 1 then 0 else 1
1717 else funmake(rprimep,[i,j])),0);
1720 every(is, makeset(moebius(i*j) = moebius(i) * moebius(j) * rprimep(i,j),[i,j],
1721 cartesian_product(setify(makelist(i,i,1,15)),setify(makelist(j,j,1,15)))));
1724 /* Tests for random_permutation */
1726 (set_random_state (make_random_state (1234)), 0);
1729 (L : '[a + 1, b - 2, c * d, %pi, %e], S : setify (L), 0);
1732 [random_permutation (L), random_permutation (L), random_permutation (L)];
1733 '[[a + 1, %e, c*d, b - 2, %pi], [b - 2, a + 1, c*d, %e, %pi], [a + 1, c*d, b - 2, %e, %pi]];
1735 [random_permutation (S), random_permutation (S), random_permutation (S)];
1736 '[[c*d, b - 2, a + 1, %pi, %e], [%pi, %e, a + 1, b - 2, c*d], [b - 2, %pi, a + 1, %e, c*d]];
1738 apply ("+", makelist (if random_permutation ([1, 2, 3, 4]) = [4,2,1,3] then 1 else 0, i, 1, 1000));
1741 /* Tests for sublist_indices */
1743 sublist_indices ([], lambda([x], x='b));
1746 errcatch (sublist_indices (1, lambda([x], x='b)));
1749 sublist_indices ('[a, b, b, c, 1, 2, b, 3, b], lambda ([x], x='b));
1752 sublist_indices ('[a, b, b, c, 1, 2, b, 3, b], lambda ([x], integerp (x)));
1755 sublist_indices ('[a, b, b, c, 1, 2, b, 3, b], symbolp);
1758 sublist_indices ([true, false, false, true, true], identity);
1761 sublist_indices ([1 > 0, 1 < 0, 2 < 1, 2 > 1, 2 > 0], identity);
1764 (kill (P), P(x) := ordergreatp (x, 'm), sublist_indices ('[a, %pi, x, z, h, y, %e, 1, s], P));
1767 sublist_indices ('[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10], lambda ([x], evenp(x) and primep(x)));
1770 /* Tests for sublist (not part of nset but related functionality) */
1772 sublist ([], lambda([x], x='b));
1775 errcatch (sublist (1, lambda([x], x='b)));
1778 sublist ('[a, b, b, c, 1, 2, b, 3, b], lambda ([x], x='b));
1781 sublist ('[a, b, b, c, 1, 2, b, 3, b], lambda ([x], integerp (x)));
1784 sublist ('[a, b, b, c, 1, 2, b, 3, b], symbolp);
1787 sublist ([true, false, false, true, true], identity);
1790 sublist ([1 > 0, 1 < 0, 2 < 1, 2 > 1, 2 > 0], identity);
1791 [1 > 0, 2 > 1, 2 > 0];
1793 (kill (P), P(x) := ordergreatp (x, 'm), sublist ('[a, %pi, x, z, h, y, %e, 1, s], P));
1796 sublist ('[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10], lambda ([x], evenp(x) and primep(x)));
1799 /* from mailing list 2009-08-27 "what happened to 'ev' ?" */
1801 block ([l1: [[2,3], [3,4], [4,5]]], local(s_list),
1802 s_list(list, option) := sublist(list, lambda([x], ev(option))),
1803 s_list(l1, x[2]<4));
1806 block ([l1: [[2,3], [3,4], [4,5]]], local(s_list_indices),
1807 s_list_indices(list, option) := sublist_indices(list, lambda([x], ev(option))),
1808 s_list_indices(l1, x[2]<4));
1811 /* SF bug 2698078 set_partitions does not produce simplified sets */
1812 (l : set_partitions({1,2,3,4},3),0);
1818 map(lambda([s], xreduce('union,s)), l);
1821 map(lambda([s], xreduce('intersection,s)), l);
1824 (l : set_partitions({1,2,3,4}),0);
1830 map(lambda([s], xreduce('union,s)), l);
1833 map(lambda([s], xreduce('intersection,s)), l);
1834 set(set(), set(1,2,3,4))$
1836 (l : set_partitions(set(a,b, set(c)),2),0);
1842 map(lambda([s], xreduce('union,s)), l);
1843 set(set(a,b,set(c)))$
1845 map(lambda([s], xreduce('intersection,s)), l);
1848 (l : set_partitions(set(a,b, set(c))),0);
1854 map(lambda([s], xreduce('union,s)), l);
1855 set(set(a,b,set(c)))$
1857 map(lambda([s], xreduce('intersection,s)), l);
1858 set(set(),set(a,b,set(c)))$
1863 in_exactly_one(set());
1866 in_exactly_one(set(l), set(s), set(s));
1869 in_exactly_one(set(r), set(e), set(n), set(e), set(e));
1872 in_exactly_one(set(m), set(a), set(x), set(i,m,a));
1875 in_exactly_one(set(x),set(x), set(a,b));
1878 /* bug reported to mailing list, is(f("x") > 0) => Lisp error
1879 * following example from Matthew Gwynne 2010-04-29, thanks Matthew!
1883 /* F as specified in original example
1884 F : {{gv("CSup"),-gv("DiagF"),-gv("DisT"),-gv("ProgF"),-gv("SymA"),-gv("Via")},
1885 {-gv("CSup"),-gv("DiagF"),-gv("DisT"),-gv("ProgF"),-gv("SymA"),-gv("Via")},
1886 {gv("CSup"),-gv("DiagF"),-gv("DisT"),-gv("ProgF"),-gv("SymA"),-gv("Via")},
1887 {-gv("CSup"),-gv("DiagF"),gv("DisT"),-gv("ProgF"),gv("SymA"),-gv("Via")},
1888 {-gv("CSup"),gv("DiagF"),-gv("DisT"),-gv("ProgF"),gv("SymA"),gv("Via")},
1889 {gv("CSup"),gv("DiagF"),-gv("DisT"),-gv("ProgF"),gv("SymA"),gv("Via")},
1890 {gv("CSup"),gv("DiagF"),gv("DisT"),-gv("ProgF"),gv("SymA"),gv("Via")},
1891 {gv("CSup"),gv("DiagF"),gv("DisT"),-gv("ProgF"),gv("SymA"),gv("Via")},
1892 {-gv("CSup"),gv("DiagF"),-gv("DisT"),gv("ProgF"),gv("SymA"),gv("Via")},
1893 {gv("CSup"),gv("DiagF"),gv("DisT"),gv("ProgF"),gv("SymA"),gv("Via")},
1894 {gv("CSup"),gv("DiagF"),gv("DisT"),gv("ProgF"),gv("SymA"),gv("Via")}}, */
1895 /* here is a smaller (fewer variables) example */
1896 F : {{gv("CSup"),-gv("DiagF"),-gv("DisT")},
1897 {gv("CSup"),gv("DiagF"),gv("DisT")},
1898 {gv("CSup"),gv("DiagF"),gv("DisT")}},
1899 var_cs(F) := map(abs,apply(union,listify(F))),
1902 apply(cartesian_product,
1903 map(lambda([v],{-v,v}),listify(V)))),
1904 fullcnf2fulldnf(F) := setdifference(all_tass(var_cs(F)),F),
1905 fullcnf2fulldnf(F));
1907 {{-abs(gv("CSup")),-abs(gv("DiagF")),-abs(gv("DisT"))},{-abs(gv("CSup")),-abs(gv("DiagF")),abs(gv("DisT"))},
1908 {-abs(gv("CSup")),abs(gv("DiagF")),-abs(gv("DisT"))},{-abs(gv("CSup")),abs(gv("DiagF")),abs(gv("DisT"))},
1909 {abs(gv("CSup")),-abs(gv("DiagF")),-abs(gv("DisT"))},{abs(gv("CSup")),-abs(gv("DiagF")),abs(gv("DisT"))},
1910 {abs(gv("CSup")),abs(gv("DiagF")),-abs(gv("DisT"))},{abs(gv("CSup")),abs(gv("DiagF")),abs(gv("DisT"))}}$
1912 /* full_listify - ID: 3005820 */
1913 full_listify(rat(3/4));
1916 /* is union nary? */
1920 /* kron_delta is scalar */
1922 featurep (kron_delta, scalar);
1925 (kill (a, b), declare ([a, b], nonscalar), 0);
1928 (a * kron_delta (i, j)) . b, dotscrules=true;
1929 (a . b)*'kron_delta (i, j);
1931 /* verify that scalar declaration is really needed */
1932 (a * kran_dalta (i, j)) . b, dotscrules=true;
1933 (a * kran_dalta (i, j)) . b;
1935 /* SF bug #3049: "set should act like list" */
1937 (kill (a, b, c, d, foo, bar, baz), foo : {a, b, c, d});
1940 ([a, b] : [17, 29], bar : '{a, b, c, d});
1949 is (baz = subst (['a = a, 'b = b], foo));
1961 /* examples listed under "Bugs" in doc/info/nset.texi -- all work as expected now */
1964 {[x], [''(rat(x))]};
1966 setify ([[rat(a)], [rat(b)]]);
1967 {[''(rat(a))], [''(rat(b))]};
1969 orderlessp ([rat(a)], [rat(b)]);
1972 is ([rat(a)] = [rat(a)]);
1978 /* for the record, q, r, s example is treated in greater generality in rtest1 */
1980 (kill (q, r, s), q: x^2, r: (x + 1)^2, s: x*(x + 2), 0);
1983 [orderlessp (q, r), orderlessp (r, s), orderlessp (q, s)];
1984 [true, false, false];
1986 kron_delta (1/sqrt(2), sqrt(2)/2);
1989 sign (1/sqrt(2) - sqrt(2)/2);
1992 /* apply(op({...}), [...]) doesn't yield a (($SET) ...) expression
1993 * bug reported to mailing list 2016-10-27
1995 (S1:{1}, S2:apply(op(S1), [2]));
1998 ?eq(?caar(S1), 'set);
2001 ?eq(?caar(S2), 'set);
2004 is (S1 = apply(op(S1), args(S1)));