;;; lib/cli/spark.lisp --- Sparklines

 ;; based on: https://github.com/tkych/cl-spark

 ;; ref: https://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=0001OR

 ;;; Code:

 (in-package :cli/spark)

 ;; util

 (defun string-concat (&rest strings)

   (with-output-to-string (s)

     (dolist (string strings)

       (princ string s))))

 (eval-when (:compile-toplevel :load-toplevel :execute)

   (defun at-least-two-chars-p (x)

     (and (simple-vector-p x)

          (<= 2 (length x))

          (every #'characterp x))))

 (deftype %ticks ()

   '(and simple-vector (satisfies at-least-two-chars-p)))

 (declaim (type %ticks *ticks* *vticks*))

 ;;--------------------------------------------------------------------

 ;; Spark

 ;;--------------------------------------------------------------------

 ;; (vector #\▁ #\▂ #\▃ #\▄ #\▅ #\▆ #\▇ #\█)

 ;; (code-char 9600) => #\UPPER_HALF_BLOCK           <=> #\▀

 ;; (code-char 9620) => #\UPPER_ONE_EIGHTH_BLOCK     <=> #\▔

 ;; (code-char 9601) => #\LOWER_ONE_EIGHTH_BLOCK     <=> #\▁

 ;; (code-char 9602) => #\LOWER_ONE_QUARTER_BLOCK    <=> #\▂

 ;; (code-char 9603) => #\LOWER_THREE_EIGHTHS_BLOCK  <=> #\▃

 ;; (code-char 9604) => #\LOWER_HALF_BLOCK           <=> #\▄

 ;; (code-char 9605) => #\LOWER_FIVE_EIGHTHS_BLOCK   <=> #\▅

 ;; (code-char 9606) => #\LOWER_THREE_QUARTERS_BLOCK <=> #\▆

 ;; (code-char 9607) => #\LOWER_SEVEN_EIGHTHS_BLOCK  <=> #\▇

 ;; (code-char 9608) => #\FULL_BLOCK                 <=> #\█

 ;; (code-char 9135) => #\HORIZONTAL_LINE_EXTENSION  <=> #\⎯

 (defvar *ticks*

   (vector (code-char 9601) (code-char 9602) (code-char 9603)

           (code-char 9604) (code-char 9605) (code-char 9606)

           (code-char 9607) (code-char 9608))

   "

 A simple-vector of characters for representation of sparklines.

 Default is #(#\▁ #\▂ #\▃ #\▄ #\▅ #\▆ #\▇ #\█).

 Examples:

   (defvar ternary '(-1 0 1 -1 1 0 -1 1 -1))

   (spark ternary)              => \"▁▄█▁█▄▁█▁\"

   (let ((*ticks* #(#\_ #\- #\¯)))

     (spark ternary))           => \"_-¯_¯-_¯_\"

   (let ((*ticks* #(#\▄ #\⎯ #\▀)))

     (spark ternary))           => \"▄⎯▀▄▀⎯▄▀▄\"

 ")

 (defun spark (numbers &key min max key)

   (check-type numbers list)

   (check-type min     (or null real))

   (check-type max     (or null real))

   (check-type key     (or symbol function))

   (when key (setf numbers (mapcar key numbers)))

   ;; Empty data case:

   (when (null numbers)

     (RETURN-FROM spark ""))

   ;; Ensure min is the minimum number.

   (if (null min)

       (setf min (reduce #'min numbers))

       (setf numbers (mapcar (lambda (n) (max n min)) numbers)))

   ;; Ensure max is the maximum number.

   (if (null max)

       (setf max (reduce #'max numbers))

       (setf numbers (mapcar (lambda (n) (min n max)) numbers)))

   (when (< max min)

     (error "max ~S < min ~S." max min))

   (let ((unit (/ (- max min) (1- (length *ticks*)))))

     (when (zerop unit) (setf unit 1))

     (with-output-to-string (s)

       (loop :for n :in numbers

             :for nth := (floor (- n min) unit)

             :do (princ (svref *ticks* nth) s)))))

 (setf (documentation 'spark 'function) "

 Generates a sparkline string for a list of real numbers.

 Usage: SPARK <numbers> &key <min> <max> <key>

   * <numbers> ::= <list> of <real-number>

   * <min>     ::= { <null> | <real-number> }, default is NIL

   * <max>     ::= { <null> | <real-number> }, default is NIL

   * <key>     ::= <function>

   * <numbers> ~ data.

   * <min>    ~ lower bound of output.

                NIL means the minimum value of the data.

   * <max>    ~ upper bound of output.

                NIL means the maximum value of the data.

   * <key>    ~ function for preparing data.

 Examples:

   (spark '(1 0 1 0))     => \"█▁█▁\"

   (spark '(1 0 1 0 0.5)) => \"█▁█▁▄\"

   (spark '(1 0 1 0 -1))  => \"█▄█▄▁\"

   (spark '(0 30 55 80 33 150))                 => \"▁▂▃▅▂█\"

   (spark '(0 30 55 80 33 150) :min -100)       => \"▃▄▅▆▄█\"

   (spark '(0 30 55 80 33 150) :max 50)         => \"▁▅██▅█\"

   (spark '(0 30 55 80 33 150) :min 30 :max 80) => \"▁▁▄█▁█\"

   (spark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4))))

   => \"▄▆█▆▄▂▁▂▄\"

   (spark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (cos (* x pi 1/4))))

   => \"█▆▄▂▁▂▄▆█\"

  For more examples, see cl-spark/spark-test.lisp

 ")

 ;;--------------------------------------------------------------------

 ;; Vspark

 ;;--------------------------------------------------------------------

 ;; #(#\▏ #\▎ #\▍ #\▌ #\▋ #\▊ #\▉ #\█)

 ;; (code-char 9615) => #\LEFT_ONE_EIGHTH_BLOCK     <=> #\▏

 ;; (code-char 9614) => #\LEFT_ONE_QUARTER_BLOCK    <=> #\▎

 ;; (code-char 9613) => #\LEFT_THREE_EIGHTHS_BLOCK  <=> #\▍

 ;; (code-char 9612) => #\LEFT_HALF_BLOCK           <=> #\▌

 ;; (code-char 9611) => #\LEFT_FIVE_EIGHTHS_BLOCK   <=> #\▋

 ;; (code-char 9610) => #\LEFT_THREE_QUARTERS_BLOCK <=> #\▊

 ;; (code-char 9609) => #\LEFT_SEVEN_EIGHTHS_BLOCK  <=> #\▉

 ;; (code-char 9608) => #\FULL_BLOCK                <=> #\█

 ;; (code-char 9616) => #\RIGHT_HALF_BLOCK          <=> #\▐

 ;; (code-char 9621) => #\RIGHT_ONE_EIGHTH_BLOCK    <=> #\▕

 (defvar *vticks*

   (vector (code-char 9615) (code-char 9614) (code-char 9613)

           (code-char 9612) (code-char 9611) (code-char 9610)

           (code-char 9609) (code-char 9608))

   "

 A simple-vector of characters for representation of vartical

 sparklines. Default is #(#\▏ #\▎ #\▍ #\▌ #\▋ #\▊ #\▉ #\█).

 Examples:

   ;; Japan GDP growth rate, annal

   ;; see. http://data.worldbank.org/indicator/NY.GDP.MKTP.KD.ZG

   (defparameter growth-rate

    '((2007 . 2.192186) (2008 . -1.041636) (2009 . -5.5269766)

      (2010 . 4.652112) (2011 . -0.57031655) (2012 . 1.945)))

   (vspark growth-rate :key #'cdr :labels (mapcar #'car growth-rate))

   =>

   \"

        -5.5269766        -0.4374323         4.652112

        ˫---------------------+---------------------˧

   2007 ██████████████████████████████████▏

   2008 ███████████████████▊

   2009 ▏

   2010 ████████████████████████████████████████████

   2011 █████████████████████▉

   2012 █████████████████████████████████▏

   \"

   (let ((*vticks* #(#\- #\0 #\+)))

     (vspark growth-rate :key (lambda (y-r) (float-sign (cdr y-r)))

                         :labels (mapcar #'car growth-rate)

                         :size 1))

   =>

   \"

   2007 +

   2008 -

   2009 -

   2010 +

   2011 -

   2012 +

   \"

 ")

 (defun vspark (numbers &key min max key (size 50) labels title (scale? t) (newline? t))

   (check-type numbers  list)

   (check-type min      (or null real))

   (check-type max      (or null real))

   (check-type key      (or symbol function))

   (check-type size     (integer 1 *))

   (check-type labels   list)

   (when key (setf numbers (mapcar key numbers)))

   ;; Empty data case:

   (when (null numbers)

     (RETURN-FROM vspark ""))

   ;; Ensure min is the minimum number.

   (if (null min)

       (setf min (reduce #'min numbers))

       (setf numbers (mapcar (lambda (n) (max n min)) numbers)))

   ;; Ensure max is the maximum number.

   (if (null max)

       (setf max (reduce #'max numbers))

       (setf numbers (mapcar (lambda (n) (min n max)) numbers)))

   ;; Check max ~ min.

   (cond ((< max min) (error "max ~S < min ~S." max min))

         ((= max min) (incf max))        ; ensure all bars are in min.

         (t nil))

   (let ((max-lengeth-label nil))

     (when labels

       ;; Ensure num labels equals to num numbers.

       (let ((diff (- (length numbers) (length labels))))

         (cond ((plusp diff)

                ;; Add padding lacking labels not to miss data.

                (setf labels (append labels (loop :repeat diff :collect ""))))

               ((minusp diff)

                ;; Remove superfluous labels to remove redundant spaces.

                (setf labels (butlast labels (abs diff))))

               (t nil)))

       ;; Find max-lengeth-label.

       (setf max-lengeth-label

             (reduce #'max labels

                     :key (lambda (label)

                            (if (stringp label)

                                (length label)

                                (length (format nil "~A" label))))))

       ;; Canonicalize labels.

       (let* ((control-string (format nil "~~~D,,@A " max-lengeth-label)))

         (setf labels

               (mapcar (lambda (label) (format nil control-string label))

                       labels)))

       ;; Reduce size for max-lengeth-label.

       ;;  * 1 is space between label and bar

       ;;  * ensure minimum size 1

       (setf size (max 1 (- size 1 max-lengeth-label))))

     (let* ((num-content-ticks (1- (length *vticks*)))

            (unit (/ (- max min) (* size num-content-ticks)))

            (result '()))

       (when (zerop unit) (setf unit 1))

       (loop :for n :in numbers

             :for i :from 0

             :do (when labels (push (nth i labels) result))

                 (push (generate-bar n unit min max num-content-ticks)

                       result)

             :finally (setf result (nreverse result)))

       (when scale?

         (awhen (generate-scale min max size max-lengeth-label)

           (push it result)))

       (when title

         (awhen (generate-title title size max-lengeth-label)

           (push it result)))

       (if newline?

           (apply #'string-concat (push #.(format nil "~%") result))

           (string-right-trim '(#\Newline)

                              (apply #'string-concat result))))))

 (setf (documentation 'vspark 'function) "

 Generates a vartical sparkline string for a list of real numbers.

 Usage: VSPARK <numbers> &key <min> <max> <key> <size>

                              <labels> <title> <scale?> <newline?>

   * <numbers>  ::= <list> of <real-number>

   * <min>      ::= { <null> | <real-number> }, default is NIL

   * <max>      ::= { <null> | <real-number> }, default is NIL

   * <key>      ::= <function>

   * <size>     ::= <integer 1 *>, default is 50

   * <labels>   ::= <list>

   * <title>    ::= <object>, default is NIL

   * <scale?>   ::= <generalized-boolean>, default is T

   * <newline?> ::= <generalized-boolean>, default is T

   * <numbers>  ~ data.

   * <min>      ~ lower bound of output.

                  NIL means the minimum value of the data.

   * <max>      ~ upper bound of output.

                  NIL means the maximum value of the data.

   * <key>      ~ function for preparing data.

   * <size>     ~ maximum number of output columns (contains label).

   * <labels>   ~ labels for data.

   * <title>    ~ If title is too big for size, it is not printed.

   * <scale?>   ~ If T, output graph with scale for easy to see.

                  If string length of min and max is too big for size,

                  the scale is not printed.

   * <newline?> ~ If T, output graph with newlines for easy to see.

 Examples:

   ;; Life expectancy by WHO region, 2011, bothsexes

   ;; see. http://apps.who.int/gho/data/view.main.690

   (defvar life-expectancies '((\"Africa\" 56)

                               (\"Americans\" 76)

                               (\"South-East Asia\" 67)

                               (\"Europe\" 76)

                               (\"Eastern Mediterranean\" 68)

                               (\"Western Pacific\" 76)

                               (\"Global\" 70)))

   (vspark life-expectancies :key #'second :scale? nil :newline? nil)

   =>

   \"▏

   ██████████████████████████████████████████████████

   ███████████████████████████▌

   ██████████████████████████████████████████████████

   ██████████████████████████████▏

   ██████████████████████████████████████████████████

   ███████████████████████████████████▏\"

   (vspark life-expectancies :min 50 :max 80

                             :key    #'second

                             :labels (mapcar #'first life-expectancies)

                             :title \"Life Expectancy\")

   =>

   \"

                    Life Expectancy                  

                         50           65           80

                         ˫------------+-------------˧

                  Africa █████▋

               Americans ████████████████████████▎

         South-East Asia ███████████████▉

                  Europe ████████████████████████▎

   Eastern Mediterranean ████████████████▊

         Western Pacific ████████████████████████▎

                  Global ██████████████████▋

   \"

   (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))

                                :size 20)

   \"

   -1.0     0.0     1.0

   ˫--------+---------˧

   ██████████▏

   █████████████████▏

   ████████████████████

   █████████████████▏

   ██████████▏

   ██▉

   ▏

   ██▉

   █████████▉

   \"

   (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))

                                :size 10)

   =>

   \"

   -1.0   1.0

   ˫--------˧

   █████▏

   ████████▏

   ██████████

   ████████▏

   █████▏

   █▏

   ▏

   █▏

   ████▏

   \"

   (vspark '(0 1 2 3 4 5 6 7 8) :key (lambda (x) (sin (* x pi 1/4)))

                                :size 1)

   =>

   \"

   ▌

   ▊

   █

   ▊

   ▌

   ▎

   ▏

   ▎

   ▌

   \"

   For more examples, see cl-spark/spark-test.lisp

 ")

 (defun generate-bar (number unit min max num-content-ticks)

   (multiple-value-bind

         (units frac) (floor (- number min) (* unit num-content-ticks))

     (with-output-to-string (s)

       (let ((most-tick (svref *vticks* num-content-ticks)))

         (dotimes (i units) (princ most-tick s))

         (unless (= number max)

           ;; max number need not frac.

           ;; if number = max, then always frac = 0.

           (princ (svref *vticks* (floor frac unit))

                  s))

         (terpri s)))))

 (defun generate-title (title size max-lengeth-label)

   (let* ((title-string (princ-to-string title))

          (mid (floor (- (if max-lengeth-label

                             (+ 1 size max-lengeth-label)

                             size)

                         (length title-string)) 2)))

     (when (plusp mid)

       (format nil "~A~%"

               (replace (make-string (if max-lengeth-label

                                         (+ 1 size max-lengeth-label)

                                         size)

                                     :initial-element #\Space)

                        title-string :start1 mid)))))

 (defun ensure-non-double-float (x)

   (if (integerp x) x (float x 0.0)))

 (defun to-string (n)

   (princ-to-string (ensure-non-double-float n)))

 ;; (code-char 743) => #\MODIFIER_LETTER_MID_TONE_BAR              <=> #\˧

 ;; (code-char 746) => #\MODIFIER_LETTER_YANG_DEPARTING_TONE_MARK  <=> #\˫

 (defun generate-scale (min max size max-lengeth-label)

   (let* ((min-string  (to-string min))