brmlab/hackerbase
9
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Prepare stats infrastructure.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-19 18:30:09 +01:00
parent 15926d124e
commit cd2a08e2ec
2 changed files with 30 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

27
members-base.scm
View file

@ -260,17 +260,34 @@
(member-nick mr))) (member-nick mr)))
mrs)))) mrs))))
;; Returns dictionary with statistics about the members base.
(define (members-base-info mb)
(let* ((di0 (make-dict))
(di1 (dict-set di0 'invalid
(filter-members-by-predicate mb
(compose not is-4digit-prime? member-id))))
(di2 (dict-set di1 'active
(filter-members-by-predicate mb member-active?)))
(di3 (dict-set di2 'suspended
(filter-members-by-predicate mb member-suspended?)))
(di4 (dict-set di3 'students
(filter-members-by-predicate mb member-student?)))
(di5 (dict-set di4 'destroyed
(filter-members-by-predicate mb member-destroyed?))))
di5))
;; Basic information about members-base in human-readable form. ;; Basic information about members-base in human-readable form.
(define (print-members-base-info mb) (define (print-members-base-info mb)
(let ((nicks (list-members-nicks mb)) (let ((nicks (list-members-nicks mb))
(ids (list-members-ids mb))) (ids (list-members-ids mb)))
(print "Known members: " (print "Known members: "
(length nicks)) (length nicks))
(let ((invalid-mrs (filter-members-by-predicate mb (compose not is-4digit-prime? member-id))) (let* ((bi (members-base-info mb))
(active-mrs (filter-members-by-predicate mb member-active?)) (invalid-mrs (dict-ref bi 'invalid))
(suspended-mrs (filter-members-by-predicate mb member-suspended?)) (active-mrs (dict-ref bi 'active))
(destroyed-mrs (filter-members-by-predicate mb member-destroyed?)) (suspended-mrs (dict-ref bi 'suspended))
(student-mrs (filter-members-by-predicate mb member-student?))) (destroyed-mrs (dict-ref bi 'destroyed))
(student-mrs (dict-ref bi 'students)))
(print a:success " Active (" (length active-mrs) "): " a:default (print a:success " Active (" (length active-mrs) "): " a:default
(member-records->nicks-string active-mrs)) (member-records->nicks-string active-mrs))
(print a:warning " Suspended (" (length suspended-mrs) "): " a:default (print a:warning " Suspended (" (length suspended-mrs) "): " a:default

8
month.scm
View file

@ -34,6 +34,7 @@
month=? month=?
month<? month<?
month-diff month-diff
month-add
month-tests! month-tests!
) )
@ -113,6 +114,12 @@
(error 'month-diff "Second argument is not a valid month" t)) (error 'month-diff "Second argument is not a valid month" t))
(error 'month-diff "First argument is not a valid month" f))) (error 'month-diff "First argument is not a valid month" f)))
;; Returns a month n months after the month m.
(define (month-add m n)
(let ((mi (+ (* 12 (car m)) (cadr m) n)))
(list (quotient mi 12)
(remainder mi 12))))
;; Performs self-tests of the month module. ;; Performs self-tests of the month module.
(define (month-tests!) (define (month-tests!)
(run-tests (run-tests
@ -136,6 +143,7 @@
(test-eq? month-diff (month-diff '(2023 1) '(2023 2)) 1) (test-eq? month-diff (month-diff '(2023 1) '(2023 2)) 1)
(test-eq? month-diff (month-diff '(2023 1) '(2023 12)) 11) (test-eq? month-diff (month-diff '(2023 1) '(2023 12)) 11)
(test-eq? month-diff (month-diff '(2023 1) '(2022 2)) -11) (test-eq? month-diff (month-diff '(2023 1) '(2022 2)) -11)
(test-eq? month-add (month-add '(2023 1) 2) '(2023 3))
)) ))
) )