Fix computing expected income based on actual fees and discounts.

src/members-fees.scm

@@ -30,6 +30,7 @@
  (
   lookup-member-fee
   member-calendar
+  make-member-calendar-entry
   member-calendar-first-month
   member-calendar-last-month
   member-calendar-query
@@ -82,15 +83,17 @@
        (if (cal-month>? cm last-month)
 	   (reverse cal)
 	   (loop (cal-month-add cm)
-		 (cons (list cm
+		 (cons (with-current-month
-			     (with-current-month
+			cm
-			      cm
+			(make-member-calendar-entry mr))
-			      (brmember-flags mr))
-			     (with-current-month
-			      cm
-			      (brmember-spec-fee mr)))
 		       cal))))))
 
+ ;; Assumes current-month is specified correctly
+ (define (make-member-calendar-entry mr)
+   (list (*current-month*)
+	 (brmember-flags mr)
+	 (brmember-spec-fee mr)))
+
  ;; Returns the first month of the calendar
  (define (member-calendar-first-month mc)
    (caar mc))

src/members-print.scm

@@ -500,7 +500,17 @@
 			       (null? (cdr dsa)))
 			   #f
 			   (cadr dsa))))
-     (let* ((members ;; Pass 1
+     (let* ((raw-members
+	     (sort
+	      (if destroyed?
+		  (find-members-by-predicate MB (lambda x #t))
+		  (if only-active?
+		      (find-members-by-predicate MB (lambda (mr)
+						      (brmember-active? mr)))
+		      (find-members-by-predicate MB (lambda (mr)
+						      (not (brmember-destroyed? mr))))))
+	      brmember<?))
+	    (members ;; Pass 1
 	     (map
 	      (lambda (mr)
 		(let* ((balance (member-balance mr))
@@ -522,15 +532,7 @@
 			total
 			balance
 			)))
-	      (sort
+	      raw-members))
-	       (if destroyed?
-		   (find-members-by-predicate MB (lambda x #t))
-		   (if only-active?
-		       (find-members-by-predicate MB (lambda (mr)
-						       (brmember-active? mr)))
-		       (find-members-by-predicate MB (lambda (mr)
-						       (not (brmember-destroyed? mr))))))
-	       brmember<?)))
 	    (balances (map (lambda (m)
 			     (list-ref m 6))
 			   members)))
@@ -598,19 +600,25 @@
 		     (map (lambda (member)
 			    (min 0 (list-ref member 5)))
 			  members)))
-       (let* ((ns (foldl (lambda (acc member)
+       (let* ((flst
-			   (cons (+ (car acc) (if (eq? 'student (cadr member)) 1 0))
+	       (map (compose member-calendar-entry->fee make-member-calendar-entry)
-				 (+ (cdr acc) (if (eq? 'active (cadr member)) 1 0))))
+		    (filter brmember-active? raw-members)))
-			 (cons 0 0)
+	      (amts (sort (delete-duplicates flst) <))
-			 members))
+	      (sums
-	      (students (car ns))
+	       (map
-	      (full (cdr ns)))
+		(lambda (amt)
+		  (cons amt
+			(length (filter (lambda (v) (= v amt)) flst))))
+		amts))
+	      )
 	 (print "Expected income: "
-		(+ (* (lookup-member-fee 'normal) full)
+		(string-intersperse (map
-		   (* (lookup-member-fee 'student) students))
+				     (lambda (p)
-		" (" full " full members + " students " students)"))
+				       (format "~A*~A" (cdr p) (car p)))
-       )
+				     sums)
-     ))
+				    " + ")
+		" = "
+		(foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums)))))))
 
  (define (unpaired-table mb . args)
    (apply