Racket Plot: Synoptic View for Questionnaires
The code needs editing, but I like this view of questionnaire data where “factor” responses of 1 and 2 are negative, 3 is seemingly neutral, and 4 and 5 are positive. It seems possible to see things with this view that might not be possible with an average/mean of the responses.
The visualization needs to be on a page with the full text for the questions, the symbols for the numbered responses, the tables for the data, and an attempt to explain the visualization.
code
#lang racket
;; set the directory in which to write plot images and web page
(define working-directory
(build-path (find-system-path 'home-dir)
"FD"
"FD201802H30K-2C-SynopticPage"))
(unless (directory-exists? working-directory)
(make-directory working-directory))
(define img-ext-for-pge 'svg)
(define img-fle-for-pge (path-replace-extension
(build-path working-directory
"SynopticView")
(string-append "." (symbol->string img-ext-for-pge))))
(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
(require racket/require)
(require (only-in srfi/1 iota))
(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)))))
(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) (sze 8) (pnt-clr 0) (lbel-angl 0))
(point-label (vector x n) l #:anchor algn #:size sze #:point-color pnt-clr #:angle lbel-angl)))
(define vline-y1-to-y2
(lambda (x y1 y2 (clr 0)) ; y1 and y2 are percents
(list
(lines (map vector (list x x) (list 0 y1)) #:width 2 #:color clr)
(lines (map vector (list x x) (list y1 y2)) #:width 4 #:color clr))))
(define line-label ;; change name to line-label
;; xlevel percents, 4's count 5's count
;; defaults to positive line with anchor 'bottom
;; over-ride anchor with 'top fo negative direction
(lambda (x p4 p5 c4 c5 (lbl-aln 'bottom) (clr 0))
;; points always given with same sign +pos or -neg
(let ((p4n5 (+ p4 p5))
(cnt-lbl (string-join (map number->string (list (abs c4) (abs c5))) ":")))
(list
(pnt-w-lbl x p4n5 (->plot-label cnt-lbl) lbl-aln)
(vline-y1-to-y2 x p4 p4n5 clr))))) ;; 1 is #:color 1 (red)
(define stck-rslts
(lambda (row (x 5.5) (lbl-aln 'bottom)(clr 0) (sign +))
(let* ((cn5 (first row))
(cn4 (second row))
;; (x 5.5) ;; #:x-max will be 5.8
(pcnts (counts->percents row))
(pr5 (first pcnts))
(pr4 (second pcnts)))
(line-label x (sign pr4) (sign pr5) (sign cn4) (sign cn5) lbl-aln clr))))
(define pos-neg-stacked-lines-labeled-row
(lambda (row x)
(list
(stck-rslts row x 'bottom 1)
(stck-rslts (reverse row) x 'top 0 -))))
(define pos-neg-stacked-lines-labeled-rows3
(lambda (3rows x)
(list
(pos-neg-stacked-lines-labeled-row (car 3rows) (- x .30))
(pos-neg-stacked-lines-labeled-row (cadr 3rows) x)
(pos-neg-stacked-lines-labeled-row (caddr 3rows) (+ x .30)))))
(define pos-neg-stacked-lines-labeled-rows3-quesN
(lambda (d1 d2 d3) ;; data sets
;; number of rows = number of questions
(let ((qn (length d1)))
(define helper
;; remainders
(lambda (r1 r2 r3 n keep)
(cond
((> n qn) (reverse (cons (hrule 0 #:color 0) keep)))
(else (helper (cdr r1) (cdr r2) (cdr r3) (+ 1 n)
(cons keep
(cons
(pos-neg-stacked-lines-labeled-row (car r1) (- n .30))
(cons
(pos-neg-stacked-lines-labeled-row (car r2) n)
(pos-neg-stacked-lines-labeled-row (car r3) (+ n .30))))))))))
(helper d1 d2 d3 1 '()))))
(define NQs (map list (range 1 12) quest-symbs))
(define label-rows3
(lambda (xmid yval labels)
(list (point-label (vector (- xmid .30) yval) (car labels) #:anchor 'bottom #:point-size 0)
(point-label (vector xmid yval) (cadr labels) #:anchor 'bottom #:point-size 0)
(point-label (vector (+ xmid .30) yval) (caddr labels) #:anchor 'bottom #:point-size 0))))
;; Synoptic View
(parameterize ((plot-x-ticks (linear-ticks #:number 11))
(plot-y-ticks (linear-ticks #:number 8))
(plot-x-far-axis? #f)
(plot-y-far-axis? #f))
(plot (cons (label-rows3 1 100 (list "教員" "学科" "大学"))
(cons (label-rows3 5 100 (list "教員" "学科" "大学"))
(cons (label-rows3 10 100 (list "教員" "学科" "大学"))
(cons (map (lambda (xval)
(lines (list (vector xval 90) (vector xval 99)) #:color -2 #:style 'dot))
(list .6 1.4 4.6 5.4 9.6 10.4))
(cons (map (lambda (nq) (point-label (vector (car nq) 105) (symbol->string (cadr nq))
#:anchor 'bottom #:size 12
#:point-color -1 #:point-size 0))
NQs)
(cons
(map (lambda (xval)
(lines (list (vector xval -40) (vector xval 0)) #:color -2 #:style 'dot))
(iota 12 .5 1))
(cons
(map (lambda (nq)
(point-label (vector (car nq) -40)
(symbol->string(cadr nq))
#:anchor 'bottom #:size 14
#:point-color -1 #:point-size 0))
NQs)
(list
(pos-neg-stacked-lines-labeled-rows3-quesN
(als-ref 'dta ind-als) (als-ref 'dta dep-als) (als-ref 'dta uni-als))))))))))
#:x-label "設問 questions" #:y-label "割合 percent"
#:x-min .3 #:x-max 11.7
#:y-min -40 #:y-max 110
#:width 1500 #:height 700
#:out-file img-fle-for-pge
#:out-kind img-ext-for-pge))
(define questions '(
(出席 "私はこの授業によく出席した" 学生取組)
(発言 "私は授業内容について質問や発言した" 学生取組)
(取組 "私はこの科目に積極的に取り組んだ(予習と復習した)" 学生取組)
(聞取 "教員の声は聞き取りやすかった。" 教員実施)
(資料 "教員の板書（またはPPT・配布資料など）は読みやすかった（見やすかった）" 教員実施)
(時刻 "教員は授業の開始・終了の時刻を守ろうとしていた" 教員実施)
(反応 "教員は学生の反応を確かめながら授業を進めていた" 教員実施)
(熱意 "教員は熱意を持って授業をしていた" 教員実施)
(理解 "私はこの授業内容を理解できた" 総合評価)
(役立 "私はこの授業で学んだ内容はなんらかの形で将来的に役立つと感じた" 総合評価)
(満足 "私は総合的に判断してこの授業で満足が得られた" 総合評価)))
(define Q-li
(lambda (qrow)
(li class: "question" (string-append (symbol->string (car qrow)) " : "
(cadr qrow)))))
(define Qs-ol
(lambda (qs)
(ol
(map Q-li qs))))
(define lst->row
(lambda (Qrslts)
(tr
(map td Qrslts))))
(define th-row
(lambda (rsp-txt-lst)
(define helper
(lambda (l n rsps keep)
(cond
((> n l) (reverse keep))
(else (helper l (+ 1 n) (cdr rsps)
(cons
(th
(string-append (number->string n) ":"
(symbol->string(cadar rsps))))
keep))))))
(helper (length rsp-txt-lst) 1 (reverse rsp-txt-lst) '())))
(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")))
(define lsts->table
(lambda (als)
(table class: "results"
(caption (symbol->string (car (als-ref 'nme als))))
(th-row responses)
;; (map th (iota 5 1 1))
(map lst->row (map reverse (als-ref 'dta als))))))
(define R-li
(lambda (rrow) ;; results list for one question, a row
(li (string-append (symbol->string (cadr rrow)) " : " (caddr rrow)))))
(define Rs-ol
(lambda (rs) ;; results for a body: TCR, DPT, UVY
(ol
(map R-li (reverse rs)))))
(define output-synoptic-view-page
(lambda (als)
(let* ((year-strn (string-join (map ->plot-label (als-ref 'smr als)) ""))
(pge-ttl (string-append "FD アンケート結果 Synoptic View 共観 " year-strn)))
(call-with-output-file
(build-path working-directory
(string-append "FD-Questionnaire-Results-Synoptic-View" year-strn ".html"))
#:exists 'truncate
(lambda (out)
(output-xml (xhtml
(head (title pge-ttl)
(meta http-equiv: "Content-Type" content: "text/html;charset=utf-8")
(map style (list ;; saves ink/color to map style over a list of strings
"@page { size: 210mm 297mm; margin: 4mm 4mm 6mm 4mm; }"
"h2 {margin-top: 10px; margin-bottom: 10px; font-size: 14pt;} "
"h3 {margin-top: 8px; margin-bottom: 8px; }"
"div.questions-list { float: left; }"
"div.results-explanation {float:left;}"
"h3.image-explanation { margin-top: 5em; }"
"p.image-explanation { width: 20em; }"
"div.results-tables { margin-left: 1em; }"
"table.results { float: left; margin-left: 1em; }"
"table.restuls th { text-align: right; }"
"table.results td { text-align: right; width: 4em; }"
"div.wide-view { clear: left; }")))
(body (h2 pge-ttl)
(div class: "text-section questions-list"
(h3 class: "questions" "設問の文")
(Qs-ol questions))
(div class: "text-section results-explanation"
(h3 class: "results explanation" "結果の文")
(Rs-ol responses)
(h3 class: "text-section image-explanation" "図の説明")
(p class: "image-explanation"
"肯定的回答の4と5は正号の赤線、5は太い。" (br)
"否形的回答の1と2は負号の黒線、1は太い。"))
(div class: "text-section results-tables"
(h3 class: "results" "結果の表" )
(lsts->table ind-als)
(lsts->table dep-als)
(lsts->table uni-als))
(div class: "image-section wide-view"
(h3 class: "image" "結果の図")
(element 'img src: img-fle-for-pge))))
out))))))
(output-synoptic-view-page uni-als)
The above was pasted from this session with DrRacket:
I should learn to use git, or even just really make use of the RCS conversioning I do in Emacs as a safety measure, just in case. But as I'm learning, moving the minimum amount of code from Emacs into DrRacket lets me review while catching mistakes. I'm hoping the DrRacket, with build-path will make the code work on proprietary operating systems. If some peers get interested enough to play with the scripts and views, it might be a step toward Free Software and developing abilities beyond Office Software.
#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化 #graph #plot #Questionnaires #アンケート