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-spec-fee
brmember-age
brmember-tests! brmember-tests!
) )
@ -492,6 +494,18 @@
#f)) #f))
#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 ;; Self-tests
(define (brmember-tests!) (define (brmember-tests!)
(run-tests (run-tests

View file

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

View file

@ -47,6 +47,13 @@
(define (members-base-oldest-month mb) (define (members-base-oldest-month mb)
(make-cal-month 2015 1)) (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. ;; Returns dictionary with statistics about the members base.
(define (mbase-info mb-arg) (define (mbase-info mb-arg)
(let* ((members (find-members-by-predicate mb-arg brmember-usable?)) (let* ((members (find-members-by-predicate mb-arg brmember-usable?))
@ -81,10 +88,10 @@
(map (lambda (v) (map (lambda (v)
(min 0 v)) (min 0 v))
mbals)))) mbals))))
;; debts of fees (di13 (ldict-set di12 'age
;; add average age of active members (members-average-age active-members)))
) )
di12)) di13))
;; 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.
@ -93,6 +100,7 @@
'(month '(month
total active suspended students destroyed invalid total active suspended students destroyed invalid
expected balance advance debt expected balance advance debt
age
))) )))
(let mloop ((data '()) (let mloop ((data '())
(month (members-base-oldest-month mb))) (month (members-base-oldest-month mb)))