Streamline mbase ids management.

This commit is contained in:
Dominik Pantůček 2023-04-13 20:11:43 +02:00
parent 4893d1e7d5
commit e4ad273b06
3 changed files with 40 additions and 40 deletions

View file

@ -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-)

View file

@ -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)

View file

@ -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)