diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 2ac6162..fa5d557 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -269,7 +269,7 @@ (newline)) ((genid) (newline) - (print "New member id: " (gen-member-id MB)) + (print "New member id: " (mbase-gen-id MB)) (newline)) ((gencards) (if (-normal-month-) diff --git a/src/mbase.scm b/src/mbase.scm index 5b79c92..2965a97 100644 --- a/src/mbase.scm +++ b/src/mbase.scm @@ -39,13 +39,14 @@ find-members-by-predicate find-members-by-nick - list-members-ids - list-members-nicks + list-mbase-ids + list-mbase-nicks + mbase-free-ids + mbase-gen-id + members-base-info members-base-stats - get-free-members-ids - gen-member-id members-base-update members-base-add-unpaired members-base-unpaired @@ -133,23 +134,6 @@ 'nick) nick)))) - ;; Returns a list of members whose nick contains pat - (define (find-members-by-nick mb pat) - (find-members-by-predicate - mb - (lambda (mr) - (substring-index pat (brmember-nick mr))))) - - ;; Returns all ids found in the database - (define (list-members-ids mb) - (map (lambda (mr) (ldict-ref mr 'id)) - (mbase-members mb))) - - ;; Returns all nicks found in the database - (define (list-members-nicks mb) - (map (lambda (mr) (ldict-ref (ldict-ref mr 'info) 'nick)) - (mbase-members mb))) - ;; Returns a list of members which match given predicate. (define (find-members-by-predicate mb pred) (let loop ((mb (mbase-members mb)) @@ -162,6 +146,37 @@ (cons mr res) res)))))) + ;; Returns a list of members whose nick contains pat + (define (find-members-by-nick mb pat) + (find-members-by-predicate + mb + (lambda (mr) + (substring-index pat (brmember-nick mr))))) + + ;; Returns all ids found in the database + (define (list-mbase-ids mb) + (map (lambda (mr) (ldict-ref mr 'id)) + (mbase-members mb))) + + ;; Returns all nicks found in the database + (define (list-mbase-nicks mb) + (map brmember-nick + (mbase-members mb))) + + ;; Returns all free ids + (define (mbase-free-ids mb) + (let ((ids (list-mbase-ids mb))) + (filter + (lambda (id) + (not (member id ids))) + (gen-all-4digit-primes)))) + + ;; Generates random vector id. + (define (mbase-gen-id mb) + (let* ((fids (mbase-free-ids mb)) + (vfids (list->vector fids))) + (vector-ref vfids (pseudo-random-integer (vector-length vfids))))) + ;; Returns dictionary with statistics about the members base. (define (members-base-info mb-arg) (let* ((members (find-members-by-predicate mb-arg brmember-usable?)) @@ -201,21 +216,6 @@ (cdr keys))))) (list keys (reverse data)))))) - - ;; Returns all free ids - (define (get-free-members-ids mb) - (let ((ids (list-members-ids mb))) - (filter - (lambda (id) - (not (member id ids))) - (gen-all-4digit-primes)))) - - ;; Generates random vector id. - (define (gen-member-id mb) - (let* ((fids (get-free-members-ids mb)) - (vfids (list->vector fids))) - (vector-ref vfids (pseudo-random-integer (vector-length vfids))))) - ;; Returns new members base with member records matching the ;; predicate processed by proc. (define (members-base-update mb pred? proc) diff --git a/src/members-print.scm b/src/members-print.scm index 2e0e557..28d5287 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -258,13 +258,13 @@ ;; Prints statistics about allocated and unused valid/invalid IDs. (define (print-members-ids-stats MB) (print "Allocated IDs: " - (length (list-members-ids MB)) + (length (list-mbase-ids MB)) "/" (length (gen-all-4digit-primes)) " (" - (length (get-free-members-ids MB)) + (length (mbase-free-ids MB)) " free)") - (let ((iids (filter (compose not is-4digit-prime?) (list-members-ids MB)))) + (let ((iids (filter (compose not is-4digit-prime?) (list-mbase-ids MB)))) (when (not (null? iids)) (print " Invalid: " (length iids)