marcuskammer/dev.metalisp.qmetrics
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Init commit

Browse source
This commit is contained in:
Marcus Kammer 2024-11-16 10:15:17 +01:00
commit aea6e26c87
7 changed files with 372 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
dev.metalisp.qmetrics.asd Normal file
View file

@ -0,0 +1,16 @@
(defsystem "dev.metalisp.qmetrics"
:version "0.1.0"
:author "Marcus Kammer <marcus.kammer@metalisp.dev>"
:license "MIT"
:source-control "git@git.sr.ht:~marcuskammer/dev.metalisp.qmetrics"
:depends-on ("dev.metalisp.sbt")
:components ((:module "src/"
:components ((:file "stats")
(:module "assessment/"
:serial t
:components ((:file "assessment")
(:file "calculator")
(:file "displayer")
(:file "sus")
(:file "visawi"))))))
:description "A Common Lisp library for calculating questionnaire results.")

136
src/assessment/assessment.lisp Normal file
View file

@ -0,0 +1,136 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(defpackage :ml-qmetrics/assessment
(:use #:cl)
(:import-from :ml-sbt/section
#:with-section
#:with-section-row
#:with-section-col
#:with-title-bar)
(:import-from :ml-sbt/accordion
#:with-accordion)
(:import-from :ml-sbt/tbl
#:render-plist-tbl
#:render-nested-plist-tbl)
(:import-from :ml-qmetrics/stats
#:calculate-statistics
#:average)
(:export #:assessment-results-html
#:parse-assessments))
(in-package :ml-qmetrics/assessment)
;;; Assessment
(defclass assessment ()
((results :initarg :results
:reader assessment-results
:type list
:documentation "Complete output of an assessment.")
(responses :initarg :responses
:reader assessment-responses
:type list
:documentation "Data sent by the user using a HTML form.")
(displayer :initarg :displayer
:accessor assessment-displayer
:type displayer)
(calculator :initarg :calculator
:accessor assessment-calculator
:type calculator)
(group-stats :initarg :group-stats
:reader assessment-group-stats
:type list))
(:documentation "Provides mechanism to handle data related to assessments. An assessment includes the calculated results for a specific questionnaire."))
(defmethod assessment-calculations ((a assessment))
(let* ((responses (assessment-responses a))
(calculator (assessment-calculator a))
(results (calculator-calc-results calculator responses))
(group-stats (calculator-calc-group-stats calculator results)))
(make-instance (class-name (class-of a))
:displayer (assessment-displayer a)
:results results
:group-stats group-stats)))
(defmethod assessment-html ((a assessment) &optional survey-id)
"Render HTML to show results."
(let* ((a (assessment-calculations a)))
(displayer-generate-html (assessment-displayer a)
(assessment-results a)
(assessment-group-stats a)
survey-id)))
(defun string-to-keyword (str)
"Converts string to keyword symbol.
STR is a string.
Returns keyword symbol."
(intern (string-upcase str) :keyword))
(defun string-integer (str)
"Converts string to integer.
STR is a string.
Returns integer."
(parse-integer (remove-if (complement #'digit-char-p) str)))
(defun reverse-pairs (list)
(loop :for (value key) :on (reverse list) :by #'cddr
:append (cons key value)))
;;; response entry functions
(defun response-entry-extract-group (key-str)
"Extract category name from response separated by hyphens.
KEY-STR is a string.
Returns string."
(nth 1 (uiop:split-string key-str :separator "-")))
(defun response-entry-negative-p (key-str)
"Check if entry is a negtive question.
KEY-STR is a string.
Returns t or nil."
(let ((identifier (first (last (uiop:split-string key-str :separator "-")))))
(if (string= identifier "r")
t
nil)))
(defun response-entry-process (negative-fn value-fn entry)
"Process entry and return category and value as (:CAT (VAL)).
VALUE-FN: Function which operates on the value.
ENTRY: Entry from a response."
(destructuring-bind (key . value) entry
(let* ((category (string-to-keyword (response-entry-extract-group key)))
(negative-p (funcall negative-fn key))
(value (funcall value-fn (string-integer value) negative-p)))
(list category (list value)))))
;;; helper functions
(defun merge-values-into-group (acc new-value)
(let ((cat-name (first new-value))
(value (second new-value)))
(setf (getf acc cat-name)
(append (getf acc cat-name) value))
acc))
(defun create-assessment (type responses)
(ecase type
(:visawi (make-instance 'visawi-assessment :responses responses))
(:sus (make-instance 'sus-assessment :responses responses))))
(defun parse-assessments (categorized-responses)
(loop for (type data) on categorized-responses by #'cddr
collect (create-assessment type data)))
(defun aggregate-values-per-group (entry-fn responses)
(reduce #'merge-values-into-group
(mapcar entry-fn responses)
:initial-value '()))
(defun average-score-per-group (entry-fn responses)
(let* ((values-per-group (aggregate-values-per-group entry-fn responses))
(average-scores (loop for (category values) on values-per-group by #'cddr
collect category
collect (* 1.0 (average values))))
(overall-average (* 1.0 (average (loop for (nil score) on average-scores by #'cddr
collect score)))))
(append average-scores (list :average overall-average))))

26
src/assessment/calculator.lisp Normal file
View file

@ -0,0 +1,26 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(in-package :ml-qmetrics/assessment)
;;; Calculator
(defclass calculator () ())
;; TODO (defgeneric calculator-recode-value (calculator value))
;; TODO (defgeneric calculator-process-entry (calculator entry))
(defgeneric calculator-calc-results (calculator responses))
(defgeneric calculator-calc-group-stats (calculator results))
(defmethod calculator-calc-group-stats ((calc calculator) results)
(when (> (length results) 1)
(flet ((merge-entry (acc entry)
(loop :for (key value) :on entry :by #'cddr
:do (push value (getf acc key)))
acc))
(let ((merged-values (reduce #'merge-entry
(mapcar #'cddr results)
:initial-value '())))
(reverse (loop :for (key value) :on merged-values :by #'cddr
:collect (list key (calculate-statistics value))))))))

28
src/assessment/displayer.lisp Normal file
View file

@ -0,0 +1,28 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(in-package :ml-qmetrics/assessment)
;;; Displayer
(defclass displayer ()
((name :initarg :name
:accessor displayer-name)))
(defgeneric displayer-generate-html (displayer results &optional group-stats survey-id))
(defgeneric displayer-csv-url (displayer &optional survey-id format))
(defmethod displayer-csv-url ((disp displayer) &optional survey-id format)
(when (and survey-id format)
(format nil "~a/~a-~a-~a.csv" survey-id survey-id (displayer-name disp) format)))
(defmethod displayer-generate-html ((disp displayer) results &optional group-stats survey-id)
(with-section (with-title-bar (format nil "~A" (displayer-name disp)))
(:div :class "row"
(with-section-col (with-title-bar "Results"
"Download CSV" (displayer-csv-url disp survey-id "results"))
(render-plist-tbl results))
(when group-stats
(with-section-col (with-title-bar "Group Stats"
"Download CSV" (displayer-csv-url disp survey-id "group-stats"))
(render-nested-plist-tbl group-stats))))))

61
src/assessment/sus.lisp Normal file
View file

@ -0,0 +1,61 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(in-package :ml-qmetrics/assessment)
(defun sus-score (values)
(let ((values (remove-if #'keywordp values)))
(list :SCORE (* (apply #'+ values) 2.5))))
(defun sus-recode-value (value negative-p)
(if negative-p
(- 5 value)
(1- value)))
(defun sus-response-entry-process (entry)
(response-entry-process #'response-entry-negative-p #'sus-recode-value entry))
(defclass sus-calculator (calculator) ())
(defmethod calculator-calc-results ((calc sus-calculator) responses)
(loop :for response :in responses
:for timestamp = (first response)
:for values = (reverse-pairs (aggregate-values-per-group #'sus-response-entry-process
(rest response)))
:collect (cons :TIMESTAMP
(cons timestamp
(append values (sus-score values))))))
(defclass sus-displayer (displayer) ())
(defmethod displayer-generate-html ((disp sus-displayer) results &optional group-stats survey-id)
(with-section (with-title-bar (format nil "~A" (displayer-name disp)))
(with-accordion
nil
"Grading Table" (ml-sbt/tbl:render-tbl '("Score Range" "Grade" "Percentile range")
'(("84.1-100" "A+" "96-100")
("80.8-84.0" "A" "90-95")
("78.9-80.7" "A-" "85-89")
("77.2-78.8" "B+" "80-84")
("74.1-77.1" "B" "70-79")
("72.6-74.0" "B-" "65-69")
("71.1-72.5" "C+" "60-64")
("65.0-71.0" "C" "41-59")
("62.7-64.9" "C-" "35-40")
("51.7-62.6" "D" "15-34")
("0.0-51.6" "F" "0-14"))))
(:div :class "row"
(with-section-col
(with-title-bar "Results"
"Download CSV" (displayer-csv-url disp survey-id "results"))
(render-plist-tbl results))
(when group-stats
(with-section-col
(with-title-bar "Group Stats"
"Download CSV" (displayer-csv-url disp survey-id "group-stats"))
(render-nested-plist-tbl group-stats))))))
(defclass sus-assessment (assessment) ())
(defmethod initialize-instance :after ((a sus-assessment) &key)
(setf (assessment-calculator a) (make-instance 'sus-calculator)
(assessment-displayer a) (make-instance 'sus-displayer :name "SUS")))

40
src/assessment/visawi.lisp Normal file
View file

@ -0,0 +1,40 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(in-package :ml-qmetrics/assessment)
(defun visawi-value-matching (value)
(case value
(1 7)
(2 6)
(3 5)
(4 4)
(5 3)
(6 2)
(7 1)))
(defun visawi-recode-value (value negative-p)
"Recode response score from negative question.
VALUE is a integer.
NEGATIVE-P is a Predicate.
Returns an integer."
(if negative-p
(visawi-value-matching value)
value))
(defun visawi-entry-process (entry)
(response-entry-process #'response-entry-negative-p #'visawi-recode-value entry))
(defclass visawi-calculator (calculator) ())
(defmethod calculator-calc-results ((calc visawi-calculator) responses)
(loop :for response :in responses
:for timestamp = (first response)
:collect (cons :timestamp
(cons timestamp (average-score-per-group #'visawi-entry-process
(rest response))))))
(defclass visawi-assessment (assessment) ())
(defmethod initialize-instance :after ((a visawi-assessment) &key)
(setf (assessment-calculator a) (make-instance 'visawi-calculator)
(assessment-displayer a) (make-instance 'displayer :name "VISAWI")))

65
src/stats.lisp Normal file
View file

@ -0,0 +1,65 @@
;;;; -*- mode: common-lisp; coding: utf-8; -*-
(defpackage :ml-qmetrics/stats
(:use #:cl)
(:export #:preprocess-and-transpose
#:calculate-statistics
#:stdev
#:average
#:median
#:geomean))
(in-package :ml-qmetrics/stats)
(defun preprocess-and-transpose (data)
(apply #'mapcar #'list (mapcar #'cdr data)))
(defun calculate-statistics (numbers)
(list :median (median numbers)
:average (average numbers)
:geomean (geomean numbers)
:stdev (stdev numbers)
:min (reduce #'min numbers)
:max (reduce #'max numbers)))
(defun average (numbers)
(if (null numbers)
0
(* 1.0 (/ (reduce #'+ numbers)
(length numbers)))))
(defun geomean (numbers)
(if (null numbers)
0
(expt (reduce #'* numbers)
(/ 1.0 (length numbers)))))
(defun median-odd (numbers)
(nth (floor (length numbers) 2) numbers))
(defun median-even (numbers)
(let* ((mid (floor (length numbers) 2))
(pair (list (nth (1- mid) numbers)
(nth mid numbers))))
(average pair)))
(defun median (numbers)
(let ((sorted (sort (copy-list numbers) #'<)))
(if (oddp (length sorted))
(median-odd sorted)
(median-even sorted))))
(defun range (numbers)
(- (reduce #'max numbers)
(reduce #'min numbers)))
(defun variance (numbers)
(if (< (length numbers) 2)
nil ; or we could return nil to indicate undefined variance
(let* ((n (length numbers))
(average-value (average numbers))
(squared-diff (mapcar (lambda (x) (expt (- x average-value) 2)) numbers)))
(/ (reduce #'+ squared-diff) (1- n)))))
(defun stdev (numbers)
(sqrt (variance numbers)))