Code for blog post at https://www.travishinkelman.com/eda-scheme-tk

eda-tk.ss

(import (dataframe)
        (only (wak irregex) irregex-split)
        (prefix (gnuplot-pipe) gp:)
	(chez-tk))

(define df (csv->dataframe "txhousing.csv"))

;; Need to double quote string elements that contain a space for passing to Tcl/Tk
(define (double-quote lst)
  (map (lambda (x)
	 (let ([x-list (string->list x)])
	   (if (member #\space x-list)
	       (string-append "\"" x "\"")
	       x)))
       lst))

;; Global Variables
(define cities (remove-duplicates ($ df 'city)))
;; frustratingly, I don't understand why retaining these 3 cities returns this error
;;    --> can't set "::scmVar(cities-tk)": invalid listvar value
(define cities
  (filter
   (lambda (x) (not (member x '("Montgomery County"
                                "Port Arthur"
                                "Wichita Falls"))))
   cities))
(define cities-dq (double-quote cities))
(define min-yr (apply min ($ df 'year)))
(define max-yr (apply max ($ df 'year)))
(define months '(Jan Feb Mar Apr May Jun
		     Jul Aug Sep Oct Nov Dec))
(define vars '(("Median Sale Price" median)
	       ("Sales" sales)
	       ("Volume" volume)
	       ("Listings" listings)
	       ("Inventory" inventory)))
(define vars-labs "\"Median Sale Price\" Sales Volume Listings Inventory")

(define (filter-data df min-yr max-yr months-idx cities-idx cities resp-var)
  (let ([months-sel (map add1 months-idx)]
        [cities-sel (map (lambda (x) (list-ref cities x)) cities-idx)])
    (-> df
        (dataframe-remove-na resp-var)
        (dataframe-filter*
         (city year month)
         (and (>= year min-yr)
	      (<= year max-yr)
	      (member month months-sel)
	      (member city cities-sel))))))

(define (agg-data df xvar resp-var)
  (dataframe-aggregate
   df
   (list 'city xvar)
   '(mean-rv)
   (list (list resp-var))
   (lambda (resp-var) (exact->inexact (mean resp-var)))))

(define (plot-data df x y xvar-str resp-var-str)
  (gp:call/gnuplot
   (gp:send "set key top left")
   (gp:send (string-append "set xlabel \'" xvar-str "\'"))
   (gp:send (string-append "set ylabel \'Avg. " resp-var-str "\'"))
   (gp:send "set style data linespoints")
   (gp:plot
    (map (lambda (c)
           (let ([df-sub (dataframe-filter*
                          df
                          (city)
                          (string=? c city))])
             (list
              (string-append "title '" c "'")
              ($ df-sub x)
              ($ df-sub y))))
         (remove-duplicates ($ df 'city))))))

(ttk-map-widgets 'all)
(define tk (tk-start))
(define frame (tk 'create-widget 'frame 'padding: '(10 10 10 10)))
(define months-lb
  (frame 'create-widget 'listbox 'listvariable: (tk-var 'months-tk)
	 'height: 5 'exportselection: #f 'selectmode: 'extended))
(define cities-lb
  (frame 'create-widget 'listbox 'listvariable: (tk-var 'cities-tk)
	 'height: 10 'exportselection: #f 'selectmode: 'extended))
(define vars-cb
  (frame 'create-widget 'combobox 'values: vars-labs 'state: 'readonly))

(tk/grid frame)
(tk/grid (frame 'create-widget 'label 'text: "Years")
	 'column: 0 'row: 0 'sticky: 'w 'pady: 5)
(tk/grid (frame 'create-widget 'spinbox 'from: min-yr 'to: max-yr
		'textvariable: (tk-var 'min-yr-tk) 'width: 5)
	 'column: 1 'row: 0 'sticky: 'w)
(tk/grid (frame 'create-widget 'spinbox 'from: min-yr 'to: max-yr
		'textvariable: (tk-var 'max-yr-tk) 'width: 5)
	 'column: 2  'row: 0 'sticky: 'w)

(tk/grid (frame 'create-widget 'label 'text: "Months")
	 'column: 0 'row: 1 'sticky: 'w)
(tk/grid months-lb 'column: 0 'row: 2 'columnspan: 3 'sticky: 'we 'pady: 5)

(tk/grid (frame 'create-widget 'label 'text: "Cities")
	 'column: 0 'row: 3 'sticky: 'w)
(tk/grid cities-lb 'column: 0 'row: 4 'columnspan: 3 'sticky: 'we 'pady: 5)

(tk/grid (frame 'create-widget 'label 'text: "X Variable")
	 'column: 0 'row: 5 'sticky: 'w 'pady: 5)
(tk/grid (frame 'create-widget 'radiobutton 'text: "Year" 'value: "Year"
	        'variable: (tk-var 'xvar-tk))
	 'column: 1 'row: 5 'sticky: 'e)
(tk/grid (frame 'create-widget 'radiobutton 'text: "Month" 'value: "Month"
	        'variable: (tk-var 'xvar-tk))
	 'column: 2 'row: 5 'sticky: 'e)

(tk/grid (frame 'create-widget 'label 'text: "Response Variable")
	 'column: 0 'row: 6 'columnspan: 3 'sticky: 'w)
(tk/grid vars-cb 'column: 0 'row: 7 'columnspan: 3 'sticky: 'we)

(define (prepare-curselection x)
  (map string->number (irregex-split " " x)))

(define plot-cmd
  (lambda ()
    (let* ([xvar-str (tk-get-var 'xvar-tk)]
           [xvar (if (string=? xvar-str "Year") 'year 'month)]
           [rv-str (vars-cb 'get)]
           [rv (cadr (assoc rv-str vars))]
           [df-sub (filter-data
                    df
                    (string->number (tk-get-var 'min-yr-tk))
                    (string->number (tk-get-var 'max-yr-tk))
                    (prepare-curselection (months-lb 'curselection))
                    (prepare-curselection (cities-lb 'curselection))
                    cities
                    rv)])
      ;; can't aggregate empty dataframe
      (when (> (car (dataframe-dim df-sub)) 0)
        (plot-data (agg-data df-sub xvar rv) xvar 'mean-rv xvar-str rv-str)))))

(tk/grid (frame 'create-widget 'button 'text: "Plot" 'command: plot-cmd)
	 'column: 0 'row: 8 'columnspan: 3 'sticky: 'we 'pady: 5)

(tk-set-var! 'min-yr-tk min-yr)
(tk-set-var! 'max-yr-tk max-yr)
(tk-set-var! 'months-tk months)
(tk-set-var! 'cities-tk cities-dq)
(tk-set-var! 'xvar-tk "Year")
(vars-cb 'set "Median Sale Price")
(months-lb 'selection 'set 0 11)

(define (get-idx lst lst-sub)
  ;; get indices of lst-sub from lst
  (let* ([idx (iota (length lst))]
	 [lst-idx (map (lambda (x i) (cons x i)) lst idx)])
    (map (lambda (y) (cdr (assoc y lst-idx))) lst-sub)))

(for-each (lambda (x) (cities-lb 'selection 'set x))
	  (get-idx cities '("Austin" "Dallas" "El Paso" "Houston" "Lubbock" "San Antonio")))

;; Colorize alternating lines of listboxes
(define (get-even-idx lst)
  ;; get list of all even indices for a list
  (filter (lambda (x) (= (remainder x 2) 0)) (iota (length lst))))

(for-each
 (lambda (x) (months-lb 'itemconfigure x 'background: "#f0f0ff"))
 (get-even-idx months))
(for-each
 (lambda (x) (cities-lb 'itemconfigure x 'background: "#f0f0ff"))
 (get-even-idx cities))

;; Start event loop
(tk-event-loop tk)