detecting lisp overflow



I think the fog is clearing for me.

This is my first experience of dealing
with lisp print output which is not
a readable expression. Behind the
print output is a sensible lisp expression
which lisp functions can deal with,
and I am able to ask questions of the
list output of adaptive-plot.

The code is a work in progress.

-----------------------
(%i1) load("singular.lisp");
(%o1) "c:/work2/singular.lisp"
(%i2) singular(sin(x),[x,0,1]);
The value of R1 is (NIL NIL)
(%o2) done
(%i3) singular(exp(x),[x,1000,2000]);
 overflow

The value of R1 is (T NIL)
(%o3) done
(%i4) singular(sin(x)/x,[x,-0.5,0.5]);
 singular

The value of R1 is (NIL T)
(%o4) done
--------------------------------
current code in singular.lisp:

;;;  probably can eliminate most of the contents of
;;;  the list features?
(defun $singular (fun range)
  (let (($display2d nil)
        (*plot-realpart* *plot-realpart*)
        ($plot_options $plot_options)
        features r1)
    (setf (getf features :type) "plot2d")

    ;; the range option is mandatory and provides the name of
    ;; the horizontal axis and the values of xmin and xmax.
    (let (small huge)
      ; assume not using clisp here
      (setq small (- (/ most-positive-flonum 1024)))
      (setq huge (/ most-positive-flonum 1024))
      ($set_plot_option `((mlist) $y ,small ,huge))

      (setq range (check-range range))
      (setf (getf features :xlabel) (ensure-string (second range)))
      (setf (getf features :xmin) (third range))
      (setf (getf features :xmax) (fourth range)))

    ;; create y-axis label
    (let (label)
       (setq label (coerce (mstring fun) 'string))
       (setf (getf features :ylabel) label))

    (setq *plot-realpart* ($get_plot_option '$plot_realpart 2))


    (setq r1 (singular1 fun range features))
    (show r1)
    '$done))

;;;  singular1 is designed as a simplified draw2d-like
;;;  interface to adaptive-plot.
;;;  do we really need all the stuff we pass from
;;;  $singular in the list features?

(defun singular1 (fcn range features)
  (let* ((nticks (third ($get_plot_option '$nticks)))
         (yrange ($get_plot_option '$y))
         (depth (third ($get_plot_option '$adapt_depth)))
         (rsing nil) (roflow nil) )

    (setq fcn (coerce-float-fun fcn `((mlist), (second range))))

    (let* ((x-start (coerce-float (third range)))
           (xend (coerce-float (fourth range)))
           (x-step (/ (- xend x-start) (coerce-float nticks) 2))
           (ymin (coerce-float (third yrange)))
           (ymax (coerce-float (fourth yrange)))
           (n-clipped 0) (n-non-numeric 0)
           (nn 0)
           ;; What is a good EPS value for adaptive plotting?
                                        ;(eps 1e-5)
           x-samples y-samples result)

      (declare (type flonum ymin ymax))

      ;; Divide the region into NTICKS regions.  Each region has a
      ;; start, mid and endpoint. Then adaptively sample over each of
      ;; these regions.  So it's probably a good idea not to make
      ;; NTICKS too big.  Since adaptive plotting splits the sections
      ;; in half, it's also probably not a good idea to have NTICKS be
      ;; a power of two.

      (flet ((fun (z)  (funcall fcn z)))

        (dotimes (k (1+ (* 2 nticks)))
          (let ((x (+ x-start (* k x-step))))
            (push x x-samples)
            (push (fun x) y-samples)))

        (setf x-samples (nreverse x-samples))
        (setf y-samples (nreverse y-samples))

        ;; For each sub-region, adaptively sample it.
        (do ((x-start x-samples (cddr x-start))
             (x-mid (cdr x-samples) (cddr x-mid))
             (x-end (cddr x-samples) (cddr x-end))
             (y-start y-samples (cddr y-start))
             (y-mid (cdr y-samples) (cddr y-mid))
             (y-end (cddr y-samples) (cddr y-end)))
            ((null x-end))

          ;; (setq nn (1+ nn))
          ;;   (show nn)
          ;;   (when (and *mdebug* (< nn 2))
          ;;       (show x-start x-mid x-end y-start y-mid y-end))

          ;; The sub-region is x-start to x-end, with mid-point x-mid.

          (setf result
                (adaptive-plot #'fun (car x-start) (car x-mid) (car x-end)
                                   (car y-start) (car y-mid) (car y-end)
                                   depth 1e-5))

          (when (find-if #'float-inf-p result)
             (format t "~& overflow ~%")
             (setq roflow t)
             (return 'loop-done))

          (when (find-if #'(lambda (x) (eq x T)) result)
             (format t "~& singular  ~%")
             (setq rsing t)
             (return 'loop-done)))

          (list roflow rsing)))))
----------------------------------------
Ted Woollett