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

Fix month computation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-19 19:06:22 +01:00
parent 5ff4aaff1b
commit a4a296f36b
3 changed files with 16 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

6
brmsaptool.scm
View file

@ -76,6 +76,7 @@
(-mi (id) "Specify member by id" (-member-id- (string->number id))) (-mi (id) "Specify member by id" (-member-id- (string->number id)))
(-mn (nick) "Specify member by nick" (-member-nick- nick)) (-mn (nick) "Specify member by nick" (-member-nick- nick))
(-pi () "Print information" (-action- 'print-info)) (-pi () "Print information" (-action- 'print-info))
(-stats () "Get stats for all months" (-action- 'print-stats))
) )
;; Load the members database (required for everything anyway) ;; Load the members database (required for everything anyway)
@ -98,4 +99,7 @@
(if mr (if mr
(print-member-record-info mr) (print-member-record-info mr)
(print-members-base-info MB)) (print-members-base-info MB))
(newline))) (newline))
((print-stats)
(print (members-base-stats MB)))
)

12
members-base.scm
View file

@ -33,6 +33,7 @@
find-member-by-nick find-member-by-nick
list-members-ids list-members-ids
list-members-nicks list-members-nicks
members-base-stats
print-members-base-info print-members-base-info
members-base-tests! members-base-tests!
) )
@ -276,8 +277,9 @@
(filter-members-by-predicate mb member-student?))) (filter-members-by-predicate mb member-student?)))
(di5 (dict-set di4 'destroyed (di5 (dict-set di4 'destroyed
(filter-members-by-predicate mb member-destroyed?))) (filter-members-by-predicate mb member-destroyed?)))
(di6 (dict-set di5 'month (*current-month*)))) (di6 (dict-set di5 'month (*current-month*)))
di6)) (di7 (dict-set di6 'total mb)))
di7))
;; 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.
@ -288,12 +290,12 @@
(if (month<? month (*current-month*)) (if (month<? month (*current-month*))
(let ((bi (parameterize ((*current-month* month)) (let ((bi (parameterize ((*current-month* month))
(members-base-info mb)))) (members-base-info mb))))
(let kloop ((row '()) (let kloop ((row (list (dict-ref bi 'month)))
(keys keys)) (keys (cdr keys)))
(if (null? keys) (if (null? keys)
(mloop (cons (reverse row) data) (mloop (cons (reverse row) data)
(month-add month 1)) (month-add month 1))
(kloop (cons (dict-ref bi (car keys)) row) (kloop (cons (length (dict-ref bi (car keys))) row)
(cdr keys))))) (cdr keys)))))
(list keys (reverse data)))))) (list keys (reverse data))))))

8
month.scm
View file

@ -113,17 +113,17 @@
(define (month-diff f t) (define (month-diff f t)
(if (month-valid? f) (if (month-valid? f)
(if (month-valid? t) (if (month-valid? t)
(let ((F (+ (* (car f) 12) (cadr f))) (let ((F (+ (* (car f) 12) (cadr f) -1))
(T (+ (* (car t) 12) (cadr t)))) (T (+ (* (car t) 12) (cadr t) -1)))
(- T F)) (- T F))
(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. ;; Returns a month n months after the month m.
(define (month-add m n) (define (month-add m n)
(let ((mi (+ (* 12 (car m)) (cadr m) n))) (let ((mi (+ (* 12 (car m)) (cadr m) n -1)))
(list (quotient mi 12) (list (quotient mi 12)
(remainder mi 12)))) (+ (remainder mi 12) 1))))
;; Performs self-tests of the month module. ;; Performs self-tests of the month module.
(define (month-tests!) (define (month-tests!)