Last active
August 29, 2022 22:18
-
-
Save christophejunke/ef695435bfd3d27d87e8d99296b864eb to your computer and use it in GitHub Desktop.
display graphs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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 | -----------------------------------------------------------● |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment