Experience with Racket's path utilities over the past weeks (and today's discovery that regexp-replace works with paths!) helped to clean up the part that filters plot images.

Other work demands attention and time, but it's awful to leave code in a broken state.

code

#lang racket

(define working-directory (build-path (find-system-path 'home-dir)
             "FD"
             "FD201801H30K-0408-2"))

(make-directory* working-directory)

(define page-plot-type 'svg)
(define page-plot-strn (symbol->string page-plot-type))
(define shre-bmps-type 'png) ;; was bitmap-plot-type
(define shre-bmps-strn (symbol->string shre-bmps-type))

(define bmps-dir (symbol->string shre-bmps-type))
(make-directory* (path->complete-path bmps-dir working-directory))

(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)))))

(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


(define als-ref
  (lambda (key als)
    (if (assoc key als)
       (second (assoc key als))
       #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)))
;;  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 (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 ;; replaces pos-line-label and neg-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)

;; Replaces stck-ngtv-rslts and stck-pstv-rsltrs
(define stck-rslts
  (lambda (row #:x (x 5.5) #:algn (algn 'bottom) #:clr (clr 1) #:sign (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) algn clr))))
	   
(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))))

(define plot-bod-als-to-percentlines-countlabels
  (lambda (BodAls  Qsyms #:kind (ext 'svg))
    ;; get orginal result data into associative list: QR-als
    (let ((QR-als (dta->Qss-Als Qsyms BodAls))
          (smr (string-join (map ->plot-label (als-ref 'smr BodAls)) ""))
           (bod (->plot-label (car (als-ref 'nme BodAls)))))
      (define lines-percents-titled
	(lambda (QR)
	  (let* ((ttl (string-append smr "  " bod ":" (->plot-label (car QR))))
		 (plt-ttl (string-append ttl "  "
                                        (string-join (map ->plot-label
                                                         (als-ref 'cls BodAls)) "T/")
                                        "S   Avg: "
                                        (->plot-label
                                         (round (/ (cadr (als-ref 'cls BodAls))
                                                  (car (als-ref 'cls BodAls)))))
                                        "S"))
                 (fle-name (build-path working-directory ; remove space from ttle for filename
                                      (string-append  (regexp-replace* "  | " ttl "")
                                                    (->plot-label (car (als-ref 'smr BodAls)))
                                                    (->plot-label (cadr (als-ref 'smr BodAls)))
                                                    "."
                                                    (symbol->string ext))))) ;; use page-plot-type later
            (plot (list (hrule 0 #:color 0) ;; need this for stck-ngtv-rslts
			(lines-percents-labels-counts (cadr QR))
			(stck-rslts (cadr QR))
			(stck-rslts (reverse (cadr QR)) #:algn 'top #:clr 0 #:sign -))
		#: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))))

(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))))


(define working-files (directory-list working-directory)) ;; was dir-lis-strs
;; ".svg" working-directory
(define get-plot-files ;; was mthcd-files
  (lambda (ext-str img-pths)
    (filter (lambda (p) (path-has-extension? p ext-str))
	    img-pths)))

(define page-plot-files (get-plot-files page-plot-strn working-files))

(define body-quest-plot-name ; was bod-img
  (lambda (B Q) ; Body Question
    (let ((Brx (regexp (symbol->string B)))
	  (Qrx (regexp (symbol->string Q))))
      (path->string
       (car
	(filter (lambda (p) (regexp-match Brx p))
		(filter (lambda (p)
			  (regexp-match Qrx p))
			page-plot-files)))))))
(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)))

(define Qsym-Bdys-rslt-imgs
;; Question symbol, list of body symbols
  (lambda (qsym bdys) ;; extensiong taking care of aith get-page-plots
    (map (lambda (bdy-rx) ; Racket style define vs. cute lambda?
	   (body-quest-plot-name bdy-rx qsym))
	 bdys)))

(define rslt-img-div
  (lambda (rslt-imgs)
    (element 'div class: "result-images"
	     (map bdy-rslt-img rslt-imgs))))

;; (output-xml (map bdy-rslt-img (Qsym-Bdys-rslt-imgs '資料 bodies)))
;; <img class="result-image" src="20182H30K教員:資料20182.svg" /><img class="result-image" src="20182H30K学科:資料20182.svg" /><img class="result-image" src="20182H30K大学:資料20182.svg" />

(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) ;; To do, remove ext, not needed with new Qsym-Bdys-rslt-imgs def
    (list
     (Qsym->Qli sym questions)
     (rslt-img-div (Qsym-Bdys-rslt-imgs sym bodies)))))

(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")
                                                  (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: 12pt;} "
                                                              "h3 {margin-top: 8px; margin-bottom: 8px; font-size: 10pt; }"                 					    
                                                              "ol.response-levels {margin-left: 0em; padding-left: 0; font-size: 11pt;"
                                                              "li.response-item {display: inline; margin-left: .5em; }"       
                                                              "li {page-break-inside: avoid; } "                       
                                                              "li.ques-txt-ja { margin-left: -.7em; font-size: 13pt; }"
                                                              "div.result-images {width: 100%;} "                       
                                                              "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))))))

(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) (symbol->string page-plot-type))

;; End html page with .svg plots
;; Start png plots to png directory

(define plot-bod-als-to-percentlines-countlabels-to-bmps
  (lambda (BodAls  Qsyms #:kind (ext 'svg))
    ;; get orginal result data into associative list: QR-als
    (let ((QR-als (dta->Qss-Als Qsyms BodAls))
          (smr (string-join (map ->plot-label (als-ref 'smr BodAls)) ""))
           (bod (->plot-label (car (als-ref 'nme BodAls)))))
      (define lines-percents-titled
	(lambda (QR)
	  (let* ((ttl (string-append smr "  " bod ":" (->plot-label (car QR))))
		 (plt-ttl (string-append ttl "  "
                                        (string-join (map ->plot-label
                                                         (als-ref 'cls BodAls)) "T/")
                                        "S   Avg: "
                                        (->plot-label
                                         (round (/ (cadr (als-ref 'cls BodAls))
                                                  (car (als-ref 'cls BodAls)))))
                                        "S"))
                 (fle-name (build-path working-directory shre-bmps-strn ; remove space from ttle for filename
                                      (string-append  (regexp-replace* "  | " ttl "")
                                                    (->plot-label (car (als-ref 'smr BodAls)))
                                                    (->plot-label (cadr (als-ref 'smr BodAls)))
                                                    "."
                                                    (symbol->string ext))))) ;; use page-plot-type later
            (plot (list (hrule 0 #:color 0) ;; need this for stck-ngtv-rslts
			(lines-percents-labels-counts (cadr QR))
			(stck-rslts (cadr QR))
			(stck-rslts (reverse (cadr QR)) #:algn 'top #:clr 0 #:sign -))
		#: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))))

(define anket-reslt-alist->line-labl-chrts-w-ext
  (lambda (als Qsymbs #:ext (ext 'png))
    (parameterize ((plot-tick-size 3)
		   (plot-x-far-axis? #f)
		   (plot-y-far-axis? #f))
      (plot-bod-als-to-percentlines-countlabels-to-bmps als Qsymbs #:kind ext))))

(define write-ind-dep-uni-result-plots
  (lambda (ext-dir-sym)
      (map (lambda (als)
	     (anket-reslt-alist->line-labl-chrts-w-ext als quest-symbs #:ext ext-dir-sym))
	   (list ind-als dep-als uni-als))
    ))
      ;;(change-directory-to wrk-dir))))

(write-ind-dep-uni-result-plots shre-bmps-type)

• previous attempt: the basis of this script
  • https://write.as/bs2facdev/racket-plot-stacked-lines-labeled-positive-and-negative #Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化 #graph #plot #DataVisualization

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 #アンケート

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
  • https://write.as/bs2facdev/racket-plot-faceted-view-of-questionnaire-data #Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化 #graph #plot #DataVisualization

It was good to get that feeling that capacities/abilities/powers were growing while doing this. Racket's documentation, DrRacket, and Emacs are great for self-directed exploratory learning. With enough time to become the equivalent of a “native speaker” in Racket, developing a Graded Direct Method for learning the language could be one way of developing “effectively capable people”(I.A. Richards).

It was fun develop the script, to bring about my imagined page of Questionnaire Result visualizations while learning how to work with paths, directories and files, with scribble/html and output-xml, with regular expressions, all the little details needed to make something work.

One of the most important thing to learn with all these hours spent coding, is that nothing is magic. Working with Scheme's associative lists provides an important experience: using built-in convenience functions like assoc or self-built convenience functions like als-ref doesn't mean you can't just use the generic “primitive” functions like car(first) and cdr(rest) and their variations like cadr, caddr.... Getting a feel for map list gives the ability to freely transform data into associative lists. And Racket's sort with #:key car < made re-ordering the list or Response Types easy. And the using sort is a basic, widely useful, procedure. The reason sort als #:keyword car < seems important is because of all the time I spent searching, learning, and re-learning how to order factors in R and the tidyverse.

If there is a chance to work through a course in Statistics for Biology, I'd rather do it in Racket than R/ggplot2. DrRacket probably works the same on the proprietary systems the students and teachers seem stuck with for now. And writing learning journals in Racket's Scribble with DrRacket seems a lot more straightforward and widely useful than RMarkdown and knittr etc...

In DrRacket's Edit menu Preferences lets you get Emacs bindings, which is great for simple combinations like Ctrl-e to jump to the end of a line, but longer combinations to select all text in a buffer or switch buffers didn't work. So I'll still be developing in Emacs with Geiser-mode.

I should generate two more pages, a page for just the department and the university, and a page like this one, but with the internal bodies removed from the umbrella bodies for comparison. So the teacher's data would be removed from the departments data, and the department's from the university's. But this is enough for now. I have to go back and make Racket versions of the Guile scripts for teacher administration tasks: generating worksheets, roll-sheets, seating-charts and bureaucratic reports.

code

#lang racket

;; set the directory in which to write plot images
;;   and 
(current-directory-for-user "FD201801B")

(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 スモール 教養))
    (smr (2018 01 H30 Z)) ;; 学期 SeMesteR
    (cls (1 84))         ;; 授業、教室 CLasS
    (dta ((62 13 9 0 0)   ;; データ、DaTA
	 (19 24 28 6 6)
	 (23 24 27 6 4)
	 (53 22 9 0 0)
	 (35 29 19 0 1)
	 (64 12 7 1 0)
	 (54 19 10 1 0)
	 (69 9 6 0 0)
	 (34 28 16 4 1)
	 (43 25 12 2 1)
	 (35 25 20 2 1)))))

(define dep-als ;;学科 associative list
  '((nme (学科 DPT 教養 大学))
    (smr (2018 01 H30 Z))
    (cls (7 269))
    (dta ((202 41 26 0 0)
    (62 68 99 22 17)
    (72 74 98 14 11)
    (144 67 41 9 8)
    (111 78 55 13 10)
    (171 60 28 5 4)
    (140 65 46 10 8)
    (165 62 27 9 6)
    (96 98 51 14 8)
    (119 76 56 8 8)
    (109 79 60 9 10)))))

(define uni-als ;;大学
  '((nme (大学 UVY 南九州 学園))
    (smr (2018 01 H30 Z))
    (cls (59 2452))
    (dta ((1738 472 206 23 8)
     (495 549 923 195 283)
     (713 765 736 162 65)
     (1400 628 296 86 35)
     (1264 630 384 110 55)
     (1795 446 166 25 13)
     (1378 654 317 59 38)
     (1573 588 230 33 20)
     (976 886 438 99 42)
     (1411 684 289 33 24)
     (1217 740 388 58 38)))))

;; inspired by "Racket for Data Science" code
;;   by Nicholas M. Van Horn,  n3mo
;;    and 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)
    (point-label (vector x n) l #:anchor 'bottom #:size 8)))

(define vline-to-y
  (lambda (x y)
    (lines (map vector (list x x) (list 0 y)))))

(define lines-percents-labels-counts
  (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 ;; add ext argument 'svg (symbol->string ext)
(define plot-bod-als-to-percentlines-countlabels
  (lambda (BodAls  Qsyms)
    (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 (string-append ttl (->plot-label (car (als-ref 'smr BodAls))) (->plot-label (cadr (als-ref 'smr BodAls))) ".svg")))
	    (plot (lines-percents-labels-counts (cadr QR))
		#:x-min .2 
		#:x-max 5.8 #:y-max 100  
		#:width 400 #:height 250
		#:x-label "levels" #:y-label "percent"
		#:title plt-ttl
		#:out-file fle-name
 		#:out-kind 'svg))))
      (map lines-percents-titled QR-als))))

;; need better names
(define anket-reslt-alist->line-labl-chrts
  (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))))

;; execting plot-bod-als-to-percentlines-countlabels and
;;           anket-reslt-alist->line-labl-chrts
;; This is needed before the call to output-QsRs-page 
(map (lambda (als) (anket-reslt-alist->line-labl-chrts als quest-symbs))
     (list ind-als dep-als uni-als))
;; 教員:理解201801.png 学科:役立201801.png 大学:資料201801.png

;; 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))
	    (mtchd-files rxQ "."))))
;; (bod-img #rx"大学" #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"大学:" #rx"理解" ".")))
;; <img class="result-image" src="大学:理解201801.png" />

;; get list of result images in bodies order for rslt-img-div

(define symbol->regexp
  (lambda (sym)
    (regexp (symbol->string sym))))
;; Question symbol, list of body symbols
(define Qsym-Bdys-rslt-imgs
  (lambda (qsym bdys)
    (map (lambda (bdy-rx)
	   (bod-img bdy-rx (symbol->regexp qsym)))
	 (map symbol->regexp 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
  (lambda (sym Qs)
    (element 'li class: "ques-txt-ja"
	     (als-ref sym Qs))))
(define Q-li-Rs-div
  (lambda (sym)
    (list
     (Qsym->Qli sym questions)
     (rslt-img-div (Qsym-Bdys-rslt-imgs sym bodies)))))
(define Qs-w-Rs->ol
  (lambda (syms)
    (element 'ol class: "questions-with-results"
	     (map Q-li-Rs-div 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)
    (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 (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: -.8em; 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: -.8em; 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)
					     ;; (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)

;; 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)))))
      (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 (string-append ttl (->plot-label (car (als-ref 'smr BodAls))) (->plot-label (cadr (als-ref 'smr BodAls)))
                                         "." (->plot-label ext))))
	    (plot (lines-percents-labels-counts (cadr QR))
		#:x-min .2 
		#:x-max 5.8 #:y-max 100  
		#: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))))

(if (directory-exists? "pngs")
   (map delete-file (map (lambda (f) (build-path "pngs" f))
                        (directory-list "pngs")))
   (make-directory "pngs"))

(current-directory "pngs");; I don't know why I need this... 
(current-directory-for-user "pngs")
(map (lambda (als) (anket-reslt-alist->line-labl-chrts-w-ext als quest-symbs 'png))
     (list ind-als dep-als uni-als))

• More images: https://snap.as/bsmall2/racket-plot-2-output-page

#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化

Discussion in Diaspora* post comments provides motivation to explore more code and presentation. (fn:1~

Now I have to see about getting these separate images aligned into one eye-span for analytical viewing.

• https://snap.as/bsmall2/racket-plot-1/jSH8sgR
• (fn:1) Diaspora* post and discussion in comments

code

#lang racket

(current-directory "FD201801")
(current-directory-for-user "FD201801")

(require plot) ;; discrete-histogram, stacked-histogram etc
(require plot/utils) ;; ->plot-label

;; Questions Symbols
(define quest-symbs '(出席 発言 取組 聞取 資料 時刻 反応 熱意 理解 役立 満足))


;; データを入力し直すところ
(define ind-als ;;教員の連帯リスト associative list
  '((nme (教員 TCR スモール 教養))
    (smr (2018 1 H30 Z)) ;; 学期 SeMesteR
    (cls (1 84))         ;; 授業、教室 CLasS
    (dta ((62 13 9 0 0)   ;; データ、DaTA
	 (19 24 28 6 6)
	 (23 24 27 6 4)
	 (53 22 9 0 0)
	 (35 29 19 0 1)
	 (64 12 7 1 0)
	 (54 19 10 1 0)
	 (69 9 6 0 0)
	 (34 28 16 4 1)
	 (43 25 12 2 1)
	 (35 25 20 2 1)))))

(define dep-als ;;学科 associative list
  '((nme (学科 DPT 教養 大学))
    (smr (2018 1 H30 Z))
    (cls (7 269))
    (dta ((202 41 26 0 0)
    (62 68 99 22 17)
    (72 74 98 14 11)
    (144 67 41 9 8)
    (111 78 55 13 10)
    (171 60 28 5 4)
    (140 65 46 10 8)
    (165 62 27 9 6)
    (96 98 51 14 8)
    (119 76 56 8 8)
    (109 79 60 9 10)))))

(define uni-als ;;大学
  '((nme (大学 UVY 南九州 学園))
    (smr (2018 1 H30 Z))
    (cls (59 2452))
    (dta ((1738 472 206 23 8)
     (495 549 923 195 283)
     (713 765 736 162 65)
     (1400 628 296 86 35)
     (1264 630 384 110 55)
     (1795 446 166 25 13)
     (1378 654 317 59 38)
     (1573 588 230 33 20)
     (976 886 438 99 42)
     (1411 684 289 33 24)
     (1217 740 388 58 38)))))

;; inspired by "Racket for Data Science" code
;;   by Nicholas M. Van Horn n3mo's 
(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)
    (point-label (vector x n) l #:anchor 'bottom)))

(define vline-to-y
  (lambda (x y)
    (lines (map vector (list x x) (list 0 y)))))

(define lines-percents-labels-counts
  (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))))

(define plot-bod-als-to-percentlines-countlabels
  (lambda (BodAls  Qsyms)
    (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))))
		 (fle-name (string-append ttl (->plot-label (car (als-ref 'smr BodAls))) "0" (->plot-label (cadr (als-ref 'smr BodAls))) ".png")))
	    (plot (lines-percents-labels-counts (cadr QR))
		#:x-min .2 #:y-max 100 
		#:x-max 5.8 #:height 250
		#:width 400 #:y-label "percent"
		#:x-label "levels"
		#:title ttl
		#:out-file fle-name
 		#:out-kind 'png))))
      (map lines-percents-titled QR-als))))

;;; Working!!		
(parameterize ((plot-tick-size 3)
                (plot-x-far-axis? #f)
                (plot-y-far-axis? #f))
  (plot-bod-als-to-percentlines-countlabels uni-als quest-symbs))

#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化

code

#lang racket

(require plot) ;; discrete-histogram, stacked-histogram etc
(require plot/utils) ;; ->plot-label

(define listsmpl '(62 13 9 0 0))

(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)
    (point-label (vector x n) l #:anchor 'bottom)))

(define vline-to-y
  (lambda (x y)
    (lines (map vector (list x x) (list 0 y)))))

(define lines-percents-labels-counts
  (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)))))))

(plot (lines-percents-labels-counts listsmpl)
     #:y-max 100 #:x-min .2 #:x-max 5.8
      #:width 300 #:height 250
     #:x-label "levels"  #:y-label "percent")

#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化

This code is still clumsy, the process isn't clear enough in my mind for elegant solutions. But working through the process is great for learning. This may be a way to re-discover the faceting that R/ggplot2 makes possible. I think this is the best way to get a feel for how an individual teachers results are situated in relation to the groups: the individual's department and school.

It would be great to get Racket-competent students and citizens with questions to explore. We could implement the Questionnaires and their Visualization ourselves, with good questions it might be possible to continue the work of Ignacio Martin-Baro and Ignacio Ellacuria “Towards a Society that Serves its People”. In the meantime these Faculty Development Questionnaires provide data for training in computer languages, data transformations, and information designs.

Although DrRacket is great, Emacs keybindings for going to the start and end of lines, for switching buffers and windows, for going to the head or tail of a buffer, and the keyboard macros just make development smoother.

It's always a shock to press [Ctrl]-[e] and have a DrRacket panel disappear. But DrRacket is fun, the arrows that show you where definitions come from....

code

#lang racket

 (current-directory "FD201801")
 (current-directory-for-user "FD201801")

;;(require racket/format) ;; for ~r #:precision
;;(require plot/utils) ;; linear-seq exact->inexact
(require plot) ;; discrete-histogram, stacked-histogram etc
;; (require scribble/html/html) ;; to view png files in browser
;; (require scribble/html) ;; output-xml to make .html page for browser

;; (define RsEng (map (lambda (l) (list (car l) (cadddr l))) responses))
;; (define QsEng (map cadr questions-English))

(define quest-symbs '(出席 発言 取組 聞取 資料 時刻 反応 熱意 理解 役立 満足))

(define ind-als ;;教員の連帯リスト associative list
  '((nme (教員 TCR スモール 教養))
    (smr (2018 1 H30 Z)) ;; 学期 SeMesteR
    (cls (1 84))         ;; 授業、教室 CLasS
    (dta ((62 13 9 0 0)   ;; データ、DaTA
	 (19 24 28 6 6)
	 (23 24 27 6 4)
	 (53 22 9 0 0)
	 (35 29 19 0 1)
	 (64 12 7 1 0)
	 (54 19 10 1 0)
	 (69 9 6 0 0)
	 (34 28 16 4 1)
	 (43 25 12 2 1)
	 (35 25 20 2 1)))))

(define dep-als ;;学科 associative list
  '((nme (学科 DPT 教養 大学))
    (smr (2018 1 H30 Z))
    (cls (7 269))
    (dta ((202 41 26 0 0)
    (62 68 99 22 17)
    (72 74 98 14 11)
    (144 67 41 9 8)
    (111 78 55 13 10)
    (171 60 28 5 4)
    (140 65 46 10 8)
    (165 62 27 9 6)
    (96 98 51 14 8)
    (119 76 56 8 8)
    (109 79 60 9 10)))))

(define uni-als ;;大学
  '((nme (大学 UVY 南九州 学園))
    (smr (2018 1 H30 Z))
    (cls (59 2452))
    (dta ((1738 472 206 23 8)
     (495 549 923 195 283)
     (713 765 736 162 65)
     (1400 628 296 86 35)
     (1264 630 384 110 55)
     (1795 446 166 25 13)
     (1378 654 317 59 38)
     (1573 588 230 33 20)
     (976 886 438 99 42)
     (1411 684 289 33 24)
     (1217 740 388 58 38)))))

(define als-ref
  (lambda (idx als)
    (let ((tmp (assv idx als)))
      (if tmp (cadr tmp) #f))))

(define count->percent
  (lambda (lst) ;; list of lists
    (let ((total (apply + lst)))
      (map (lambda (cnt)
	     (* (/ cnt total) 100.0))
	   lst))))
;; might need to truncate decimal places for labels later
;; in plot/utils  (real->decimal-string num 2) (r->d-s num min)
(define vctrz-rspns-prcnt
  (lambda (lst)
    (map vector '(5 4 3 2 1) (count->percent lst))))
(define labl-from-alst
  (lambda (als)
    (format "~a~a" (car (als-ref 'nme als)) (cadr (als-ref 'nme als)))))

(define intrleav-3-dsct-hstm-1
  (lambda (l1 l2 l3)
    (list
     (discrete-histogram
      l1
      #:skip 3.5 #:x-min 0
      #:label "教員TCR") ;; 教員
     (discrete-histogram
      l2
      #:skip 3.5 #:x-min 1  ;; 学科
      #:label "学科DEP" #:color 2 #:line-color 2)
     (discrete-histogram
      l3
      #:skip 3.5 #:x-min 2  ;; 大学
      #:label "大学UVY" #:color 4 #:line-color 4))))

(map (lambda (l1 l2 l3 Q)
       (plot (intrleav-3-dsct-hstm-1
	      (vctrz-rspns-prcnt l1)
	      (vctrz-rspns-prcnt l2)
	      (vctrz-rspns-prcnt l3))
	     #:title (symbol->string Q) #:x-label "Response Level"
             #:y-label "Percent" #:y-max 100
             #:legend-anchor 'top-right
             #:height 300))
     (als-ref 'dta ind-als)
     (als-ref 'dta dep-als)
     (als-ref 'dta uni-als)
     quest-symbs)
;; need a function that will take alists and plot to file

(define plot-3-alsts-intrleaved-to-file
  (lambda (als1 als2 als3 Qsymbs)
    (map (lambda (l1 l2 l3 Q)
	   (plot-file (intrleav-3-dsct-hstm-1
		       (vctrz-rspns-prcnt l1)
		       (vctrz-rspns-prcnt l2)
		       (vctrz-rspns-prcnt l3))
		      #:title (symbol->string Q)
		      #:x-label "Response Value"
		      #:y-label "Percent%"
		      #:y-max 100
		      #:legend-anchor 'top-right
                      #:height 300
		      (format "~a~a~a~a.png" (symbol->string Q)
			       (car (als-ref 'smr als1))
			       0
			       (cadr (als-ref 'smr als1)))
		      'png))
	 (als-ref 'dta als1)
	 (als-ref 'dta als2)
	 (als-ref 'dta als3)
	 Qsymbs)))

(plot-3-alsts-intrleaved-to-file ind-als dep-als uni-als quest-symbs)

#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化

I imagine DrRacket will make the code below work with a Windows computer too. How would Windows users be able to find their home directory, Racket's (current-directory) and get their bowser to show “/FD201801/FD-Anketo-Results.html”... The file-separator slashes are probably different too. But that sort of detail can be overcome when a Windows user shows an interest in testing the code and visualization...

It was good training to work with associative lists, to use two a-lists to generate a new a-list. Using a-lists allows for the generation of useful titles and file names that match the data used for the visualization. 教員抜き大学の結果： 大学w-o教員 The image below is a visualization of the university data with one teacher's results removed. A teacher's comment about the difficulty in interpreting result averages without reference to the department averages and the minimum and maximum values prompted the “w-o” data and visualization exercise.

Reading a Japanese book about Gauche Scheme helped me see how important it is to get the data into structures that make the work go smoothly.

code

#lang racket

;; Generate Data Visualizations for Questionnaire Results
;;  let teachers see their results 
;;   see relations to their department and university
;;  ~/FD201801/FD-Anketo-Results.html

;; 画像ファイル、.htmlページを書き込むフォルダー:directory
(make-directory* "FD201801")
(current-directory "FD201801")
(current-directory-for-user "FD201801")

(require plot) 
(require scribble/html/html) ;; to view png files in browser
(require scribble/html) ;; output-xml to make .html page for browser

;; データを入力し直すところ
(define ind-als ;;教員の連帯リスト associative list
  '((nme (教員 TCR スモール 教養))
    (smr (2018 1 H30 Z)) ;; 学期 SeMesteR
    (cls (1 84))         ;; 授業、教室 CLasS
    (dta ((62 13 9 0 0)   ;; データ、DaTA
	 (19 24 28 6 6)
	 (23 24 27 6 4)
	 (53 22 9 0 0)
	 (35 29 19 0 1)
	 (64 12 7 1 0)
	 (54 19 10 1 0)
	 (69 9 6 0 0)
	 (34 28 16 4 1)
	 (43 25 12 2 1)
	 (35 25 20 2 1)))))

(define dep-als ;;学科 associative list
  '((nme (学科 DPT 教養 大学))
    (smr (2018 1 H30 Z))
    (cls (7 269))
    (dta ((202 41 26 0 0)
    (62 68 99 22 17)
    (72 74 98 14 11)
    (144 67 41 9 8)
    (111 78 55 13 10)
    (171 60 28 5 4)
    (140 65 46 10 8)
    (165 62 27 9 6)
    (96 98 51 14 8)
    (119 76 56 8 8)
    (109 79 60 9 10)))))

(define uni-als ;;大学
  '((nme (大学 UVY 南九州 学園))
    (smr (2018 1 H30 Z))
    (cls (59 2452))
    (dta ((1738 472 206 23 8)
     (495 549 923 195 283)
     (713 765 736 162 65)
     (1400 628 296 86 35)
     (1264 630 384 110 55)
     (1795 446 166 25 13)
     (1378 654 317 59 38)
     (1573 588 230 33 20)
     (976 886 438 99 42)
     (1411 684 289 33 24)
     (1217 740 388 58 38)))))

;; Questions Symbols
(define quest-symbs '(出席 発言 取組 聞取 資料 時刻 反応 熱意 理解 役立 満足))

;; short symbol for Qquestion, Japanese Sentence,  short symbol for Q-type
(define questions '(
(出席 	"私はこの授業によく出席した"                                              学生取組)
(発言 	"私は授業内容について質問や発言した"                                      学生取組)
(取組 	"私はこの科目に積極的に取り組んだ(予習と復習した)"                      学生取組)
(聞取 	"教員の声は聞き取りやすかった。"                                          教員実施)
(資料 	"教員の板書（またはPPT・配布資料など）は読みやすかった（見やすかった）"   教員実施)
(時刻 	"教員は授業の開始・終了の時刻を守ろうとしていた"                          教員実施)
(反応 	"教員は学生の反応を確かめながら授業を進めていた"                          教員実施)
(熱意 	"教員は熱意を持って授業をしていた"                                        教員実施)
(理解 	"私はこの授業内容を理解できた"                                            総合評価)
(役立 	"私はこの授業で学んだ内容はなんらかの形で将来的に役立つと感じた"          総合評価)
(満足 	"私は総合的に判断してこの授業で満足が得られた"                            総合評価)))

;; Japanese short symbol key, quest-symbs, English word short key, English Translation
(define questions-English '(
(出席 attended "I attended this class often")
(発言 spoke "I made remarks or questions about this class")
(取組 engaged "I actively engaged with this subject (I studied before and after class)")
(聞取 heard "The teacher's voice was easy to hear")
(資料 seen "The teacher's board-work, presentations, and printouts were easy to read(see)")
(時刻 timed "The teacher started and ended the class on time")
(反応 responsive "The teacher checked for student responses in the class")
(熱意 enthused "The teacher was enthused to do the class")
(理解 comprehended "I comprehended this class's content")
(役立 valued "I felt that the content of this class will be of use in some form in the future")
(満足 satisfied "I am satisfied with the class overall")))

;; number, short symbol, Japanese Sentence, English Translation
(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")))


;; remove ind results from dep results
;; and dep results from uni
(define als-ref
  (lambda (idx als)
    (let ((tmp (assv idx als)))
      (if tmp (cadr tmp) #f))))

(define remove-internal-data
  (lambda (base umbrella)
    (map (lambda (list-pair)
	   (map - (car list-pair)(cadr list-pair)))
	 (map list umbrella base))))


;; "w-o" means without or 抜き
(define removed-prt-into-nme
  (lambda (bse-als grp-als)
    (cons 'nme (list
	  (cons (string->symbol
		 (string-join (list (symbol->string (caadr (assoc 'nme grp-als)))(symbol->string (caadr (assoc 'nme bse-als)))) "w-o"))
		(cdr (als-ref 'nme grp-als)))))))

(define remove-internal-body-als
  (lambda (bse-als grp-als)
    (list (removed-prt-into-nme bse-als grp-als)
	  (assoc 'smr grp-als) ;; keep the same
	  (cons 'cls (list
		      (map - (als-ref 'cls grp-als)
			   (als-ref 'cls bse-als))))
	  (cons 'dta (list
		      (remove-internal-data
		       (als-ref 'dta bse-als)
		       (als-ref 'dta grp-als)))))))
;; (remove-internal-body-als dep uni)

;; responses must be in form (Int "Str")
;; like '(5 "very much" ... ) (4 "多少")
(define stack-plot-body
  ;; Questions Numbers Responses
  (lambda (Qstns Alst Rspns) ;; Questions, Numbers, Responses
    (plot (stacked-histogram
	   (reverse (map vector Qstns (als-ref 'dta Alst)))
	   #:invert? #t
	   #:add-ticks? #t
	   #:labels (map (lambda (l)
			   (format "~s ~s"
				   (car l) (cadr l)))
			 Rspns)
	   #:colors '(-7 -6 -5 -4 -3 -2 -1 0)
	   #:line-colors '(-7 -6 -5 -4 -3 -2 -1 0)
	   #:styles '(2 4 5 6 3)
	   #:line-widths '(1 1 1 1 1)
	   #:gap .5
	   )
	  #:legend-anchor 'top-right
	  #:width 600
	  #:height 250
	  #:x-label "枚数 Responses"
	  #:y-label "設問 Questions"
	  #:title (format "~a ~a ~a" (car (als-ref 'nme Alst))
			  (car (als-ref 'smr Alst))
			  (cadr (als-ref 'smr Alst)))
	  )))
;; (stack-plot-body quest-symbs ind responses)
;; (stack-plot-body quest-symbs (remove-internal-body-als ind-als dep-als) responses)
;; (stack-plot-body quest-symbs (remove-internal-body-als ind-als uni-als) responses)

(define als-dat-to-png-nam
  (lambda (Alst)
    (format "~a~a~a~a.png"
	    (car (als-ref 'nme Alst))
	    (car (als-ref 'smr Alst))
	    0
	    (cadr (als-ref 'smr Alst)))))

;; ;; For printing the commented out plot colors and styles might be
;; ;; nice, the defaults may be better for comparing in browser
;; (define stack-plot-body-to-file
;;   ;; Questions Numbers Responses
;;   (lambda (Qstns Alst Rspns) ;; Questions, Numbers, Responses
;;     (plot-file (stacked-histogram
;; 	   (reverse (map vector Qstns (als-ref 'dta Alst)))
;; 	   #:invert? #t
;; 	   #:add-ticks? #t
;; 	   #:labels (map (lambda (l)
;; 			   (format "~s ~s"
;; 				   (car l) (cadr l)))
;; 			 Rspns)
;; 	   #:colors '(-7 -6 -5 -4 -3 -2 -1 0)
;; 	   #:line-colors '(-7 -6 -5 -4 -3 -2 -1 0)
;; 	   #:styles '(2 4 5 6 3)
;; 	   #:line-widths '(1 1 1 1 1)
;; 	   #:gap .5
;; 	   )
;; 	  #:legend-anchor 'top-right
;; 	  #:width 600
;; 	  #:height 250
;; 	  #:x-label "枚数 Responses"
;; 	  #:y-label "設問 Questions"
;; 	  #:title (format "~a ~a ~a" (car (als-ref 'nme Alst))
;; 			  (car (als-ref 'smr Alst))
;; 			  (cadr (als-ref 'smr Alst)))
;; 	  ;; file arguments, file name and mode
;; 	  (als-dat-to-png-nam Alst)
;; 	  'png
;; 	  )))


;; end of definitions preparation
;;; start to write files
;; (map (lambda (als) (stack-plot-body-to-file quest-symbs als responses)) plot-to-file)

(define plot-to-file (list ind-als dep-als uni-als
			       (remove-internal-body-als ind-als dep-als)
			       (remove-internal-body-als dep-als uni-als)
			       (remove-internal-body-als ind-als uni-als)))

(define stack-deflt-plot-body-to-file
  ;; Questions Numbers Responses
  (lambda (Qstns Alst Rspns) ;; Questions, Numbers, Responses
    (plot-file (stacked-histogram
	   (reverse (map vector Qstns (als-ref 'dta Alst)))
	   #:invert? #t
	   #:add-ticks? #t
	   #:labels (map (lambda (l)
			   (format "~s ~s"
				   (car l) (cadr l)))
			 Rspns)
	   )
	  #:legend-anchor 'top-right
          #:width 800
	  #:height 250
	  #:x-label "枚数 Responses"
	  #:y-label "設問 Questions"
	  #:title (format "~a ~a ~a" (car (als-ref 'nme Alst))
			  (car (als-ref 'smr Alst))
			  (cadr (als-ref 'smr Alst)))
	  ;; file arguments, file name and mode
	  (als-dat-to-png-nam Alst)
	  'png
	  )))

(map (lambda (als) (stack-deflt-plot-body-to-file quest-symbs als responses)) plot-to-file)

(define png-fls (map als-dat-to-png-nam plot-to-file))


(call-with-output-file "FD-Anketo-Results.html" #:exists 'truncate
  (lambda (out)
    (output-xml (xhtml
		 (head (title "FD アンケート結果 視覚化 1")
		       (meta http-equiv: "Content-Type" content: "text/html;charset=utf-8")
		       (style "img.stacked-histogram { margin-bottom: 5px; }"))
		 (body (map (lambda (f) (element 'img class: "stacked-histogram"  src: f)) png-fls))) out)))

#Scheme #Racket #FS4FT #FS4FD #facdev #FacultyDevelopment #DataVisualizatoin #アンケート #データ視覚化

Faculty Development Questionnaires give me an opportunity to work with Racket. Until now the questionnaire data provided opportunities to learn data visualization with two other languages: gnuplot with Philip Janert's book, and R/ggplot2 with Hadley Wickham's book. But for more regular work I was using emacs-lisp with org-mode. Without weekly practice with language like gnuplot or R/ggplot2, it was always a struggle to get back into the data manipulation and visualization flow once every six months. Recently my regular work goes well with Scheme.(fn:1) Guile Scheme is more compact that org-mode and emacs-lisp for converting jpg images to png and svg images and for generating worksheets, roll-sheets, and seating charts. However, I am not yet able to graph/plot/chart with Guile. Racket's plot lets me work well with Questionnaire data.

It will be interesting to learn how to plot and label points at will, and how to adjust colors, but in the meantime racket/plot's stacked-histograms provide compact visualizations that may serve as springboards for discussion. I made the English version, to make it easier for non-Japanese readers to follow the code. Seeing two versions clearly shows the advantages of Chinese characters for compact information design.

There are eleven questions on the school's questionnaire. The first three questions attempt to gauge students feelings their participation in the class. What are their feelings about how often they `attended`出席 the class, how much they `spoke` in the class, and how much they `engaged` in the class. The next five questions gauge the students perceptions of how well they `heard` the teacher's voice, how they had `seen` the teacher's materials, how well `timed` the teacher's starting and ending of the classwas, how `responsive` the teacher was, as well as how `enthused` the teacher may have been. The last three questions are about overall perceptions of how much the student `comprehended` and `valued` the class, ending with a overall ranking of how `satisfied` the student is with the classes experienced so far. The questionnaires are usually filled out during the 13th or 14th class a 15-class semester. Students respond to the questions by circling a number in the range from five to one, inclusive. Five means they `very much` agree that they frequently `attended` the class, or that the teacher was `enthused` (for example). One means that `not at all` do they agree that the the teacher `timed` the starting and ending of the class well, or that they `valued` the classes usefulness in some manner. Teachers are provided with the results of the questionnaires given in the class of their choice.

The data entry and visualization is out-sourced. Working with R/ggplot2 and talking with a teacher of statistics gave me the idea that averages/means are not sensible when gauging feelings/perceptions. Our feelings of agreement do not change one unit at a time from “very much” to “not at all”. It would be interesting if there were a unit of measurement like a gram or a centimeter for agreeing, though we may need a rate: like miles per hour for running.

Besides the use of means(平均値) for factors, the changes in scale from question to question can give the impression that 198 is smaller than 102, and that 59 is smaller than 50. Redoing the same sort of bar chart with R/ggplot2 avoids disorientation from scale adjustments. (fn:2)

I am not yet able to label points with Racket/plot the way I can do so freely with R/ggplot2. But Racket's stacked-histogram plots provide for the same sort of visual comparison in a way that is compact enough to allow comparison of three different entities, the individual teacher, the teacher's department, and the entire university. I don't yet know how to append plots to a file so I had to use ImageMagick(the code is below) to combine the plot-files. The stacked-histogram approach seems promising too. I feel much more comfortable manipulating data in Scheme with nested maps than I do with half-remembered, half-understood techniques in R. Now if I can learn to place and label points and control colors the way I can with ggplot2 I'll be able to stay in scheme for a more coherent computing experience and better chance of developing more advanced programming skills.

After removing the individual's results from the deparment's, and the department's from the university's, I have to re-calculate the average class size for the department and university. The quickest way to fix that bug would be to remove AvgClassSize from the title, but I always wonder how much results are influenced simply by class size. With years of data curiosity supplies a number of questions to be explored...

I have three questions about the presentation details: 1. How can the legend be replaced with numbers and words inside the bars? 2. How can the ends the numbers of responses be placed just inside the end of the bars? 3. How can I change to color scheme?

In the documentation I saw an explanation for `point-label` on the 2D Renderers page and section for `Colors and Styles` in the Introduction to Plot: Graph Plotting documentation: so there are places to read and get started working on the details.

Interleaving

I also have to discover ways interleave histograms as shown on the 2D Renderers page. The challenges is how to structure the data so that each question type from each entity: individual, department, and univesity is interleaved and within the question the responses: 5, 4, 3, 2, and 1 are also interleaved. With Racket/Scheme techniques interleaving may be surprisingly within reach.

code

;; Generate Data Visualizations for Questionnaire Results ;; let teachers see their results ;; in relation to their department and university

;; ind, dep, uni: alternative names (define body-types '((individual 教員) ;; ind (department 学科) ;; dep (university 大学)));; uni

;; Short symbols and English for Questionsattendance, ;; these characters might help avoid repetitions later (define quest-symbs '(出席 発言 取組 聞取 資料 時刻 反応 熱意 理解 役立 満足))

;; short symbol for Qquestion, Japanese Sentence, short symbol for Q-type (define questions '( (出席 “私はこの授業によく出席した” 学生取組) (発言 “私は授業内容について質問や発言した” 学生取組) (取組 “私はこの科目に積極的に取り組んだ（予習と復習した）” 学生取組) (聞取 “教員の声は聞き取りやすかった。” 教員実施) (資料 “教員の板書（またはPPT・配布資料など）は読みやすかった（見やすかった）” 教員実施) (時刻 “教員は授業の開始・終了の時刻を守ろうとしていた” 教員実施) (反応 “教員は学生の反応を確かめながら授業を進めていた” 教員実施) (熱意 “教員は熱意を持って授業をしていた” 教員実施) (理解 “私はこの授業内容を理解できた” 総合評価) (役立 “私はこの授業で学んだ内容はなんらかの形で将来的に役立つと感じた” 総合評価) (満足 “私は総合的に判断してこの授業で満足が得られた” 総合評価)))

;; Japanese short symbol key, English word short key, English Translation (define questions-English '( (出席 attended “I attended this class often”) (発言 spoke “I made remarks or questions about this class”) (取組 engaged “I actively engaged with this subject (I studied before and after class)”) (聞取 heard “The teacher's voice was easy to hear”) (資料 seen “The teacher's board-work, presentations, and printouts were easy to read(see)”) (時刻 timed “The teacher started and ended the class on time”) (反応 responsive “The teacher checked for student responses in the class”) (熱意 enthused “The teacher was enthused to do the class”) (理解 comprehended “I comprehended this class's content”) (役立 valued “I felt that the content of this class will be of use in some form in the future”) (満足 satisfied “I am satisfied with the class overall”)))

;; number, short symbol, Japanese Sentence, English Translation (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”))) ;; semester data Japanese Year, year, first 1 or second 2 semester (define sem '(H30 2018 1)) ;; body data: number of teachers, questionnaires (define uni-dat '(59 2452)) ;;大学 (define dep-dat '(7 269)) ;;学科 (define ind-dat '(1 84)) ;;教員 (define ind ;;教員 '((62 13 9 0 0) (19 24 28 6 6) (23 24 27 6 4) (53 22 9 0 0) (35 29 19 0 1) (64 12 7 1 0) (54 19 10 1 0) (69 9 6 0 0) (34 28 16 4 1) (43 25 12 2 1) (35 25 20 2 1)))

(define dep ;;学科 '((202 41 26 0 0) (62 68 99 22 17) (72 74 98 14 11) (144 67 41 9 8) (111 78 55 13 10) (171 60 28 5 4) (140 65 46 10 8) (165 62 27 9 6) (96 98 51 14 8) (119 76 56 8 8) (109 79 60 9 10)))

(define uni ;;大学 '((1738 472 206 23 8) (495 549 923 195 283) (713 765 736 162 65) (1400 628 296 86 35) (1264 630 384 110 55) (1795 446 166 25 13) (1378 654 317 59 38) (1573 588 230 33 20) (976 886 438 99 42) (1411 684 289 33 24) (1217 740 388 58 38)))

;; remove ind results from dep results ;; and dep results from uni (define remove-internal-body (lambda (base umbrella) (map (lambda (list-pair) (map – (car list-pair)(cadr list-pair))) (map list umbrella base)))) ;; (remove-internal-body dep uni)

;; responses must be in form (Int “Str”) ;; like '(5 “very much” ... ) (4 “多少”) (define stack-plot-body ;; Questions Numbers Responses (lambda (Qs Ns Rs) ;; Questions, Numbers, Responses (plot (stacked-histogram (reverse (map vector Qs Ns)) #:invert? #t #:add-ticks? #t #:labels (map (lambda (l) (format “~s ~s” (car l) (cadr l))) Rs)) #:legend-anchor 'top-right))) ;; (stack-plot-body quest-symbs ind responses) ;; replace ind with dep and then uni to visualize ;; responses for umbrella bodies (parameterize ((plot-width 800) (plot-x-label “枚数 Responses”) (plot-y-label “設問 Questions”)) (stack-plot-body quest-symbs ind responses))

(parameterize ((plot-width 800) (plot-x-label “枚数 Responses”) (plot-y-label “設問 Questions”)) (list (stack-plot-body quest-symbs ind responses) (stack-plot-body quest-symbs dep responses) (stack-plot-body quest-symbs uni responses))) ;; Questions Numbers Responses SemesterData BodyData

(define stack-plot-body-ttld (lambda (Qs Ns Rs Sd Bd) (plot (stacked-histogram (reverse (map vector Qs Ns)) #:invert? #t #:add-ticks? #t #:labels (map (lambda (l) (format “~s ~s” (car l)(cadr l))) Rs)) #:legend-anchor 'top-right #:title (format “Year:~a Semester:~a Teachers:~a Students:~a” (cadr Sd) (caddr Sd) (car Bd)(cadr Bd)))))

(stack-plot-body-ttld quest-symbs dep responses sem dep-dat)

(parameterize ((plot-width 800) (plot-height 300) (plot-x-label “枚数 Responses”) (plot-y-label “設問 Questions”)) (list (stack-plot-body-ttld quest-symbs ind responses sem ind-dat) (stack-plot-body-ttld quest-symbs dep responses sem dep-dat) (stack-plot-body-ttld quest-symbs uni responses sem uni-dat)))

(require plot/no-gui) ;; for plot-file (require racket/format) ;; for ~r #:precision ;; Questions Numbers Rsponses SemesterData BodyData BodyTypeString (define stack-plot-body-ttld-file (lambda (Qs Ns Rs Sd Bd Bt) (plot-file (stacked-histogram (reverse (map vector Qs Ns)) #:invert? #t #:add-ticks? #t #:labels (map (lambda (l) (format “~s ~s” (car l)(cadr l))) Rs)) #:legend-anchor 'top-right #:title (format “Year:~a Semester:~a Teachers:~a Students:~a AvgClassSize:~a” (cadr Sd) (caddr Sd) (car Bd)(cadr Bd) (~r (/ (cadr Bd)(car Bd)) #:precision 1)) (format “~a~a~a~a~a.png” Bt (cadr Sd) (caddr Sd) (car Bd)(cadr Bd)) 'png))) ;;(stack-plot-body-ttld-file quest-symbs dep responses sem dep-dat “Dep”) ;; Success!!

(parameterize ((plot-width 700) (plot-height 250) (plot-x-label “枚数 Responses”) (plot-y-label “設問 Questions”)) (stack-plot-body-ttld-file quest-symbs ind responses sem ind-dat “TCRwo”) (stack-plot-body-ttld-file quest-symbs (remove-internal-body ind dep) responses sem dep-dat “DPTwoTCR”) (stack-plot-body-ttld-file quest-symbs (remove-internal-body dep uni) responses sem uni-dat “UVYwoDPT”))

(define RsEng (map (lambda (l) (list (car l) (cadddr l))) responses)) (define QsEng (map cadr questions-English))

(parameterize ((plot-width 700) (plot-height 250) (plot-x-label “Responses”) (plot-y-label “Question Type”)) (stack-plot-body-ttld-file QsEng uni RsEng sem uni-dat “UniEng”)) ;; end of stacked-histogram code

montage -tile 1x -geometry 750x TCRwo20181184.png DPTwoTCR201817269.png UVYwoDPT20181592452.png TCRwoDPTwoUVYwo.png

footnotes

• (fn:1) Regular Work with Scheme

  • https://write.as/bs2gs/batch-convert-image-files
  • https://write.as/bs2gs/from-csv-file-generate-roll-sheet-and-seat-chart
  • https://write.as/bs2gs/from-list-data-to-html-page-with-guile

• (fn:2)

  • https://write.as/bs2facdev/anketo-questionnaire-visualization-with-r-ggplot2

#Racket #RacketLang #RacketLanguage #Scheme #Programming #DataVisualization #FD #FacDev #FacultyDevelopment #アンケート #データ視覚化 #FS4FT #FS4FD