Racket Plot: stacked lines labeled, positive and negative
While using questionnaire data to learn plotting, questions come to mind. Averages don't make sense for “ranked” “factors”, for numbered responses to questions about how much a person agrees or disagrees with a question. Maybe seeing the percentage and number of positive responses versus negative responses will help in the search for meaning in the data.
With Racket it is possible to transform and view the data however you like. It's nice to be able to implement a view out of curiosity. I'm hoping the stacked lines with their labels provide enough hints for people to figure out that they are combinations of responses of 4 and 5 in a positive direction, and 1 and 2 in a negative direction.
If there is time to go over the code again there must be less repetitive way to stack negative lines after stacking positive lines. Getting started on that gave me a change to use Racket's define to give the pnt-w-lbl procedure an optional argument.
Years ago with gnuplot I plotted “enthused”熱意 results against “satisified”満足 responses. Naomi Klein quoted a Harpers article by a professor that said he refused to be “cool” like a Marshall McLuhan screen.
For now though, I just want to see how Racket can replace two pages oddly scaled visualizations and averages. It's time to move into other work, after adjusting the css styles so that the generated page fits onto two A4 papers.
Here's proof that the code pasted in below worked in DrRacket:
code
#lang racket
;; set the directory in which to write plot images
(define working-directory
(build-path (find-system-path 'home-dir)
"FD201802H30K-2B"))
(unless (directory-exists? working-directory)
(make-directory working-directory))
;; choose image extension for htmlpage
;; the #:out-kind for plot
(define page-plot-type 'svg)
;; choose image extension for bitmaps
;; #:out-kind for plot, and name of directory
;; for bitmaps, useful to share on-line
(define bitmap-plot-type 'png)
(define make-or-clear-directory
;; can't use this with absolute directory
(lambda (pth) ;; path, string, or list of strings ok!
(let ((p (build-path working-directory pth)))
(if (directory-exists? p)
(delete-directory/files p)
(make-directory p)))))
(require plot) ;; discrete-histogram, stacked-histogram etc
(require plot/utils) ;; ->plot-label
(require scribble/html/html) ;; for output-xml, html and class:
(require scribble/html) ;; for element
;; set the order of images in output page
(define bodies '(教員 学科 大学)) ;; Teacher, Department, University
;; short keys and labels for questions and data
(define quest-symbs '(出席 発言 取組 聞取 資料 時刻 反応 熱意 理解 役立 満足))
;; データを入力し直すところ
(define ind-als ;;教員の連帯リスト associative list
'((nme (教員 TCR スモール 教養)) ;; NaME of BoDy bod 体
(smr (2018 02 H30 K)) ;; 学期 SeMesteR
(cls (1 68)) ;; 授業、教室 CLasS
(dta ((33 28 6 1 0) ;; データ、DaTA
(8 27 19 9 5)
(8 25 22 12 1)
(37 25 6 0 0)
(21 34 11 2 0)
(49 16 3 0 0)
(47 16 5 0 0)
(56 11 1 0 0)
(25 31 7 5 0)
(17 33 15 2 1)
(19 38 8 2 1)))))
(define dep-als ;;学科 associative list
'((nme (学科 DPT 教養 大学))
(smr (2018 02 H30 K))
(cls (6 276))
(dta ((198 59 16 3 0)
(39 86 102 26 22)
(50 96 90 29 9)
(130 91 40 10 4)
(98 107 55 12 3)
(174 70 26 4 2)
(125 95 48 5 3)
(161 81 30 2 1)
(99 114 45 13 5)
(95 105 65 8 3)
(89 120 51 9 7)))))
(define uni-als ;;大学
'((nme (大学 UVY 南九州 学園))
(smr (2018 02 H30 K))
(cls (57 2403))
(dta ((1679 479 202 31 10)
(419 616 974 190 199)
(684 822 692 134 65)
(1341 670 293 69 28)
(1200 695 374 86 42)
(1702 480 169 28 17)
(1315 652 349 52 33)
(1537 585 236 21 19)
(938 940 412 73 34)
(1328 676 325 43 26)
(1172 781 356 55 34)))))
;; copied from "Racket for Data Science" code
;; by Nicholas M. Van Horn, n3mo
;; moved by his respect for Chicken Scheme
(define als-ref
(lambda (idx als)
(let ((tmp (assv idx als)))
(if tmp (cadr tmp) #f))))
(define counts->percents
(lambda (lon) ;; list of numbers
(let ((total (apply + lon)))
(map (lambda (count)
(* (/ count total) 100.0))
lon))))
(define pnt-w-lbl
(lambda (x n l (algn 'bottom))
(point-label (vector x n) l #:anchor algn #:size 8)))
;; adjust font-size for big numbers here
;; with too many digits #:angle 170 might help
(define vline-to-y
(lambda (x y)
(lines (map vector (list x x) (list 0 y)))))
(define vline-y1-to-y2
(lambda (x y1 y2) ; y1 and y2 are percents
(list
(lines (map vector (list x x) (list 0 y1)) #:width 2)
(lines (map vector (list x x) (list y1 y2)) #:width 3))))
(define neg-vline-y1-to-y2
(lambda (x y1 y2) ;; y1 and y2 are percents
(list
(lines (map vector (list x x) (list 0 (- y1))) #:color 0 #:width 3)
(lines (map vector (list x x) (list (- y1 ) (- y2))) #:color -1 #:width 2))))
;; 4count, 5count : 1count, 2count
(define pos-line-label
;; xlevel percents, 4's count 5's count
(lambda (x p4 p5 c4 c5)
(let ((p4n5 (+ p4 p5))
(cnt-lbl (string-join (map number->string (list c4 c5)) ":")))
(list
(pnt-w-lbl x p4n5 (->plot-label cnt-lbl))
(vline-y1-to-y2 x p4 p4n5)))))
(define neg-line-label
(lambda (x p1 p2 c1 c2)
(let ((p1n2 (- (+ p1 p2)))
(cnt-lbl (string-join (map number->string (list c1 c2)) ":")))
(list
(pnt-w-lbl x p1n2 (->plot-label cnt-lbl) 'top)
(neg-vline-y1-to-y2 x p2 (+ p1 p2))))))
(define stck-ngtv-rslts
(lambda (row)
(let* ((cn1 (fifth row))
(cn2 (fourth row))
(x 5.5)
(pcnts (counts->percents row))
(pr1 (fifth pcnts))
(pr2 (fourth pcnts)))
(neg-line-label x pr1 pr2 cn1 cn2))))
(define stck-pstv-rslts
(lambda (row)
(let* ((cn5 (first row))
(cn4 (second row))
(x 5.5) ;; #:xmax will be 5.8
(pcnts (counts->percents row))
(pr5 (first pcnts))
(pr4 (second pcnts)))
(pos-line-label x pr4 pr5 cn4 cn5))))
(define lines-percents-labels-counts
;; for each row of Question Results
;; get vline-to-y and pnt-w-lbl ready for plot
(lambda (lon)
(let ((pcnts (counts->percents lon))
(lvels '(5 4 3 2 1))
(tot-lab (->plot-label (apply + lon))))
(append ;; need a flat list for plot
(map (lambda (l p) ;; level percent
(vline-to-y l p))
lvels pcnts)
(map (lambda (x n l)
;; xResponse level nNumber point lLabel
(pnt-w-lbl x n l))
lvels pcnts
(map (lambda (s) (string-append s "/" tot-lab))
(map ->plot-label lon)))))))
;; get data ready for lines-percents-labels-counts
(define dta->Qss-Als
(lambda (Qss Als) ;; Question Symbols, A-list
(map list Qss (als-ref 'dta Als))))
;; for pngs change ".svg" and 'svg to ".png" and 'png
;; below ~w-ext adds ext argument
(define plot-bod-als-to-percentlines-countlabels
(lambda (BodAls Qsyms)
;; get orginal result data into associative list: QR-als
(let ((QR-als (dta->Qss-Als Qsyms BodAls))
(bod (->plot-label (car (als-ref 'nme BodAls)))))
(define lines-percents-titled
(lambda (QR)
(let* ((ttl (string-append bod ":" (->plot-label (car QR))))
(plt-ttl (string-append ttl " "
(string-join (map ->plot-label
(als-ref 'cls BodAls)) "T/") "S"))
(fle-name (build-path working-directory (string-append ttl
(->plot-label (car (als-ref 'smr BodAls)))
(->plot-label (cadr (als-ref 'smr BodAls))) ".svg"))))
(plot (list (hrule 0 #:color 0) ;; need this for stck-ngtv-rslts
(lines-percents-labels-counts (cadr QR))
(stck-pstv-rslts (cadr QR))
(stck-ngtv-rslts (cadr QR)))
#:x-min .5 #:x-max 5.9
#:y-min -30 #:y-max 115
#:width 400 #:height 250
#:x-label "levels" #:y-label "percent"
#:title plt-ttl
#:out-file fle-name
#:out-kind page-plot-type))))
(map lines-percents-titled QR-als))))
;; (define delete-dir-files
;; (lambda (dir)
;; (map delete-file
;; (map (lambda (f) (build-path dir f))
;; (directory-list dir)))))
;; need better names
(define anket-reslt-alist->line-labl-chrts
;; call plot-bod-als-to~~ with ink-minimizing parameters
(lambda (als Qsymbs)
(parameterize ((plot-tick-size 3)
(plot-x-far-axis? #f)
(plot-y-far-axis? #f))
(plot-bod-als-to-percentlines-countlabels als Qsymbs))))
;; End of plot output, image file generationg
;; Start of html page generation
;; using scribble/html/html
(define dir-lis-strs
(lambda (dir)
(let ((d (if (symbol? dir) (symbol->string dir) dir)))
(map path->string (directory-list d)))))
(define mtchd-files
(lambda (rxp dir)
(filter (lambda (s) (regexp-match rxp s))
(dir-lis-strs dir))))
;; (mtchd-files #rx"学科" 'csv)
(define bod-img
;; regexp body, reqexp questions
(lambda (rxB rxQ)
;; no dir: "."
;; keep everything in one, current directory for now
(filter (lambda (s) (regexp-match rxB s))
;; later: (current-directory-for-user)
(mtchd-files rxQ ".")))) ;; working-directory
;; (bod-img #rx"大学:.+svg$" #rx"理解" ".")
;; '("大学:理解201801.png")
;; quest-symbs as alst keys
(define questions '(
(出席 "私はこの授業によく出席した" 学生取組)
(発言 "私は授業内容について質問や発言した" 学生取組)
(取組 "私はこの科目に積極的に取り組んだ(予習と復習した)" 学生取組)
(聞取 "教員の声は聞き取りやすかった。" 教員実施)
(資料 "教員の板書(またはPPT・配布資料など)は読みやすかった(見やすかった)" 教員実施)
(時刻 "教員は授業の開始・終了の時刻を守ろうとしていた" 教員実施)
(反応 "教員は学生の反応を確かめながら授業を進めていた" 教員実施)
(熱意 "教員は熱意を持って授業をしていた" 教員実施)
(理解 "私はこの授業内容を理解できた" 総合評価)
(役立 "私はこの授業で学んだ内容はなんらかの形で将来的に役立つと感じた" 総合評価)
(満足 "私は総合的に判断してこの授業で満足が得られた" 総合評価)))
(define responses '((5 特に "特にそう思う" "very much" "I really think so")
(4 多少 "多少そう思う" "fairly much" "I somewhat think so")
(3 どちも "どちらともいえない" "neither" "I can't say either way")
(2 あまり "あまりそう思わない" "not much" "I do not think so much")
(1 全く "全くそう思わない" "not at all" "I do not think so at all")))
;; (sort responses #:key car <)
(define bdy-rslt-img
(lambda (imge-file)
(element 'img class: "result-image" src: imge-file)))
;; (output-xml (bdy-rslt-img (bod-img #rx"大学:.+svg$" #rx"理解" ".")))
;; <img class="result-image" src="大学:理解201801.png" />
;; get list of result images in bodies order for rslt-img-div
;; regexp<-symbol: rx from sym
(define symbol->regexp
(lambda (sym)
(regexp (symbol->string sym))))
(define make-regexp-w-ext
(lambda (sym ext-sym)
(regexp (string-append
(symbol->string sym) ":"
".+"
(symbol->string ext-sym) "$"))))
(define Qsym-Bdys-rslt-imgs
;; Question symbol, list of body symbols
(lambda (qsym bdys ext)
(map (lambda (bdy-rx)
(bod-img bdy-rx (symbol->regexp qsym)))
(map (lambda (bod) (make-regexp-w-ext bod ext)) bdys))))
(define rslt-img-div
(lambda (rslt-imgs)
(element 'div class: "result-images"
(map bdy-rslt-img rslt-imgs))))
;; (output-xml (rslt-img-div (Qsym-Bdys-rslt-imgs '理解 bodies)))
;; <div class="result-images"><img class="result-image" src="教員:理解201801.png" /><img class="result-image" src="学科:理解201801.png" /><img class="result-image" src="大学:理解201801.png" /></div>
(define Qsym->Qli
;; Question-Symbol to Question item <li>Q</li>
(lambda (sym Qs)
(element 'li class: "ques-txt-ja"
(als-ref sym Qs))))
(define Q-li-Rs-div
;; get Qli and image links ready for output-xml
(lambda (sym ext)
(list
(Qsym->Qli sym questions)
(rslt-img-div (Qsym-Bdys-rslt-imgs sym bodies ext)))))
(define Qs-w-Rs->ol
;; for output-xml get Qli and Rimages into ordered list
(lambda (syms ext)
(element 'ol class: "questions-with-results"
(map (lambda (sym) (Q-li-Rs-div sym ext)) syms))))
(define resp-levl-defn
(lambda (rsp-row)
(element 'li class: "response-item"
(string-join
(map ->plot-label (list
(car rsp-row)
". "
(caddr rsp-row)))
""))))
(define resp-levl-list
(lambda (defns)
(element 'ol class: "response-levels"
(map resp-levl-defn (sort responses #:key car <)))))
(define output-QsRs-page
(lambda (als plt-ext)
(let* ((yr-sr (string-join (map ->plot-label (als-ref 'smr als)) ""))
;;year semetsr
(pge-ttl (string-append "FD アンケート結果 " yr-sr)))
(call-with-output-file (build-path working-directory
(string-append "FD-Anketo-Questions-Result-" yr-sr ".html")) #:exists 'truncate
(lambda (out)
(output-xml (xhtml
(head (title pge-ttl)
(meta http-equiv: "Content-Type" content: "text/html;charset=utf-8")
(style "ol.response-levels {margin-left: -1em; padding-left: 0; font-size: 11pt;")
(style "li.response-item {display: inline; margin-left: .5em; }")
(style "li {page-break-inside: avoid; } ")
;; doesn't work to keep Q li and R images together
(style "li.ques-txt-ja { margin-left: -1.2em; font-size: 14pt; }")
(style "div.result-images {width: 100%;} ")
;; how to shring to 100% only if auto is too wide?
(style "img.result-image { margin: 5px 0 10px 0 ; width:32%; }"))
(body
(h2 pge-ttl)
(h3 "回答数字の文")
(resp-levl-list responses)
(h3 "設問の文と結果の図")
(Qs-w-Rs->ol quest-symbs plt-ext)
;; (element 'ol class: "questions"
;; (map (lambda (sym) (Qsym->Qli sym questions)) quest-symbs))
))
out))))))
;; output the html page
;; needs the plot images generated beforehand, as above
;; (map (lambda (als) (anket-reslt-alist->line-labl-chrts als quest-symbs))
;; (list ind-als dep-als uni-als))
;; (output-QsRs-page uni-als)
(define generate-plot-images-and-html-page
(lambda (list-of-alists plt-ext)
(map (lambda (als)
(anket-reslt-alist->line-labl-chrts als quest-symbs))
list-of-alists)
(output-QsRs-page (last list-of-alists) plt-ext)))
(define write-plot-images-html-page-to
(lambda (pth lst-of-alsts plt-ext)
(generate-plot-images-and-html-page
lst-of-alsts plt-ext)))
;; plot-type plot extension plt-ext
(write-plot-images-html-page-to working-directory (list ind-als dep-als uni-als) page-plot-type)
;; svg images are lossless, the plots should look good on a wide screen and a real page.
;; but png images are useful for sharing on-line
(define plot-bod-als-to-percentlines-countlabels-w-ext
(lambda (BodAls Qsyms ext)
(let ((QR-als (dta->Qss-Als Qsyms BodAls))
(bod (->plot-label (car (als-ref 'nme BodAls))))
(dir (build-path working-directory (symbol->string ext))))
(define lines-percents-titled
(lambda (QR)
(let* ((ttl (string-append bod ":" (->plot-label (car QR))))
(plt-ttl (string-append ttl " "
(string-join (map ->plot-label (als-ref 'cls BodAls)) "T/") "S"))
(fle-name (build-path dir
(string-append ttl ;; build path
(->plot-label (car (als-ref 'smr BodAls)))
(->plot-label (cadr (als-ref 'smr BodAls)))
"." (->plot-label ext)))))
(plot (list (hrule 0 #:color 0) ;; need this for stck-ngtv-rslts
(lines-percents-labels-counts (cadr QR))
(stck-pstv-rslts (cadr QR))
(stck-ngtv-rslts (cadr QR)))
#:x-min .5 #:x-max 5.9
#:y-min -30 #:y-max 115
#:width 400 #:height 250
#:x-label "levels" #:y-label "percent"
#:title plt-ttl
#:out-file fle-name
#:out-kind ext))))
(map lines-percents-titled QR-als))))
;; need better names
(define anket-reslt-alist->line-labl-chrts-w-ext
(lambda (als Qsymbs ext)
(parameterize ((plot-tick-size 3)
(plot-x-far-axis? #f)
(plot-y-far-axis? #f))
(plot-bod-als-to-percentlines-countlabels-w-ext als Qsymbs ext))))
(define write-ind-dep-uni-result-plots
(lambda (ext-dir-sym)
(make-or-clear-directory (symbol->string ext-dir-sym))
(map (lambda (als)
(anket-reslt-alist->line-labl-chrts-w-ext als quest-symbs ext-dir-sym))
(list ind-als dep-als uni-als))
))
;;(change-directory-to wrk-dir))))
(write-ind-dep-uni-result-plots bitmap-plot-type)
;; after this works, make a dir, plots and page for interleaved plots
;; simple page for stacked histograms
;; w-o 抜き procedures ... go on to roll generation too
- Updated version of code, using Racket path utilities