Calc NPS score

dev.metalisp.qmetrics.asd

@@ -15,4 +15,5 @@
                                            (:file "calculator")
                                            (:file "displayer")
                                            (:file "sus")
-                                           (:file "visawi")))))))
+                                           (:file "visawi")
+                                           (:file "nps")))))))

src/assessment/nps.lisp

@@ -1,28 +1,50 @@
-;;; -*- mode: lisp; coding: utf-8; comment-column 79; -*-
+;;; -*- mode: lisp; coding: utf-8; -*-
 
 (in-package :ml-qmetrics/assessment)
 
+(defun nps-calc-score (promoters detractors total)
+  "Calculate the Net Promoter Score (NPS)."
+  (* (/ (- promoters detractors) total) 100))
+
+(defun nps-enumerate (data)
+  (check-type data list)
+  (if data
+      (let ((clean-data (remove-if (lambda (x) (or (> x 10) (< x 0))) data)))
+        (loop for score in clean-data
+              counting (>= score 9) into promoters
+              counting (<= score 6) into detractors
+              finally (return (list promoters detractors (length clean-data)))))
+      (error "Empty DATA list.")))
+
 ;;;
 ;;; CALCULATOR
 ;;;
 
 (defclass nps-calculator (calculator) ())
 
-(defmethod calculator-calc-results ((calc nps-calculator) responses))
+(defmethod calculator-calc-results ((calc nps-calculator) responses)
+  (let ((values (mapcar #'parse-integer (mapcar #'cdadr responses))))
+    (apply #'nps-calc-score (nps-enumerate values))))
+
+(defmethod calculator-calc-group-stats ((calc nps-calculator) results)
+  nil)
 
 ;;;
 ;;; DISPLAYER
 ;;;
 
-(defclass nps-displayer (displayer))
+(defclass nps-displayer (displayer) ())
 
-(defmethod displayer-generate-html ((disp nps-displayer) results &optional group-stats survey-id))
+(defmethod displayer-generate-html ((disp nps-displayer) results &optional group-stats survey-id)
+  (with-section
+    (with-title-bar (format nil "~A" (displayer-name disp)))
+    (format nil "~A" results)))
 
 ;;;
 ;;; ASSESSMENT
 ;;;
 
-(defclass nps-assessment (assessment))
+(defclass nps-assessment (assessment) ())
 
 (defmethod initialize-instance :after ((a nps-assessment) &key)
   (setf (assessment-calculator a) (make-instance 'nps-calculator)