Another Album

• https://snap.as/bsmall2/fd-racket

https://snap.as/bsmall2/fd-racket

• https://ruhrspora.de/posts/3357215
• https://write.as/bs2facdev/questionnaire-visualization

201801アンケートデータ視覚化

code

#lang racket

(define my-home (find-system-path 'home-dir))
(define learning-directory "Learning-Racket")
(define facdev-directory "FD")
;; ~/home-directory/Learning-Racket/FD"
(define data-file "DG-2018-1-Frequencies.csv")

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

;; KaiTou.csv
;; 5, 特に,特にそう思う
;; 4, 多少,多少そう思う
;; 3, どちも,どちらともいえない
;; 2, あまり,あまりそう思わない
;; 1, 全く,全くそう思わない

(define working-directory (build-path my-home learning-directory facdev-directory))
(current-directory-for-user working-directory)
(define data-path (build-path working-directory data-file))
(define get-data
  (lambda (pth)
    (let* ((inp (open-input-file pth))
	   (lines (port->lines inp)))
      (close-input-port inp)
      (map (lambda (s) (string-split
			(regexp-replace* "\"" s "")
				     ","))
	   lines))))

(define fd-data (get-data data-path))
(define info-data (list (first fd-data) (second fd-data)))
(define data-labels (cddr fd-data))
(define questions-ja (get-data (build-path working-directory Q-ja-file)))

(define (transpose-table tbl)
  (define (helper tbl dict) ; dictionary
    (cond
     ((empty? (first tbl)) (reverse dict))
     (#t (helper (map cdr tbl) (cons (cons (first (first tbl))
					   (map first (cdr tbl)))
				     dict)))))
  (helper tbl '()))

;; from info-lines generate plot-title and file-name
(define info-dict (transpose-table info-data))
(define (plot-title-join dict)
  (define (title-part entry)
    (string-join entry ":"))
  (map title-part dict))
(define plot-title-string
  (string-join (plot-title-join info-dict)
              ","))
(define (filename-join dict)
  (string-join
   (map car (dict-values dict))
   "-"))
(define plot-file-name
  (filename-join info-dict))
;;;;;;;;


(define (reorder-responses-ascending dat-labs) ;; data-labels
  (map (lambda (row) (cons (car row) (reverse (cdr row)))) dat-labs))

(define ascending-data-labels
  (reorder-responses-ascending data-labels))

(define (get-response-number row n)
  (string->number (list-ref row n)))

(define (sum-responses row n m)
  (+ (get-response-number  row n)(get-response-number row m)))

(define (positives-sum row)
  (sum-responses row 4 5))
(define (negatives-sum row)
  (sum-responses row 1 2))

(require plot)
(require plot/utils)

;; (define neutral-response 3)
(define (neutral-line row y)
  (let* ((neutral-label (list-ref row 3))
         (neutral-number (string->number neutral-label))
	 (half (/ neutral-number 2)))
    (list 
     (hrule y (- half) half #:color "black")
     (point-label (vector 0 y) (string-append "3:" neutral-label)
                 #:anchor 'bottom #:point-size 5 #:size 9))))

(define (positive-line row y)
  (let* ((4-label (list-ref row 4))
         (4-number (string->number 4-label))
         (5-label (list-ref row 5))
         (5-number (string->number 5-label))
         (4n5 (+ 4-number 5-number)))
    (list

     (lines (list(vector 0 y) (vector 4-number y)) #:color "green")
     (lines (list (vector 4-number y) (vector 4n5 y)) #:color "green" #:width 3)
     (points (list (vector 4-number y)) #:color "black" #:sym 'fullcircle #:size 5)
     (point-label (vector 4n5 y) (string-append "4:" 4-label "," "5:" 5-label)
                 #:anchor 'bottom #:point-size 5))))

(define (negative-line row y)
  (let* ((1-label (list-ref row 1))
         (1-number (string->number 1-label))
         (2-label (list-ref row 2))
         (2-number (string->number 2-label))
         (1n2 (+ 1-number 2-number)))
    (list
     (point-label (vector (- 1n2) y) (string-append "1:" 1-label "," "2:" 2-label)
                 #:anchor 'bottom #:point-size 2)
     (lines (list (vector (- 1n2) y) (vector (- 2-number) y)) #:color "blue" #:width 3)
     (lines (list (vector (- 2-number) y) (vector 0 y)) #:color "blue")
     (points (list (vector 0 y)) #:color "black" #:sym 'fullcircle #:size 5)
     )))

(define (place-question key dict y)
  (let* ((d-ref (dict-ref dict key))
         (type (first d-ref))
         (question (second d-ref))
         (label (string-append type ":" question))
         (y-offset .3)
         (q-y (+ y y-offset)))positives-sum
    (point-label (vector 0 q-y) label #:size 16 #:point-size 0)))

(define (plot-a-question row dict y)
  (list
   (neutral-line row (- y .25))
   (positive-line row (- y .05))
   (negative-line row (- y .05))
   (place-question (first row) dict y)
   ))

(define (plot-questions data dict)
  (define (helper rows y plots)
    (cond
      ((empty? rows) plots)
      (#t (helper (cdr rows) (add1 y)
                 (cons (plot-a-question (car rows) dict y) plots)))))
  (helper data 1 '()))

(parameterize
    ((plot-title plot-title-string)
     (plot-x-axis? #f)
     (plot-x-label #f)
     (plot-x-far-axis? #f)
     (plot-y-axis? #f)
     (plot-y-label #f)
     (plot-y-far-axis? #f)
     (plot-width 1200)
     (plot-height 1000))
     (plot
      (plot-questions
       (sort (cdr ascending-data-labels) #:key positives-sum >)
       questions-ja)
      #;(plot-a-question (fourth ascending-data-labels) questions-ja 4)
    
      
	   #:x-min -800 #:x-max 2500
	   #:y-min 0 #:y-max 11.5
           #:out-file (string-append plot-file-name "-made-2019-07-01-b.png")
           #:out-kind 'png))

• 他のデータ視覚化とコード:
  • https://write.as/bs2lr/ #Racket #DrRacket #FD #FacultyDevelopment #DataVisualization #データ視覚化

Racket Plot for Faculty Development Questionnaire Result Visualization:

;; test: list
     ;; test: (negative-line (third data-strings) 3)
     ;; test: (negative-line (third data-strings) 3)
     ;; test: (negative-line (third data-strings) 3)

#racket-lang #racket-plot #visualization

Pages Generated by DrRacket with Code:

#lang racket


(define base-dir "NanKyuRoll")

(define working-directory (build-path (find-system-path 'home-dir)
                                     base-dir))
;; csv-data-file
(define data-file-name (build-path working-directory "data/2018/1/EK1-a.csv"))

;; go through list of file names from the directory
;; given from command-line.

;; get from command-line, default to 6
(define seat-row-num "6")

(define end-ext-dta "-roll-data.rkt")
(define end-ext-htm "-roll-sheet.html")
(define end-ext-seats (string-append "-seat-chart"  "-" seat-row-num ".html"))

;; use at the end of the semester to output bureacratic report
(define end-ext-attnd "-attendance.html")


;; get and clean data from sjis-encoded .csv file
(define characters-to-replace
  '(("\"" "")
    (" " " ")
    ("\u3000" " ") 
    ("�K" "II")
    ("" "今")
    ("" "別")
    ("" "匡")))

(define clean-sjis-string
  (lambda (sjis-str char-rplc-list)
    (let ((new-str sjis-str))
      (for-each (lambda (pair)
	     (set! new-str (regexp-replace* (regexp (car pair))
					    new-str
					    (cadr pair))))
      char-rplc-list)
    new-str)))

(define get-sjis-file-contents-as-list-of-strings
  (lambda (fstr char-pairs)
    (let* ((inf (open-input-file fstr))
	   (iu8 (reencode-input-port inf "SJIS"))
	   (str (port->string iu8))
	   (cln-str (clean-sjis-string str char-pairs))) ;; closes port too
      (string-split cln-str "\n"))))

(define got-strs (get-sjis-file-contents-as-list-of-strings data-file-name characters-to-replace))

(define got-lsts (map (lambda (s) (string-split s ",")) got-strs))

;; class data lists from first two lines of .csv file
(define cls-dta-lst (list (car got-lsts)
			  (cadr got-lsts)))
;; student data lists from third line on of .csv file
(define stt-dta-lst (cdddr got-lsts))

;; from data table-style  rows from .csv file
;;    make associative lists
(define transpose-rows-columns
  (lambda (lol) ;; list of lists
    (define helper
      (lambda (lol keep)
	(cond ((null? (car lol)) (reverse keep))
	      (#t (helper (map cdr lol) (cons (map car lol) keep))))))
    (helper lol '())))

;; associative list reference
(define als-ref
  (lambda (key als)
    (let ((tmp (assoc key als)))
      (if tmp (cadr tmp) #f))))

(define cls-als
  (transpose-rows-columns cls-dta-lst))

(define stt-rll-dta
  (map (lambda (row)
	 (list (first row) (second row)))
       stt-dta-lst))

;; (require racket/pretty) not-needed?
(define defntn-symbol-to-string
  (lambda (symbl deftn)
    (let ((dfn "")
	  (os (open-output-string)))
      (pretty-print (append
		     (cons 'define (list symbl))
		     (list deftn))
		    os)
      (set! dfn (get-output-string os))
      (set! dfn (regexp-replace #rx"\\(\\(" dfn "'(("))
      (set! dfn (regexp-replace #rx"'\\(define " dfn "(define "))
      dfn)))

(define from-als-name-directory
  (lambda (als)
    (build-path
     (find-system-path 'home-dir)
     base-dir
     (als-ref "年度" als)
     (als-ref "学期" als))))
(define from-als-make-directory
  (lambda (als)
    (make-directory*
     (from-als-name-directory als))))
(define from-als-name-file
  (lambda (als end-ext)
    (let ((time (als-ref "開講曜日" als))
	  (clss (als-ref "科目名" als)))
      (build-path (path->string (from-als-name-directory als))
		  (string-append time clss
				 end-ext)))))
(define roll-file (from-als-name-file cls-als end-ext-dta))
(define roll-sheet (from-als-name-file cls-als end-ext-htm))

;; only need first two columns from sjis-csv-data above
(require (only-in srfi/1 iota))
;; set the number of class-meetings used for roll-sheet
(define classes 15)
; (define roll-heads
;  '("学籍番号" "学生氏名"   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 tst grd))
(define roll-heads
  (cons "学籍番号" (cons "学生氏名"
			 (append (iota classes 1)
				 (cons 'tst '(grd))))))
;; one underline per cell under each class number in roll table
(define class-lines (map (lambda (n) "_") (iota classes)))

(define roll-data
  (lambda (stdt-list)
    (map (lambda (lst) (list (car lst) (cadr lst)))
	 stdt-list)))
;; later get the keys and the roll-heads from cls-als data position?
(define stdt-keys (list (first roll-heads)(second roll-heads)))
;; "学籍番号" "学生氏名" 
(define clss-keys '("年度" "学期" "科目名" "開講曜日" "開講教室" "教員氏名"))
(define comment-string-sample-roll-date-lists
"
;; ;; (define rll-dta
;; ;;   '((\"1531116007\" \"石牟礼 道子\" 1 0 1 1 1 0 1 1 0 1 1 0 1 1 1)
;; cls-dts need to be entered during/after the semester
;; (define cls-dts
;;  '((10 01)(10 15)(10 22)(10 29)(11 5)(11 12)(11 19)(11 26)
;; (12 3)(12 10)(12 17)(1 7)(1 21)(1 28)(2 4)))  
"
)

(define start-roll-data-file
  (lambda (als end-ext)
    (let ((out-fle (open-output-file
		  ;;  (build-path
		    ;; (from-als-name-directory als)
		     (from-als-name-file als end-ext)
		    #:exists 'replace)))
      (display comment-string-sample-roll-date-lists out-fle)
      (close-output-port out-fle))))

;; (start-roll-data-rkt roll-file explan-string)
(start-roll-data-file cls-als end-ext-dta)

;; This procedure puts symbols and their definitions into roll-data file
(define add-to-roll-data-file
  (lambda (sym f-als s-als) ;; file als, and symbol als, not alwasy the same
    (let ((apnd-file (open-output-file
		      (from-als-name-file f-als end-ext-dta)
		      #:exists 'append)))
      ;; earlier version worked with emacs geiser, but got #%top errors in DrRacket
      (display (defntn-symbol-to-string sym s-als) apnd-file)
      (close-output-port apnd-file))))

;; only need two definitions so far
;; avoiding #%top issues with eval
(add-to-roll-data-file 'cls-als cls-als cls-als)   
(add-to-roll-data-file 'stt-rll-dta cls-als stt-rll-dta)    

(require scribble/html) ;; for output-xml
(require scribble/html/html) ;; for table etc
;; clss-keys stdt-keys
(define class-table
  (lambda (als kys)
    (table class: "classinfo"
	   (tr
	    (map (lambda (ky)
		   (th (car (assoc ky als))))
		 kys))
	   (tr
	    (map (lambda (ky)
		   (td (cadr (assoc ky als))))
		       kys)))))

;; use class-lines as global variable, or argument?
(define roll-table
  (lambda (als kys)
    (table class: "roll"
	   (tr
	    (map (lambda (hd)  ;; any need to separate keys from nums, tst, grd? as in Guile script?
		   (th class: "hdr" hd))
		 roll-heads))
	   (map (lambda (ls)
		  (tr (td class: "num" (car ls))
		      (td class: "stu" (cadr ls))
		      (map (lambda (s)
			     (td class: "line" s))
			   class-lines)))
		als))))
	    
;; -rll-sht-.html
(define class-sheet-html
  (lambda (class-alst cls-kys stdn-alst stn-kys)
    (let ((page-ttle (path->string (file-name-from-path (from-als-name-file class-alst ""))))
	  (out-file (open-output-file roll-sheet #:exists 'replace)))
      (output-xml (xhtml
		  (head (title page-ttle )
			(meta http-equiv: "Content-Type" content: "text/html;charset=utf-8")
			(map style (list ;;saves spase to map style over a list of strings
				    "h2 { font-weight: normal; }"
				    "table.classinfo { margin: 1em 0 3em 0; } "
				    "table.classinfo td, th { font-weight: normal; padding-right: 1em; text-align: left; }"
				    "table.roll th { font-weight: 50; font-size: 9pt; }"
				    "table.roll td {padding-right: .5em; text-align: left; }"
				    "table.rollsymbols td.date {font-size: 9pt; text-align: right; }"
				    "td.num { font-size: 8pt; }"
				    "td.stu { font-size: 10pt; width: 6em; }"
				    "td.blank { padding: 10px 0px 2px 0px;  text-align: center; }"
				    "table.seating td {padding: 4px 6px 6px 6px; font-size: 11pt; }")))
		  (body (h2 page-ttle)
			(class-table class-alst cls-kys)
			(roll-table stdn-alst stn-kys)
			))
		  out-file)
      (close-output-port out-file))))

(class-sheet-html cls-als clss-keys stt-rll-dta stdt-keys)

;; end roll-sheet generation
;; start seating chart generation
(define seat-chart (from-als-name-file cls-als end-ext-seats))

(define fill-row
  (lambda (lst num)
    (cond
     ((= 0 num) (reverse lst))
     (#t (fill-row (cons '("_" "_") lst) (sub1 num))))))

(define split-rows
  (lambda (list limt)
    (let ((lim (if (number? limt) limt (string->number limt)))
	  (rows '()))
      (define helper ;; re-write with split-at and drop later
	(lambda (lst now prt prts)
	  (cond
	   ((null? lst)(reverse (cons (fill-row prt (- lim now)) prts)))
	   ((= lim now)(helper lst 0 '() (cons (reverse prt) prts)))
	   (#t (helper (cdr lst) (add1 now) (cons (car lst) prt) prts)))))
      (helper list 0 '() '()))))

(define lng-nme->lst-nme
  (lambda (name)
    (if (> 7 (string-length name))
	name
	(last (string-split name)))))

(define stdt-cell
  (lambda (pair)
    (td (lng-nme->lst-nme (cadr pair)) (br) (car pair))))

;; stt-rll-dta in current flow,
;; or import roll-file from -roll-data.rkt if hand-change order in .rkt file
(define seat-table
  ;; for now outupt a default 6 seater row .html page
  (lambda (rll-dta lmt)
    (table class: "seating chart"
	   (map (lambda (row)
		  (tr
		   (map (lambda (pair)
			  (stdt-cell pair))
			row)))
		(split-rows rll-dta lmt)))))
;; (output-xml (seat-table stt-rll-dta seat-row-num))

(define class-seating-html
  (lambda (rll-dta row-len)
    (let ((out-file (open-output-file seat-chart #:exists 'replace))
	  (page-ttle (path->string (file-name-from-path seat-chart))))
      (output-xml (xhtml
		   (head (title page-ttle )
			 (meta http-equiv: "Content-Type" content: "text/html;charset=utf-8")
			 (map style (list ;;saves space to map style over a list of strings
                                     "@page { size: 210mm 297mm; margin: 4mm 4mm 6mm 4mm; }"
				     "h2 { font-weight: normal; }"
                                     "table.teacher {border: thin solid; margin: -2em 2em 2em 20em; padding: .5em 1em .5em 1em;}"
                                     "table.seating td {padding: 3px 6px 4px 6px; font-size: 11pt; }  ")))
                   (body (p page-ttle)
                        (table class: "teacher box" (tr (td  "teacher")))                      
                        (seat-table rll-dta row-len)))
                 out-file)
      (close-output-port out-file))))

(class-seating-html stt-rll-dta seat-row-num)

#Racket #DrRacket #LearningRacket #Programming #LearningProgramming#Scheme #RacketThroughExamples