Tables



On Sat, 2010-04-10 at 01:39 +0100, Jaime Villate wrote:
> 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;

OK, I have fixed it and makelist2 now solves all the problems in the
list that John sent, and even some where his Table function fails:

(%i3) Table ( f(i), [i, 10, -5, -2] );
(%o3)        [f(10), f(8), f(6), f(4), f(2), f(0), f(- 2), f(- 4)]
(%i4) makelist2 ( f(i), i, 10, -5, -2 );
(%o4)        [f(10), f(8), f(6), f(4), f(2), f(0), f(- 2), f(- 4)]


(%i6) Table ( 2^x + x, [x, a, a + 2* n, n] );
                   a       n + a           2 n + a
(%o6)            [2  + a, 2      + n + a, 2        + 2 n + a]
(%i7) makelist2 ( 2^x + x, x, a, a + 2* n, n );
                   a       n + a           2 n + a
(%o7)            [2  + a, 2      + n + a, 2        + 2 n + a]


(%i8) Table ( 2^x + x, [x, a + 2*n , a, -n] );

argument '[X,[A,[2,N]],A,[N]]' does not have the correct form for an
iterator
 -- an error. To debug this try: debugmode(true);

(%i9) makelist2 ( 2^x + x, x, a + 2*n , a, -n );
                   2 n + a             n + a           a
(%o9)            [2        + 2 n + a, 2      + n + a, 2  + a]


(%i10) Table ( 1 );
(%o10)                                 1
(%i11) makelist2 ( 1 );
(%o11)                                [1]
(%i12) Table( random ( 10 ) );
(%o12)                            random(10)
(%i13) makelist2 ( random ( 10 ) );
(%o13)                                [2]

In these last two tests Table works but, regardless of Mathematicas
behavior in that case, I think that the correct thing to do is to return
a list.

Regards,
Jaime

-------------- next part --------------
(defmspec $makelist2 (x)
  (setq x (cdr x))
  (prog (n form arg a b c d lv)
     (setq n (length x))
     (if (or (< n 1) (> n 5))
         (merror (intl:gettext "makelist: must have between 1 and 5 arguments.")))
     (setq form (first x))
     (when (= n 1)
       (return
	 `((mlist simp) ,(meval `(($ev) ,@(list (list '(mquote) form)))))))
     (setq 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)))
		     (if  (= n 5)
			  (progn
			    (setq c (meval (fifth x)))
			    (setq d (meval `((mtimes) ((mplus) ,b ((mtimes) ,a -1)) ((mexpt) ,c -1))))
			    (if (not (meval `(($numberp) ,d)))
				(merror (intl:gettext "makelist: the fourth minus the third argument, divided by the fifth must be a number; found: ~M") d)
				(interval2 a c (meval `(($float) ,d)))))
			  (progn
			    (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))
			  (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 s d)
  (do ((nn i (meval `((mplus) ,s ,nn)))
       (m 0 (1+ m))
       (ans))
      ((> m d) (nreverse ans))
    (push nn ans)))