Add data for graph of expected income.

This commit is contained in:
Dominik Pantůček 2025-01-02 15:18:53 +01:00
parent b25fbd407d
commit 0e9cfd546b
3 changed files with 18 additions and 8 deletions

View file

@ -572,7 +572,8 @@ export-sheet.import.scm: $(EXPORT-SHEET-SOURCES)
MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \
brmember.import.scm util-bst-ldict.scm primes.import.scm \ brmember.import.scm util-bst-ldict.scm primes.import.scm \
cal-period.import.scm cal-month.import.scm cal-period.import.scm cal-month.import.scm \
members-fees.import.scm
mbase-query.o: mbase-query.import.scm mbase-query.o: mbase-query.import.scm
mbase-query.import.scm: $(MBASE-QUERY-SOURCES) mbase-query.import.scm: $(MBASE-QUERY-SOURCES)

View file

@ -40,7 +40,8 @@
util-bst-ldict util-bst-ldict
primes primes
cal-period cal-period
cal-month) cal-month
members-fees)
(define (members-base-oldest-month mb) (define (members-base-oldest-month mb)
(make-cal-month 2015 1)) (make-cal-month 2015 1))
@ -63,18 +64,22 @@
(di7 (ldict-set di6 'total members)) (di7 (ldict-set di6 'total members))
(di8 (ldict-set di7 'problems (di8 (ldict-set di7 'problems
(find-members-by-predicate mb-arg brmember-has-problems?))) (find-members-by-predicate mb-arg brmember-has-problems?)))
;; add expected income (di9 (ldict-set di8 'expected
(get-expected-income mb-arg)))
;; add total balance of all members (including destroyed) ;; add total balance of all members (including destroyed)
;; add total balance of all active members (-only-active -like) ;; add total balance of all active members (-only-active -like)
;; add average age of active members ;; add average age of active members
) )
di8)) di9))
;; Returns a list two lists: keys, data. ;; Returns a list two lists: keys, data.
;; Each data record contains values for all keys. ;; Each data record contains values for all keys.
(define (mbase-stats mb) (define (mbase-stats mb)
(let ((keys '(month total active suspended students destroyed invalid))) (let ((keys
'(month
total active suspended students destroyed invalid
expected
)))
(let mloop ((data '()) (let mloop ((data '())
(month (members-base-oldest-month mb))) (month (members-base-oldest-month mb)))
(if (cal-month<=? month (*current-month*)) (if (cal-month<=? month (*current-month*))
@ -85,7 +90,11 @@
(if (null? keys) (if (null? keys)
(mloop (cons (reverse row) data) (mloop (cons (reverse row) data)
(cal-month-add month 1)) (cal-month-add month 1))
(kloop (cons (length (ldict-ref bi (car keys))) row) (kloop (cons (let ((val (ldict-ref bi (car keys))))
(if (list? val)
(length val)
val))
row)
(cdr keys))))) (cdr keys)))))
(list keys (reverse data)))))) (list keys (reverse data))))))

View file

@ -220,7 +220,7 @@
(cons amt (cons amt
(length (filter (lambda (v) (= v amt)) flst)))) (length (filter (lambda (v) (= v amt)) flst))))
amts))) amts)))
(number->string (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))) (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))
(define (get-expected-income-string mb) (define (get-expected-income-string mb)
(let* ((flst (let* ((flst