Mercurial > core / lisp/lib/cli/spark.lisp
| changeset 211: |
f9e0d78b7458 |
| parent: |
cae8da4b1415
|
| author: |
Richard Westhaver <ellis@rwest.io> |
| date: |
Sat, 17 Feb 2024 21:01:56 -0500 |
| permissions: |
-rw-r--r-- |
| description: |
refreshing memory on cli and rt |
1 ;;; lib/cli/spark.lisp --- Sparklines 3 ;; based on: https://github.com/tkych/cl-spark 5 ;; ref: https://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=0001OR 8 (in-package :cli/spark) 11 (defun string-concat (&rest strings) 12 (with-output-to-string (s) 13 (dolist (string strings) 16 (eval-when (:compile-toplevel :load-toplevel :execute) 17 (defun at-least-two-chars-p (x) 18 (and (simple-vector-p x) 20 (every #'characterp x)))) 23 '(and simple-vector (satisfies at-least-two-chars-p))) 25 (declaim (type %ticks *ticks* *vticks*)) 27 ;;-------------------------------------------------------------------- 29 ;;-------------------------------------------------------------------- 30 ;; (vector #\▁ #\▂ #\▃ #\▄ #\▅ #\▆ #\▇ #\█) 32 ;; (code-char 9600) => #\UPPER_HALF_BLOCK <=> #\▀ 33 ;; (code-char 9620) => #\UPPER_ONE_EIGHTH_BLOCK <=> #\▔ 34 ;; (code-char 9601) => #\LOWER_ONE_EIGHTH_BLOCK <=> #\▁ 35 ;; (code-char 9602) => #\LOWER_ONE_QUARTER_BLOCK <=> #\▂ 36 ;; (code-char 9603) => #\LOWER_THREE_EIGHTHS_BLOCK <=> #\▃ 37 ;; (code-char 9604) => #\LOWER_HALF_BLOCK <=> #\▄ 38 ;; (code-char 9605) => #\LOWER_FIVE_EIGHTHS_BLOCK <=> #\▅ 39 ;; (code-char 9606) => #\LOWER_THREE_QUARTERS_BLOCK <=> #\▆ 40 ;; (code-char 9607) => #\LOWER_SEVEN_EIGHTHS_BLOCK <=> #\▇ 41 ;; (code-char 9608) => #\FULL_BLOCK <=> #\█ 42 ;; (code-char 9135) => #\HORIZONTAL_LINE_EXTENSION <=> #\⎯ 45 (vector (code-char 9601) (code-char 9602) (code-char 9603) 46 (code-char 9604) (code-char 9605) (code-char 9606) 47 (code-char 9607) (code-char 9608)) 49 A simple-vector of characters for representation of sparklines. 50 Default is #(#\▁ #\▂ #\▃ #\▄ #\▅ #\▆ #\▇ #\█). 54 (defvar ternary '(-1 0 1 -1 1 0 -1 1 -1)) 56 (spark ternary) => \"▁▄█▁█▄▁█▁\" 58 (let ((*ticks* #(#\_ #\- #\¯))) 59 (spark ternary)) => \"_-¯_¯-_¯_\" 61 (let ((*ticks* #(#\▄ #\⎯ #\▀))) 62 (spark ternary)) => \"▄⎯▀▄▀⎯▄▀▄\" 66 (defun spark (numbers &key min max key) 67 (check-type numbers list) 68 (check-type min (or null real)) 69 (check-type max (or null real)) 70 (check-type key (or symbol function)) 71 (when key (setf numbers (mapcar key numbers))) 75 (RETURN-FROM spark "")) 77 ;; Ensure min is the minimum number. 79 (setf min (reduce #'min numbers)) 80 (setf numbers (mapcar (lambda (n) (max n min)) numbers))) 82 ;; Ensure max is the maximum number. 84 (setf max (reduce #'max numbers)) 85 (setf numbers (mapcar (lambda (n) (min n max)) numbers))) 88 (error "max ~S < min ~S." max min)) 90 (let ((unit (/ (- max min) (1- (length *ticks*))))) 91 (when (zerop unit) (setf unit 1)) 92 (with-output-to-string (s) 93 (loop :for n :in numbers 94 :for nth := (floor (- n min) unit) 95 :do (princ (svref *ticks* nth) s))))) 98 (setf (documentation 'spark 'function) " 99 Generates a sparkline string for a list of real numbers. 101 Usage: SPARK <numbers> &key <min> <max> <key> 103 * <numbers> ::= <list> of <real-number> 104 * <min> ::= { <null> | <real-number> }, default is NIL 105 * <max> ::= { <null> | <real-number> }, default is NIL 106 * <key> ::= <function> 109 * <min> ~ lower bound of output. 110 NIL means the minimum value of the data. 111 * <max> ~ upper bound of output. 112 NIL means the maximum value of the data. 113 * <key> ~ function for preparing data. 117 (spark '(1 0 1 0)) => \"█▁█▁\" 118 (spark '(1 0 1 0 0.5)) => \"█▁█▁▄\" 119 (spark '(1 0 1 0 -1)) => \"█▄█▄▁\" 121 (spark '(0 30 55 80 33 150)) => \"▁▂▃▅▂█\" 122 (spark '(0 30 55 80 33 150) :min -100) => \"▃▄▅▆▄█\" 123 (spark '(0 30 55 80 33 150) :max 50) => \"▁▅██▅█\" 124 (spark '(0 30 55 80 33 150) :min 30 :max 80) => \"▁▁▄█▁█\" 126 (spark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))) 128 (spark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (cos (* x pi 1/4)))) 131 For more examples, see cl-spark/spark-test.lisp 135 ;;-------------------------------------------------------------------- 137 ;;-------------------------------------------------------------------- 138 ;; #(#\▏ #\▎ #\▍ #\▌ #\▋ #\▊ #\▉ #\█) 140 ;; (code-char 9615) => #\LEFT_ONE_EIGHTH_BLOCK <=> #\▏ 141 ;; (code-char 9614) => #\LEFT_ONE_QUARTER_BLOCK <=> #\▎ 142 ;; (code-char 9613) => #\LEFT_THREE_EIGHTHS_BLOCK <=> #\▍ 143 ;; (code-char 9612) => #\LEFT_HALF_BLOCK <=> #\▌ 144 ;; (code-char 9611) => #\LEFT_FIVE_EIGHTHS_BLOCK <=> #\▋ 145 ;; (code-char 9610) => #\LEFT_THREE_QUARTERS_BLOCK <=> #\▊ 146 ;; (code-char 9609) => #\LEFT_SEVEN_EIGHTHS_BLOCK <=> #\▉ 147 ;; (code-char 9608) => #\FULL_BLOCK <=> #\█ 148 ;; (code-char 9616) => #\RIGHT_HALF_BLOCK <=> #\▐ 149 ;; (code-char 9621) => #\RIGHT_ONE_EIGHTH_BLOCK <=> #\▕ 152 (vector (code-char 9615) (code-char 9614) (code-char 9613) 153 (code-char 9612) (code-char 9611) (code-char 9610) 154 (code-char 9609) (code-char 9608)) 156 A simple-vector of characters for representation of vartical 157 sparklines. Default is #(#\▏ #\▎ #\▍ #\▌ #\▋ #\▊ #\▉ #\█). 161 ;; Japan GDP growth rate, annal 162 ;; see. http://data.worldbank.org/indicator/NY.GDP.MKTP.KD.ZG 163 (defparameter growth-rate 164 '((2007 . 2.192186) (2008 . -1.041636) (2009 . -5.5269766) 165 (2010 . 4.652112) (2011 . -0.57031655) (2012 . 1.945))) 167 (vspark growth-rate :key #'cdr :labels (mapcar #'car growth-rate)) 170 -5.5269766 -0.4374323 4.652112 171 ˫---------------------+---------------------˧ 172 2007 ██████████████████████████████████▏ 173 2008 ███████████████████▊ 175 2010 ████████████████████████████████████████████ 176 2011 █████████████████████▉ 177 2012 █████████████████████████████████▏ 180 (let ((*vticks* #(#\- #\0 #\+))) 181 (vspark growth-rate :key (lambda (y-r) (float-sign (cdr y-r))) 182 :labels (mapcar #'car growth-rate) 195 (defun vspark (numbers &key min max key (size 50) labels title (scale? t) (newline? t)) 196 (check-type numbers list) 197 (check-type min (or null real)) 198 (check-type max (or null real)) 199 (check-type key (or symbol function)) 200 (check-type size (integer 1 *)) 201 (check-type labels list) 203 (when key (setf numbers (mapcar key numbers))) 207 (RETURN-FROM vspark "")) 209 ;; Ensure min is the minimum number. 211 (setf min (reduce #'min numbers)) 212 (setf numbers (mapcar (lambda (n) (max n min)) numbers))) 214 ;; Ensure max is the maximum number. 216 (setf max (reduce #'max numbers)) 217 (setf numbers (mapcar (lambda (n) (min n max)) numbers))) 220 (cond ((< max min) (error "max ~S < min ~S." max min)) 221 ((= max min) (incf max)) ; ensure all bars are in min. 224 (let ((max-lengeth-label nil)) 226 ;; Ensure num labels equals to num numbers. 227 (let ((diff (- (length numbers) (length labels)))) 229 ;; Add padding lacking labels not to miss data. 230 (setf labels (append labels (loop :repeat diff :collect "")))) 232 ;; Remove superfluous labels to remove redundant spaces. 233 (setf labels (butlast labels (abs diff)))) 235 ;; Find max-lengeth-label. 236 (setf max-lengeth-label 241 (length (format nil "~A" label)))))) 242 ;; Canonicalize labels. 243 (let* ((control-string (format nil "~~~D,,@A " max-lengeth-label))) 245 (mapcar (lambda (label) (format nil control-string label)) 247 ;; Reduce size for max-lengeth-label. 248 ;; * 1 is space between label and bar 249 ;; * ensure minimum size 1 250 (setf size (max 1 (- size 1 max-lengeth-label)))) 252 (let* ((num-content-ticks (1- (length *vticks*))) 253 (unit (/ (- max min) (* size num-content-ticks))) 255 (when (zerop unit) (setf unit 1)) 257 (loop :for n :in numbers 259 :do (when labels (push (nth i labels) result)) 260 (push (generate-bar n unit min max num-content-ticks) 262 :finally (setf result (nreverse result))) 265 (awhen (generate-scale min max size max-lengeth-label) 269 (awhen (generate-title title size max-lengeth-label) 273 (apply #'string-concat (push #.(format nil "~%") result)) 274 (string-right-trim '(#\Newline) 275 (apply #'string-concat result)))))) 278 (setf (documentation 'vspark 'function) " 279 Generates a vartical sparkline string for a list of real numbers. 281 Usage: VSPARK <numbers> &key <min> <max> <key> <size> 282 <labels> <title> <scale?> <newline?> 284 * <numbers> ::= <list> of <real-number> 285 * <min> ::= { <null> | <real-number> }, default is NIL 286 * <max> ::= { <null> | <real-number> }, default is NIL 287 * <key> ::= <function> 288 * <size> ::= <integer 1 *>, default is 50 289 * <labels> ::= <list> 290 * <title> ::= <object>, default is NIL 291 * <scale?> ::= <generalized-boolean>, default is T 292 * <newline?> ::= <generalized-boolean>, default is T 295 * <min> ~ lower bound of output. 296 NIL means the minimum value of the data. 297 * <max> ~ upper bound of output. 298 NIL means the maximum value of the data. 299 * <key> ~ function for preparing data. 300 * <size> ~ maximum number of output columns (contains label). 301 * <labels> ~ labels for data. 302 * <title> ~ If title is too big for size, it is not printed. 303 * <scale?> ~ If T, output graph with scale for easy to see. 304 If string length of min and max is too big for size, 305 the scale is not printed. 306 * <newline?> ~ If T, output graph with newlines for easy to see. 311 ;; Life expectancy by WHO region, 2011, bothsexes 312 ;; see. http://apps.who.int/gho/data/view.main.690 313 (defvar life-expectancies '((\"Africa\" 56) 315 (\"South-East Asia\" 67) 317 (\"Eastern Mediterranean\" 68) 318 (\"Western Pacific\" 76) 321 (vspark life-expectancies :key #'second :scale? nil :newline? nil) 324 ██████████████████████████████████████████████████ 325 ███████████████████████████▌ 326 ██████████████████████████████████████████████████ 327 ██████████████████████████████▏ 328 ██████████████████████████████████████████████████ 329 ███████████████████████████████████▏\" 331 (vspark life-expectancies :min 50 :max 80 333 :labels (mapcar #'first life-expectancies) 334 :title \"Life Expectancy\") 339 ˫------------+-------------˧ 341 Americans ████████████████████████▎ 342 South-East Asia ███████████████▉ 343 Europe ████████████████████████▎ 344 Eastern Mediterranean ████████████████▊ 345 Western Pacific ████████████████████████▎ 346 Global ██████████████████▋ 349 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 365 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 382 (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))) 397 For more examples, see cl-spark/spark-test.lisp 400 (defun generate-bar (number unit min max num-content-ticks) 402 (units frac) (floor (- number min) (* unit num-content-ticks)) 403 (with-output-to-string (s) 404 (let ((most-tick (svref *vticks* num-content-ticks))) 405 (dotimes (i units) (princ most-tick s)) 406 (unless (= number max) 407 ;; max number need not frac. 408 ;; if number = max, then always frac = 0. 409 (princ (svref *vticks* (floor frac unit)) 413 (defun generate-title (title size max-lengeth-label) 414 (let* ((title-string (princ-to-string title)) 415 (mid (floor (- (if max-lengeth-label 416 (+ 1 size max-lengeth-label) 418 (length title-string)) 2))) 421 (replace (make-string (if max-lengeth-label 422 (+ 1 size max-lengeth-label) 424 :initial-element #\Space) 425 title-string :start1 mid))))) 427 (defun ensure-non-double-float (x) 428 (if (integerp x) x (float x 0.0))) 431 (princ-to-string (ensure-non-double-float n))) 433 ;; (code-char 743) => #\MODIFIER_LETTER_MID_TONE_BAR <=> #\˧ 434 ;; (code-char 746) => #\MODIFIER_LETTER_YANG_DEPARTING_TONE_MARK <=> #\˫ 435 (defun generate-scale (min max size max-lengeth-label) 436 (let* ((min-string (to-string min)) 437 (max-string (to-string max)) 438 (num-padding (- size (length min-string) (length max-string)))) 439 (when (plusp num-padding) 440 (let* ((mid (/ (+ max min) 2)) 441 (mid-string (to-string mid)) 442 (num-indent (aif max-lengeth-label (1+ it) 0))) 443 (if (and (< (length mid-string) num-padding) 446 ;; A. mid exist case: 447 (format nil "~V,0T~V<~A~;~A~;~A~>~ 448 ~%~V,0T~V,,,'-<~A~;~A~;~A~>~%" 449 num-indent size min-string mid-string max-string 450 num-indent size #.(code-char 747) #\+ #.(code-char 743)) 451 ;; B. no mid exist case: 452 (format nil "~V,0T~V<~A~;~A~>~ 453 ~%~V,0T~V,,,'-<~A~;~A~>~%" 454 num-indent size min-string max-string 455 num-indent size #.(code-char 747) #.(code-char 743)))))))
