Finish new stats.

This commit is contained in:
Dominik Pantůček 2025-01-02 16:58:41 +01:00
parent 227787597d
commit 6cfdf705c8
3 changed files with 471 additions and 445 deletions

View file

@ -87,6 +87,8 @@
brmember-spec-fee
brmember-age
brmember-tests!
)
@ -492,6 +494,18 @@
#f))
#f)))
(define (brmember-age mr)
(let ((born (brmember-info mr 'born #f)))
(if born
(let ((lst (string-split born "-")))
(if (null? lst)
#f
(let ((y (string->number (car lst))))
(if y
(- (current-year) y)
#f))))
#f)))
;; Self-tests
(define (brmember-tests!)
(run-tests

View file

@ -28,6 +28,7 @@
(module
cal-period
(
current-year
*current-month*
*current-day*
@ -85,6 +86,9 @@
;; Type tag
(define TAG-CAL-PERIOD (make-tag CAL-PERIOD))
(define (current-year)
(cal-month-year (*current-month*)))
;; Current month - if changed, we get the actual state for given month.
(define *current-month*
(make-parameter

View file

@ -47,6 +47,13 @@
(define (members-base-oldest-month mb)
(make-cal-month 2015 1))
(define (members-average-age mrs)
(let* ((ages (map brmember-age mrs))
(valid (filter (lambda (x) x) ages))
(num (length valid))
(sum (foldl + 0 valid)))
(exact->inexact (/ sum num))))
;; Returns dictionary with statistics about the members base.
(define (mbase-info mb-arg)
(let* ((members (find-members-by-predicate mb-arg brmember-usable?))
@ -81,10 +88,10 @@
(map (lambda (v)
(min 0 v))
mbals))))
;; debts of fees
;; add average age of active members
(di13 (ldict-set di12 'age
(members-average-age active-members)))
)
di12))
di13))
;; Returns a list two lists: keys, data.
;; Each data record contains values for all keys.
@ -93,6 +100,7 @@
'(month
total active suspended students destroyed invalid
expected balance advance debt
age
)))
(let mloop ((data '())
(month (members-base-oldest-month mb)))