rs: Add list-enabled.

This commit is contained in:
Sergiu Ivanov 2020-03-01 19:20:24 +01:00
parent 0cb57196c5
commit d7e189eef0
2 changed files with 17 additions and 6 deletions

View file

@ -5,8 +5,12 @@
(require typed/rackunit "rs.rkt") (require typed/rackunit "rs.rkt")
(test-case "Basic definitions" (test-case "Basic definitions"
(let ([r (reaction (set 'a) (set 'b) (set 'c))] (let* ([r1 (reaction (set 'x) (set 'y) (set 'z))]
[s1 (set 'a 'c)] [r2 (reaction (set 'x) (set) (set 'y))]
[s2 (set 'a 'b)]) [rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))]
(check-true (enabled? r s1)) [s1 (set 'x 'z)]
(check-false (enabled? r s2)))) [s2 (set 'x 'y)])
(check-true (enabled? r1 s1))
(check-false (enabled? r1 s2))
(check-equal? (list-enabled rs s1) '(a b))
(check-equal? (list-enabled rs s2) '(b))))

9
rs.rkt
View file

@ -10,7 +10,7 @@
;; Type names ;; Type names
Species ReactionSystem Species ReactionSystem
;; Functions ;; Functions
enabled?) enabled? list-enabled)
;;; ================= ;;; =================
;;; Basic definitions ;;; Basic definitions
@ -35,3 +35,10 @@
;;; A reaction system is a dictionary mapping reaction names to ;;; A reaction system is a dictionary mapping reaction names to
;;; reactions. ;;; reactions.
(define-type ReactionSystem (HashTable Symbol reaction)) (define-type ReactionSystem (HashTable Symbol reaction))
;;; Returns the list of reaction names enabled on a given set.
(: list-enabled (-> ReactionSystem (Setof Symbol) (Listof Symbol)))
(define (list-enabled rs s)
(for/list ([(name reaction) (in-hash rs)]
#:when (enabled? reaction s))
name))