Simple SparkLine Generator in Clojure 3

Posted by jonathan on February 28, 2008

The following is a little SparkLine generator written in the Clojure language.

There’s an example in the code that covers the usage.

Please post a comment if you find it useful, or have suggestions.

I have since updated this program. It should be pixel-perfect, and much more resistant to bad data.

Thanks Rich, for the comment below. I have updated the main function to use destructuring bind on the function parameters.

SparkLine

; Sparkline Generator
; Copyright (c) Jonathan A Watmough. All Rights Reserved.
;
; The use and distribution terms for this software are covered by the
; Common Public License 1.0 (http://opensource.org/licenses/cpl1.0.txt).
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license. Do not remove this notice.
 
(defn 
#^{ :doc "Scale a list of numeric 'values' to a max height of 'height'."
    :private true}
      scale-values ([values height]
  (let [highest (apply max (filter identity values))]
    (map #(if % (dec (- height (/ (* % (- height 3)) highest))) nil) values))))
 
(defn 
#^{:doc "Make a Win-style java.awt.image.BufferedImage of 'width' x 'height'."}
      make-buffered-image ([width height]
  (let [image-type (. java.awt.image.BufferedImage TYPE_3BYTE_BGR)]
    (new java.awt.image.BufferedImage width height image-type))))
 
(defn 
#^{:doc "Create pixel-accurate sparkline bitmap graphic from {:width :height :values :marker}. :marker=-1 for last entry."}
      make-sparkline ([{ w :width h :height v :values m :marker }]
  (let [v       (scale-values v h)
        bitmap  (make-buffered-image w h)
        g       (. bitmap (getGraphics))
        m       (if (and m (< m 0)) (+ m (count v)) m)
        step    (/ (- w 3) (- (count v) 1))]
    (do (doto g (setColor (. java.awt.Color white))
                (fillRect 0 0 w h)
                (setColor (. java.awt.Color gray)))
        (dotimes idx (count v)
          (let [x-pos    (inc (* idx step))
                prev-val (nth v idx)
                this-val (nth v (inc idx))]
            (when (and prev-val this-val)
                  (. g (drawLine x-pos (dec prev-val) (+ x-pos step) (dec this-val))))))
        ; Draw marker if present and return the sparkline bitmap
        (when (and m (nth v m))
            (let [bx  (* m step)
                  by  (- (nth v m) 2)]
              (doto g (setColor (. java.awt.Color red))
                      (fillOval bx by 2 2))))
        (. g (dispose))
        bitmap))))
 
(defn 
#^{:doc "Test code for sparklines graphic generator."}
      test-sparklines []
  (let [spark (make-sparkline {:width 100 :height 30 
                              :values [1 2 10 8 2 5 8 12 14 3 4 15]
                              :marker -1
                              })
        icon  (new javax.swing.ImageIcon spark)]
    (doto (new javax.swing.JFrame "Sparkline Test")
      (add (new javax.swing.JLabel icon))
      (pack)
      (setVisible true))))
 
(test-sparklines)

Prototyping Code in Clojure - A Simple Audio Displaying App 3

Posted by jonathan on February 24, 2008

Clojure is a new Lisp, created by Rich Hickey. The primary portal to all things Clojure is here on Source Forge.

I just got through prototyping a little app that takes in sound samples, and displays a stacked series of frequency spectra, and a 2d ’sonogram’ type display. The running app looks like:

Frequency Spectra in Clojure

Not so easy to see, but the lower part of the screen is a 2d sonogram.

With the help of the KJ DSP library (which has a homepage on SourceForge), the app runs in real-ish time, and does a creditable job of displaying frequency spectra.

I hoped to try and get it running on Windows too, but the Java sampling api under Windows has defeated me for now. The code below works on a Mac Book Pro. Nothing else is tested.

The code is split into two main parts, which deal with getting sound samples, and with displaying a simple gui. I’ve reproduced the code below.

Note that this code isn’t complete, since I have a separate jar KJ.JAR which has the FFT code, and a NetBeans front end that provides isometric.gui (controls: start, stop, test:JButton, inputs:JCombobox, isopanel, sonopanel:JPanel).

; The following file is written by Jonathan Watmough
; This file is free for any use, providing this notice is preserved.
;
; This file works with the sound system on a Mac Book Pro.
; Nothing else is tested.
 
; imports
(import '(java.lang Thread))
(import '(java.nio ByteBuffer ShortBuffer))
(import '(javax.sound.sampled DataLine AudioSystem LineEvent LineListener AudioFormat))
;(import '(javax.sound.sampled.DataLine Info))
 
; supported audio filetypes
(def filetypes (. AudioSystem (getAudioFileTypes)))
(print (str "Supported audio: " (seq filetypes)))
(newline)
 
; supported mixers
(def mixer-info (seq (. AudioSystem (getMixerInfo))))
 
; get mixer-info, name, description of each mixer
(def mixer-info-list
  (map #(let [m %] { :mixer-info m 
                     :name (. m (getName))
                     :description (. m (getDescription))}) mixer-info))
 
; 
;---- user interface ----
 
; create a desired pcm audio format
; -> float sampleRate, int sampleSizeInBits, int channels, boolean signed, boolean bigEndian
(def format (new AudioFormat 44100 16 1 false true))
(def buffer-size (* 22050 2))   ; 44k = 1/2 sec x 2 bytes / sample mono
 
; set a ref for the open line
(def input (ref nil))
 
; from each mixer-info, get the target data lines (inputs)
(def input-lines
  (mapcat #(let [mix-info (:mixer-info %)
                 mixer    (. AudioSystem (getMixer mix-info))
                 targets  (. mixer (getTargetLineInfo))]
              (map #(let [target-info     %
                          get-line    (fn[] 
                                      (let [mixer (. AudioSystem (getMixer mix-info))
                                            line  (. mixer (getLine target-info))]
                                      (do (. line (open format buffer-size))
                                          (. line (start))
                                          (sync nil
                                            ; ### should close old input - When @input ...
                                            (set input (. mixer (getLine target-info)))
                                            (. @input (start))))))
                          mixer-name  (. mix-info (getName))]
                      {:mixer-name  mixer-name
                       :get-line    get-line}) targets)) mixer-info-list))
 
; get a set of samples for level-checking in ui
; assume we are dealing with signed 16 bit samples (short = 2 x bytes)
; may want to sync on 'input'
(defn get-inst-samples ([num-samples]
  (do 
    (if (not (. @input (isOpen)))
      (. @input (open format buffer-size)))
    (if (not (. @input (isRunning)))
      (. @input (start)))
    (let [bytes   (make-array (. Byte TYPE) (* 2 num-samples))
          bcount  (. @input (read bytes 0 (* 2 num-samples)))
          bbyte   (. ByteBuffer (wrap bytes))
          bshort  (. bbyte (asShortBuffer))
          shorts  (make-array (. Short TYPE) num-samples)
          ]
      (do (print "Read: " (str bcount) " bytes.")
          (newline)
          (. *out* (flush))
          (. bshort (get shorts 0 num-samples))
          shorts)))))
 
(comment
 
; "Built-in Microphone"  <-- we'll use this
 
; get the mixer info for the mic
(def mic-mixer-info
  (:mixer-info (first (filter #(= "Built-in Microphone" (:name %)) mixer-info-list))))
 
; get the built in mic mixer
(def mic (. AudioSystem (getMixer mic-mixer-info)))
 
; get the supported source and target lines for the mixer
(def sources (seq (. mic (getSourceLineInfo))))   ; nil
(def targets (seq (. mic (getTargetLineInfo))))   ; (interface TargetDataLine supporting 72 audio formats)
 
; get a target line
(def line-info (first targets))
(def mic-line (. mic (getLine line-info)))
 
; add a line listener for events on the line
(. mic-line (addLineListener
              (implement [LineListener]
                (update [evt]
                  (do (print "Event: " (. evt (getType)))
                      (newline)
                      (. *out* (flush)))))))
 
; check if we can get this format from the built in mic
(. mic-line (open format buffer-size))
 
; start the input
(. mic-line (start))  

; try looping and counting available samples
(dotimes i 100
  (print "Available data: " (. mic-line (available)))
  (newline)
  (. *out* (flush))
  (let [buffer  (make-array (. Byte TYPE) 2048)
        bcount  (. mic-line (read buffer 0 2048))
        bbyte   (. ByteBuffer (wrap buffer))
        bshort  (. bbyte (asShortBuffer))
        ]
    (print "Read: " bcount " bytes. Buffer state:" (str bshort))
    (print " ... Converted to short: "  (str (. bshort (get 0))))
    (newline))
  (. Thread (sleep 20)))   ; 1 milli sleep = 1/1000 of a sec = 44 samples
 
; stop the input
;(. mic-line (stop))
 
; close mic
;(. mic-line (close))
 
)
 

GUI Code
The following is the GUI part of the code. It generates some functions that draw over a couple of passed in controls. Create a simple GUI interface, then pass a couple of labels.

; osx sampling code
(load-file "iso-source.clj")
 
; load in the windows sampling code
;(load-file "iso-source-win.clj")
 
; graphics code
(import '(java.awt Color Polygon))
(import '(java.awt.event ActionListener))
(import '(java.awt.image BufferedImage VolatileImage))
(import '(javax.swing JLabel JFrame ImageIcon))
(import '(java.lang Thread))
(import '(java.util.concurrent Executors))
 
; make a set of functions that are associated with a graphcs in the ui
; this function is called with a couple of labels that we will draw on
(defn get-oscilloscope ([iso sono]
  (let [c   iso
        s   sono
        of  false
        oc  100
        pa  (ref nil)       ; store previous array so we can undraw
        ox  (ref 0)
        oy  (ref 0)
 
        ; might be neat to 'fade out'
        turn-off 
          (fn []
            (print "Turned off. Fading.")
            (newline))
 
        ; draw an oscilloscope grid
        turn-on
          (fn []
            (let [g   (. c (getGraphics))
                  x   (. c (getX))
                  y   (. c (getY))
                  w   (. c (getWidth))
                  h   (. c (getHeight))
                  r   7
                  xs  (/ (- w 1) (- r 1))
                  ys  (/ (- h 1) (- r 1))]
              (do 
                (. g (clearRect x y w h))
                (. g (setColor (. Color gray)))
                (. g (fillRect x y w h))
                (. g (setColor (. Color lightGray)))
                (dotimes ix r
                  (. g (drawLine (+ x (* ix xs)) y (+ x (* ix xs)) (+ y h))))
                (dotimes iy r
                  (. g (drawLine x (+ y (* iy ys)) (+ x w) (+ y (* iy ys)))))
                (. g (setColor (. Color white)))
                (. g (dispose)))))
 
        ; draw a set of samples, then xor out next time round
        draw-samples
          (fn [samples]
            (let [g (. c (getGraphics))
                  x (. c (getX))
                  y (. c (getY))
                  w (. c (getWidth))
                  h (. c (getHeight))
                  n (count samples)
                  s (/ w n)
                  m 32768                     ; signed 16-bit samples
                  ]
              (do (print "Drawing at " x "," y " size: " w " by " h ". Sample count: " n )
                  (newline)
                  (. *out* (flush))
                  (. g (setColor (. Color gray)))
                  (. g (setXORMode (. Color white)))
 
                  ; undraw the old one
                  (when @pa
                    (. g (drawPolygon @pa)))
 
                  ; draw the new one
                  (loop [i    0
                         xa   (make-array (. Integer TYPE) n)
                         ya   (make-array (. Integer TYPE) n)]
                    (if (< i n)
                      (let [nx (int (+ x (* i s)))
                            ny (int (- (/ h 2) (/ (* (aget samples i) h) m)))]
                        (do (aset-int xa i nx)
                            (aset-int ya i ny)
                            (recur (+ i 1) xa ya)))
                      (let [p (new Polygon xa ya n)]
                        (do (sync nil (set pa p))
                            (. g (drawPolygon p))))))
 
                  ; clean up graphics context
                  (. g (dispose)))))
 
        ; draw a 2d sonogram - need a better color scheme
        si  (ref 0)
        draw-sono
          (fn [samples]
            (let [g   (. s (getGraphics))
                  w   (. s (getWidth))
                  h   (. s (getHeight))
                  x   (. s (getX))
                  y   h
                  n   (/ (count samples) 4)
                  ss  (/ h n)
                  m   32768                     ; signed 16-bit samples
                  sx  (+ x (* ss @si))          ; start pos
                  ]
              (dotimes iy n
                (let [sy  (- y (* iy ss) ss)
                      gain   3                  ; sonogram gain
                      c   (int (* gain 255 (/ (aget samples iy) m)))
                      c   (if (> c 255) 255 c)]
                  (do (. g (setColor (new Color c c c)))
                      (. g (fillRect sx sy ss ss)))))
              (. g (dispose))
              (if (> (* @si ss) w)
                  (sync nil (set si 0))
                  (sync nil (set si (+ 1 @si))))))
 
        ; draw a frequency spectra and let it 'walk' down screen +x+y
        ; should clamp either end of spectra to zero to fix graphic glitches
        draw-frequencies
          (fn [spectra]
            (let [g (. c (getGraphics))
                  x (. c (getX))
                  y (. c (getY))
                  w (. c (getWidth))
                  h (. c (getHeight))
                  n (/ (count spectra) 4)
                  s (/ (- w 100) n)
                  m 32768                     ; signed 16-bit samples
                  ]
              (do ; bump iso
                  (sync nil 
                    (set ox (+ @ox 1))
                    (set oy (+ @oy 1))
                    (when (> @ox (- (/ h 2) 40))
                      (turn-on)
                      (set ox 0)
                      (set oy 0)))
 
                  ; Fill a red polygon, and outline in white
                  (loop [i    0
                         xl   (make-array (. Integer TYPE) n)
                         yl   (make-array (. Integer TYPE) n)]
                    (if (< i n)
                      (let [nx  (+ x (* i s) @ox)
                            ny  (- (+ (/ h 2) @oy) (/ (* (aget spectra i) h) m))]
                        (do (aset-int xl i nx)
                            (aset-int yl i ny)
                            (recur (+ i 1) xl yl)))
                      (do (let [p   (new Polygon xl yl n)]
                          (. g (setColor (. Color red)))
                          (. g (fillPolygon p))
                          (. g (setColor (. Color white)))
                          (. g (drawPolygon p))))))
 
                  (. g (dispose)))))
        ]
        
    ; return our 'vtable' associated with the two labels
    { :turn-on      turn-on 
      :draw-samples draw-samples 
      :draw-sono    draw-sono 
      :draw-frequencies draw-frequencies})))
 
;---- lame utility functions ----
 
; convert an array of shorts to floats
; there *has* to be a better way. But how?
(defn get-as-floats ([shorts]
  (let [n       (count shorts)
        floats  (make-array (. Float TYPE) n)]
    (dotimes idx n (aset floats idx (aget shorts idx)))
    floats)))
 
;---- load up the GUI, capture and analyze samples ----
 
; create an analyzer
(def fft (new kj.dsp.KJFFT 512))
 
; running flag
(def running (ref nil))
 
; oscilloscope
(defn oscilloscope ([]
  (let [gui       (new isometric.gui)
        ipanel    (. gui isopanel)
        iw        (. ipanel (getWidth))
        ih        (. ipanel (getHeight))
        iimage    (new BufferedImage iw ih (. BufferedImage TYPE_3BYTE_BGR))
        iicon     (new ImageIcon iimage)
        ilabel    (new JLabel iicon)
        spanel    (. gui sonopanel)
        sw        (. spanel (getWidth))
        sh        (. spanel (getHeight))
        simage    (new BufferedImage sw sh (. BufferedImage TYPE_3BYTE_BGR))
        sicon     (new ImageIcon simage)
        slabel    (new JLabel sicon)
        startbutton   (. gui start)
        oneshotbutton (. gui test)
        stopbutton    (. gui stop)
        inputs        (. gui inputs)
        pool      (. Executors (newFixedThreadPool 1))
        ]
    (. ilabel (setSize iw ih))
    (. ipanel (add ilabel))
    (. ipanel (doLayout))
    (. slabel (setSize sw sh))
    (. spanel (add slabel))
    (. spanel (doLayout))
    (. gui (pack))
    (. gui (setVisible true))
    ; populate input sources
    (doseq inp input-lines
      (. inputs (addItem (:mixer-name inp))))
    (let [funcs     (get-oscilloscope ilabel slabel)
          turn-on   (:turn-on funcs)
          draw-freq (:draw-frequencies funcs)
          draw-samp (:draw-samples funcs)
          draw-sono (:draw-sono funcs)
  
          ; worker function that samples and calls the draw functions
          worker
            (fn [] 
              (turn-on)
              (loop []
                (let [samples (get-inst-samples 512)
                      floats  (get-as-floats samples)
                      spectra (. fft (calculate floats))
                      ]
                  (aset-float spectra 0 0)
                  (draw-freq spectra)
                  (draw-sono spectra)
;                  (draw-samp samples)
                  (. Thread (sleep 10))
                  (if @running
                      (recur)))))
 
          ; starts a worker, who will quit if @running == nil
          start
            (fn []
              (when (not @running)
                (do
                  (sync nil (set running true))
                  (. pool (submit worker)))))
 
          ; one-shot, sample and analyze a single 'frame'
          one-shot
            (fn []
              (when (not @running)
                (do
                  (. pool (submit worker)))))
 
          ; kil the worker by setting @running = nil
          stop
            (fn []
              (sync nil (set running nil)))]
 
          ; set up UI buttons
          (do 
            (. inputs
              (addActionListener
                (implement [ActionListener]
                  (actionPerformed [evt]
                    (let [mixer-name  (. inputs (getSelectedItem))
                          sel-line    (:get-line (first (filter #(= mixer-name (:mixer-name %)) input-lines)))]
                      (do (print "Selecting: " mixer-name)
                          (newline)
                          (sel-line)))))))
 
            (. startbutton
              (addActionListener
                (implement [ActionListener]
                  (actionPerformed [evt]
                    (start)))))
 
            (. oneshotbutton
              (addActionListener
                (implement [ActionListener]
                  (actionPerformed [evt]
                    (one-shot)))))
 
            (. stopbutton
              (addActionListener
                (implement [ActionListener]
                  (actionPerformed [evt]
                    (print "=== STOP ===")
                    (newline)
                    (. *out* (flush))
                    (stop)))))

            (print "Hit start to go..."))))))
         
 
; comment out the following to have it not start automatically
(oscilloscope)

Google Charts from Clojure 1

Posted by jonathan on February 16, 2008

I wrote up a very simple example of calling Google Charts api from Clojure.

Example Google Charts Graph

Note: Rich Hickey actually emailed with some suggestions, and these have been added. I added a comment on the one I found most interesting, which is a function literal. Thanks Rich!

(in-ns 'google-chart)
(clojure/refer 'clojure)

(def *amp* "&")
 
; ---- connect to google charts and retrieve a chart ----
(defn get-google-chart [request]
  (new javax.swing.ImageIcon (new java.net.URL request) "Google Chart"))
 
; ---- pop-up a png in a dialog frame ----
(import '(javax.swing JLabel JFrame))
 
(defn show-chart [request]
  (println "Showing chart: " request)
  (doto (new JFrame "Google Chart")
    (add (new JLabel (get-google-chart request)))
    (pack)
    (setVisible true)))
 
; display the hello-world chart
;(show-chart (str "http://chart.apis.google.com/chart?"
;                 "cht=p3&chd=s:hW&chs=250×100&chl=Hello|World"))
 
; ---- simple encoding to 0 - 61 in chars ----
 
(defn encode [val scale]
  (if (nil? val)
      "_"
      (let [val (. Math (floor (* 61 (/ val scale))))]
        (nth "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" val))))
 
; ---- build a chart ----
 
(defn base-url []
  "http://chart.apis.google.com/chart?")
 
(defn chart-size [x y]
  (str "chs=" x "x" y))
 
(defn chart-type [type]
  (str "cht=" type))
 
(defn chart-data [data]
  (let [mx (apply max data)]
    (apply str "chd=s:" (map #(encode % mx) data))))   ; function literal

;### fix spaces -&gt; +
(defn chart-title [title]
  (str "chtt=" title))

(defn chart-axis [x y]
  ; really basic, just an x and y axis
  (apply str "chxt=x,y" *amp*
         "chxl=0:" (concat (interleave (repeat "|") x)
                           ["|1:"] (interleave (repeat "|") y))))

;; Test it out ...
(comment
(show-chart
  (str
    (base-url)
    (chart-size 480 480) *amp*
    (chart-type "lc") *amp*
    (chart-data (map (fn [x] (* x x)) (range -50 51))) *amp*
    (chart-title "x+squared") *amp*
    (chart-axis ["-5" "0" "5"] ["" "" "y-axis"]))))
 
; Test it out ...
(show-chart
  (str
    (base-url)
    (chart-size 480 240) *amp*
    (chart-type "lc") *amp*
    (chart-data [188.5 186 181.5 183 179.5 181]) *amp*
    (chart-title "Jonathan+Weight") *amp*
    (chart-axis ["Week+1" "Week+2" "Week+3"] ["" "" "190+lbs"])))

LISP Running on OLPC (One Laptop Per Child) 1

Posted by jonathan on December 29, 2007

After a couple of glasses of red wine tonight, I decided I would try and get a JVM and LISP, in the form of Rich Hickey’s Clojure language, running on my OLPC.

Downloading a JVM was simple, and it installed quickly, once I worked out that the OLPC software saves large files that it doesn’t understand into /tmp.

I then tried several times to download the Clojure distribution, but I never managed to find where mozilla was putting the .zip file. Anyway, I was able to unzip it by opening the file in etoys which has the first decent file selector I’ve seen on the OLPC.

Once Clojure is unzipped, it can be run simply by running ‘java’ against the clojure.jar file. Expressions typed at the repl, or loaded are compiled by Clojure, then JITed by the java runtime, which (and I can vouch for this) gives extreme performance that is more than up to the task of moving multithousand line datasets around even before your finger is off the enter key.

Anyways, here’s a couple of shots of Clojure running on the latest JRE on my OLPC:

Clojure on OLPC

Clojure on OLPC

It seems like a lot of people have been worried about getting java up and running, but downloading it from java.com (See Linux Self-extracting file) worked just fine. ;-)