Tables



On Fri, 2010-04-09 at 17:20 +0200, John Lapeyre wrote:
> This version of Table is not in the most recent 'release'
> of the compatibility functions. The old version was written
> in maxima and was less capable. Currently the following examples,
> mostly from Mathematica, work:
> 
> Table(1);
> Table(i^2, [i, 10]);
> block([i], i:1, Table(i,[i,1,3]));
> Table(f(i), [i, 0, 20, 2]);
> Table(x,[10]);
> Table(10*i + j, [i, 4], [j, 3]);
> Table(f(i), [i, 10, -5, -2]);
> Table(f[i], [i, 10, -5, -2]);
> Table(10* i + j, [i, 5], [j, i]);
> Table(100* i + 10* j + k, [i, 3], [j, 2], [k, 4]);
> Table(sqrt(x), [x, [1, 4, 9, 16]]);
> Table(j^(1/i), [i, [1, 2, 4]], [j, [1, 4, 9]]);
> Table(2^x + x, [x, a, a + 5* n, n]);
> apply( lambda([x,y], Table(i - j, [i, x], [j, y])), [4,5]);
> Table( block(print(i), i^i^i), [i, 3]);
> Table(Last(IntegerDigits(x, 2)), [x, [1,6,1,0,0,7,9,8]]);
> map(lambda([x],Last(IntegerDigits(x, 2))), [1,6,1,0,0,7,9,8]);
> Table(i + j, [i, 3], [j, i]);
> Table(Table(i + j, [j, i]), [i, 3]);
> apply(lambda([x,y] , Table(i - j, [i, x], [j, y])) , [4,5]);
> 
> However, the following, which is a useful example from Mathematica,
> fails with this implementation:
> 
>  Table(a[x]!, [a[x], 6]);

Here is how to obtain exactly the same results with makelist2 (attached
to this message). There are two cases that fail (identified with
xxxxxxxx) but both would be very easy to implement; on the other hand,
the last expression works.

xxxxxxxxxxxxxxxxxxxxxxxxxxxx
makelist2(i^2, i, 10);
block([i], i:1, makelist2(i,i,1,3));
makelist2(f(i), i, 0, 20, 2);
makelist2(x,10);
makelist2(makelist2(10*i + j, j, 3), i, 4);
makelist2(f(-i), i, -10, 5, 2);
makelist2(f[-i], i, -10, 5, 2);
makelist2(makelist2(10* i + j, j, i), i, 5);
makelist2(makelist2(makelist2(100* i + 10* j + k, k, 4), j, 2), i, 3);
makelist2(sqrt(x), x, [1, 4, 9, 16]);
makelist2(makelist2(j^(1/i), j, [1, 4, 9]), i, [1, 2, 4]);
xxxxxxxxxxxxxxxxxxxxxxxxxxx
apply( lambda([x,y], makelist2(makelist2(i - j, j, y), i, x)), [4,5]);
makelist2( block(print(i), i^i^i), i, 3);
makelist2(Last(IntegerDigits(x, 2)), x, [1,6,1,0,0,7,9,8]);
map(lambda([x],Last(IntegerDigits(x, 2))), [1,6,1,0,0,7,9,8]);
makelist2(makelist2(i + j, j, i), i, 3);
makelist2(makelist2(i + j, j, i), i, 3);
apply(lambda([x,y] , makelist2(makelist2(i - j, j, y), i, x)) , [4,5]);
makelist2(a[x]!, a[x], 6)

Of course, the ability to use indices different from symbols has a price
in terms of performance:

(%i47) Table(random(1.0),[10^5])$
Evaluation took 0.2600 seconds (0.2690 elapsed) using 25.260 MB.

(%i48) makelist2(random(1.0),10^5)$
Evaluation took 0.6300 seconds (0.6410 elapsed) using 46.650 MB.

Regards,
Jaime



-------------- next part --------------
(defmspec $makelist2 (x)
  (setq x (cdr x))
  (prog (n form arg a b c lv d)
     (setq n (length x))
     (if (or (< n 2) (> n 5))
         (merror (intl:gettext "makelist: must have between 2 and 5 arguments.")))
     (setq form (first x)
           arg (second x)
           lv (cond ((= n 2)
		     (setq a (meval arg))
		     (if (or (not (integerp a)) (< a 0))
			 (merror (intl:gettext "makelist: second argument must be a positive integer; found: ~M") a)
			 (interval 1 a)))
		    ((= n 3)
		     (setq a (meval (third x)))
		     (cond (($listp a)
			    (mapcar #'(lambda (u) (list '(mquote) u)) (cdr a)))
			   ((integerp a)
			    (interval 1 a))
			   (t
			    (merror (intl:gettext "makelist: third argument must be an integer or evaluate to a list; found: ~M") a))))
                    (t
		     (setq a (meval (third x)))
                     (setq b (meval (fourth x)))
                     (when (or (not (integerp (setq d (sub* b a)))) (< d -1))
		       (merror (intl:gettext "makelist: fourth argument minus third must be a nonnegative integer; found: ~M") d))
		     (if  (= n 5)
			  (if 
			   (or (not (integerp (setq c (meval (fifth x)))))
			       (< c 1))
			   (merror (intl:gettext "makelist: fifth argument must be a positive integer; found: ~M") c)
			   (interval2 a b c))
			  (interval a b)))))
     (return
       (do ((lv lv (cdr lv))
            (ans))
           ((null lv) (cons '(mlist simp) (nreverse ans)))
         (push (cond ((= n 2)
		      (meval `(($ev)
			       ,@(list (list '(mquote) form)))))
		     (t
		      (meval `(($ev)
			       ,@(list (list '(mquote) form)
				       (list '(mequal simp) arg (car lv)))))))
               ans)))))

(defun interval2 (i j s)
  (do ((nn i (add2 s nn))
       (m 0 (add2 s m))
       (k (sub* j i))
       (ans))
      ((> m k) (nreverse ans))
    (push nn ans)))