diff --git a/src/assessment/assessment.lisp b/src/assessment/assessment.lisp deleted file mode 100644 index 710f0d9..0000000 --- a/src/assessment/assessment.lisp +++ /dev/null @@ -1,136 +0,0 @@ -;;;; -*- mode: common-lisp; coding: utf-8; -*- - -(defpackage :ml-survey/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-survey/stats - #:calculate-statistics - #:average) - (:export #:assessment-results-html - #:parse-assessments)) - -(in-package :ml-survey/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)))) diff --git a/src/assessment/calculator.lisp b/src/assessment/calculator.lisp deleted file mode 100644 index dc76df2..0000000 --- a/src/assessment/calculator.lisp +++ /dev/null @@ -1,26 +0,0 @@ -;;;; -*- mode: common-lisp; coding: utf-8; -*- - -(in-package :ml-survey/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)))))))) diff --git a/src/assessment/displayer.lisp b/src/assessment/displayer.lisp deleted file mode 100644 index ec39c03..0000000 --- a/src/assessment/displayer.lisp +++ /dev/null @@ -1,28 +0,0 @@ -;;;; -*- mode: common-lisp; coding: utf-8; -*- - -(in-package :ml-survey/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)))))) diff --git a/src/assessment/sus.lisp b/src/assessment/sus.lisp deleted file mode 100644 index d05d783..0000000 --- a/src/assessment/sus.lisp +++ /dev/null @@ -1,61 +0,0 @@ -;;;; -*- mode: common-lisp; coding: utf-8; -*- - -(in-package :ml-survey/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"))) diff --git a/src/assessment/visawi.lisp b/src/assessment/visawi.lisp deleted file mode 100644 index 8c9f9e3..0000000 --- a/src/assessment/visawi.lisp +++ /dev/null @@ -1,40 +0,0 @@ -;;;; -*- mode: common-lisp; coding: utf-8; -*- - -(in-package :ml-survey/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")))