Finish new stats.
This commit is contained in:
parent
227787597d
commit
6cfdf705c8
3 changed files with 471 additions and 445 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue