old/rclg-util.lisp

   1 (defpackage "RCLG-UTIL"
   2   (:use :rclg :common-lisp
   3         :middleangle.cl.utilities.utilities)
   4   (:export :r-plot :r-image :r-hist :r-multiple-lines))
   5
   6 (in-package :rclg-util)
   7
   8 (def-r-call (r-plot plot :no-result sequence)
   9     (xlab "") (ylab "") (type "l"))
  10
  11 (def-r-call (r-hist hist :no-result sequence)
  12     main xlab (breaks 50) (probability t) (col "blue"))
  13
  14 (defparameter *r-default-image-colormap*
  15   (r-do-not-convert (r gray (r seq .05 .95 :by .05))))
  16
  17 (def-r-call (r-image image :no-result data)
  18     (col *r-default-image-colormap*) (xlab "") (ylab ""))
  19
  20 (defun r-multiple-lines (lines &key (x nil) (log "")
  21                          (xlab "") (ylab "") (main "") (type "o") (lwd 2)
  22                          (names nil) (legend-xy nil) (expand-top .1d0)
  23                          (expand-bottom .1d0))
  24   "Makes a plot of multiple lines (contained in lines).  The y limits
  25 are computed by expanding the minimum and maximum values in lines by
  26 expand-range.  Each line must have the same number of points.  A
  27 legend is only created if both names AND legend-xy are non-NIL."
  28   (let* ((index (1-n-vec (length (first lines))))
  29          (x (or x index)))
  30     (r-plot (first lines) :x x :log log :xlab xlab :ylab ylab :main main :type type
  31             :ylim (compute-expanded-range lines expand-top expand-bottom)
  32             :lwd lwd)
  33     ;; Plot remaining lines
  34     (let ((i 2))
  35       (dolist (l (rest lines))
  36         (r lines l :x x :type type :col i :lwd lwd :lty i :pch i)
  37         (incf i)))
  38     (when (and names legend-xy)
  39       (r legend (first legend-xy) (second legend-xy) names
  40          :col index :lwd lwd :lty (1-n-list (length names))))
  41     nil))
  42
  43 (defun compute-expanded-range (seq-of-seqs expand-top expand-bottom)
  44   (mvb (min max) (compute-range seq-of-seqs)
  45        (let ((diff (- max min)))
  46          (list (- min (* diff expand-bottom))
  47                (+ max (* diff expand-top))))))
  48
  49 (defun compute-range (seq-of-seqs)
  50   (values (extremal #'min seq-of-seqs)
  51           (extremal #'max seq-of-seqs)))
  52
  53 (defun extremal (func seq-of-seqs)
  54   (reduce func
  55           (vecmap (lambda (seq)
  56                     (reduce func seq))
  57                   seq-of-seqs)))