rs: Add list-enabled.
This commit is contained in:
parent
0cb57196c5
commit
d7e189eef0
2 changed files with 17 additions and 6 deletions
14
rs-tests.rkt
14
rs-tests.rkt
|
@ -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
9
rs.rkt
|
@ -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))
|
||||||
|
|
Loading…
Reference in a new issue