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

@@ -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)))
 
-
+;; TODO
-;; Same as string-count but assumes parameter is sorted
+;;
-(define (string-count-sorted sorted)
+(define (group-by-helper sorted)
   (if (nil? sorted)
       '()
-      (let* ((elt (car sorted))
+      (let ((elt (car (car sorted))))
-	     (total-length (length sorted))
+	(define-values (group rest)
-	     (rest (find-tail (lambda (x) (not (equal? x elt))) sorted))
+	  (span (lambda (x) (equal? (car x) elt)) sorted))
-	     (rest-length (if rest (length rest) 0)))
+	(cons (cons elt (map cdr group))
-	(cons (cons elt (- total-length rest-length))
+	      (group-by-helper rest)))))
-	      (string-count-sorted 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)))))
+

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 test-alts '("red" "green" "blue"))
-(define p '(best better good))
 
-(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))