display graphs

graph.lisp

(defun decorate-for-error (fn on-error signalp)
  (cond
    (signalp fn)
    (t (lambda (&rest args)
	 (handler-case (apply fn args)
	   (error () on-error))))))

(defun domain-union (t1 t2)
  (let ((union (list 'or t1 t2)))
    (dolist (type '(integer real complex number) t)
      (when (subtypep union `(or null ,type))
	(return type)))))

(defstruct domain-guesser type)

(defun update-domain-guesser (guesser value)
  (setf (domain-guesser-type guesser)
	(domain-union (domain-guesser-type guesser)
		      (type-of value))))

(defun compute-fn (f &key from upto by (on-error nil oep))
  (loop
    :with g := (make-domain-guesser)
    :with f := (decorate-for-error f on-error (not oep))
    :for x :from from :upto upto :by by
    :for y := (funcall f x)
    :do (update-domain-guesser g y)
    :collect (cons x y) into image
    :finally (return (values (domain-guesser-type g)
			     (coerce image 'simple-vector)))))

(defgeneric graph-fn (type points &key &allow-other-keys))

(defmethod graph-fn ((type (eql 'real)) points
		     &key (width 40) (char #\#) (space #\space) (prefix ";; ")
		     &allow-other-keys)
  (let ((non-null (remove nil points :key #'cdr)))
    (flet ((colsize (key)
	     (let ((to-string (map 'list (compose #'princ-to-string key) points)))
	       (reduce #'max to-string :key #'length))))
      (let ((min-y (reduce #'min non-null :key #'cdr))
	    (max-y (reduce #'max non-null :key #'cdr))
	    (col-x (colsize #'car))
	    (col-y (colsize #'cdr)))
	(terpri)
	(fresh-line)
	(cond
	  ((eql min-y max-y)
	   (format t "Constantly ~a~%" min-y))
	  (t (let ((ratio (/ width (- max-y min-y))))
	       (flet ((project (y) (round (* ratio (- y min-y)))))
		 (loop for (x . y) across points
		       do
			  (format t "~a~v@a : ~va ~:[X~;|~] " prefix col-x x col-y y y)
			  (when y
			    (dotimes (i (1- (project y)))
			      (princ space))
			    (princ char))
			  (terpri))))))))))

(defun sigmoid (m)
  (check-type m real)
  (let* ((+m (float m))
	 (-m (float (- m)))
	 (one (float 1 (float m))))
    (lambda (x)
      (/ one (+ one (exp (* -m (float x +m))))))))

(multiple-value-call #'graph-fn
  (compute-fn #'/ :from -1 :upto 1 :by 1/10 :on-error nil)
  :space #\MIDDLE_DOT
  :char #\●
  :width 60)


;;    -1 : -1    | ··························●
;; -9/10 : -10/9 | ··························●
;;  -4/5 : -5/4  | ·························●
;; -7/10 : -10/7 | ·························●
;;  -3/5 : -5/3  | ························●
;;  -1/2 : -2    | ·······················●
;;  -2/5 : -5/2  | ·····················●
;; -3/10 : -10/3 | ···················●
;;  -1/5 : -5    | ··············●
;; -1/10 : -10   | ●
;;     0 : NIL   X 
;;  1/10 : 10    | ···························································●
;;   1/5 : 5     | ············································●
;;  3/10 : 10/3  | ·······································●
;;   2/5 : 5/2   | ·····································●
;;   1/2 : 2     | ···································●
;;   3/5 : 5/3   | ··································●
;;  7/10 : 10/7  | ·································●
;;   4/5 : 5/4   | ·································●
;;  9/10 : 10/9  | ································●
;;     1 : 1     | ································●


(multiple-value-call #'graph-fn
  (compute-fn (sigmoid 0.8) :from -6 :upto 6 :by 1/2 :on-error nil)
  :space #\-
  :char #\●
  :width 60)


;;    -6 : 0.00816257  | ●
;; -11/2 : 0.012128434 | ●
;;    -5 : 0.01798621  | ●
;;  -9/2 : 0.02659699  | ●
;;    -4 : 0.03916572  | -●
;;  -7/2 : 0.057324175 | --●
;;    -3 : 0.083172694 | ----●
;;  -5/2 : 0.11920292  | ------●
;;    -2 : 0.16798161  | ---------●
;;  -3/2 : 0.23147522  | -------------●
;;    -1 : 0.3100255   | -----------------●
;;  -1/2 : 0.40131235  | -----------------------●
;;     0 : 0.5         | -----------------------------●
;;   1/2 : 0.59868765  | -----------------------------------●
;;     1 : 0.6899745   | -----------------------------------------●
;;   3/2 : 0.7685248   | ---------------------------------------------●
;;     2 : 0.8320184   | -------------------------------------------------●
;;   5/2 : 0.880797    | ----------------------------------------------------●
;;     3 : 0.9168273   | ------------------------------------------------------●
;;   7/2 : 0.9426758   | --------------------------------------------------------●
;;     4 : 0.96083426  | ---------------------------------------------------------●
;;   9/2 : 0.973403    | ----------------------------------------------------------●
;;     5 : 0.98201376  | ----------------------------------------------------------●
;;  11/2 : 0.9878715   | -----------------------------------------------------------●
;;     6 : 0.99183744  | -----------------------------------------------------------●