From 5444c0654e081c19fe1c4a6362b052e341c064a2 Mon Sep 17 00:00:00 2001
From: "Edward L. Platt" <ed@elplatt.com>
Date: Thu, 25 Aug 2022 00:29:15 -0400
Subject: [PATCH] Add group-by to utils. * Applies a procedure to each element
 of a list and returns an association list mapping the procedures return value
 to a list of the elements that produce that return value.

---
 deliberate/utils.scm | 38 ++++++++++++++++++++++++++++----------
 test-borda.scm       | 26 ++++++++++++++++++++++----
 2 files changed, 50 insertions(+), 14 deletions(-)

diff --git a/deliberate/utils.scm b/deliberate/utils.scm
index 0171045..f1468b7 100644
--- a/deliberate/utils.scm
+++ b/deliberate/utils.scm
@@ -1,6 +1,6 @@
 (define-module (deliberate utils)
   #:use-module (srfi srfi-1)
-  #:export (const-list range reorder string-count zip))o
+  #:export (const-list group-by range reorder string-count zip))
 
 (define (const-list length value)
   (if (= length 0)
@@ -49,17 +49,23 @@
 	   (sort ranked-pairs (lambda (a b) (< (cadr a) (cadr b))))))
     (map car sorted-pairs)))
 
-
-;; Same as string-count but assumes parameter is sorted
-(define (string-count-sorted sorted)
+;; TODO
+;;
+(define (group-by-helper sorted)
   (if (nil? sorted)
       '()
-      (let* ((elt (car sorted))
-	     (total-length (length sorted))
-	     (rest (find-tail (lambda (x) (not (equal? x elt))) sorted))
-	     (rest-length (if rest (length rest) 0)))
-	(cons (cons elt (- total-length rest-length))
-	      (string-count-sorted rest)))))
+      (let ((elt (car (car sorted))))
+	(define-values (group rest)
+	  (span (lambda (x) (equal? (car x) elt)) sorted))
+	(cons (cons elt (map cdr group))
+	      (group-by-helper rest)))))
+
+;; TODO
+;;
+(define (group-by proc lst)
+  (let* ((annotated (map (lambda (x) (cons (proc x) x)) lst))
+	 (sorted (sort annotated (lambda (x y) (string< (car x) (car y))))))
+    (group-by-helper sorted)))
 
 ;; Counts the number of times each string appears in a list
 ;;
@@ -72,3 +78,15 @@
 (define (string-count values)
   (let ((sorted (sort values string<)))
     (string-count-sorted sorted)))
+
+;; Same as string-count but assumes parameter is sorted
+(define (string-count-sorted sorted)
+  (if (nil? sorted)
+      '()
+      (let* ((elt (car sorted))
+	     (total-length (length sorted))
+	     (rest (find-tail (lambda (x) (not (equal? x elt))) sorted))
+	     (rest-length (if rest (length rest) 0)))
+	(cons (cons elt (- total-length rest-length))
+	      (string-count-sorted rest)))))
+
diff --git a/test-borda.scm b/test-borda.scm
index 46d3a0f..6992171 100644
--- a/test-borda.scm
+++ b/test-borda.scm
@@ -1,6 +1,24 @@
-(use-modules (deliberate borda))
+(use-modules (srfi srfi-1)
+	     (deliberate borda))
 
-(define alts '(bad best better good worst))
-(define p '(best better good))
+(define test-alts '("red" "green" "blue"))
 
-(borda-score alts p)
+(define test-pref '("blue"))
+
+(define test-profile
+  '((1 . ("red" "green" "blue"))
+    (1 . ("green" "red" "blue"))
+    (1 . ("green"))
+    ))
+
+(borda-score test-alts test-pref)
+
+(define (profile-borda-scores alternatives profile)
+  (apply append
+	 (map (lambda (pair)
+		(borda-score alternatives (cdr pair)))
+	      profile)))
+
+(define test-scores (profile-borda-scores test-alts test-profile))
+
+(define test-score-groups (group-by car test-scores))