rs: Add union-products.
This commit is contained in:
parent
3732d4897e
commit
86256cd47e
2 changed files with 16 additions and 2 deletions
|
@ -13,4 +13,5 @@
|
||||||
(check-true (enabled? r1 s1))
|
(check-true (enabled? r1 s1))
|
||||||
(check-false (enabled? r1 s2))
|
(check-false (enabled? r1 s2))
|
||||||
(check-equal? (list-enabled rs s1) '(a b))
|
(check-equal? (list-enabled rs s1) '(a b))
|
||||||
(check-equal? (list-enabled rs s2) '(b))))
|
(check-equal? (list-enabled rs s2) '(b))
|
||||||
|
(check-equal? (union-products rs '(a b)) (set 'y 'z))))
|
||||||
|
|
15
rs.rkt
15
rs.rkt
|
@ -10,7 +10,7 @@
|
||||||
;; Type names
|
;; Type names
|
||||||
Species ReactionSystem
|
Species ReactionSystem
|
||||||
;; Functions
|
;; Functions
|
||||||
enabled? list-enabled)
|
enabled? list-enabled union-products)
|
||||||
|
|
||||||
;;; =================
|
;;; =================
|
||||||
;;; Basic definitions
|
;;; Basic definitions
|
||||||
|
@ -42,3 +42,16 @@
|
||||||
(for/list ([(name reaction) (in-hash rs)]
|
(for/list ([(name reaction) (in-hash rs)]
|
||||||
#:when (enabled? reaction s))
|
#:when (enabled? reaction s))
|
||||||
name))
|
name))
|
||||||
|
|
||||||
|
;;; Returns the union of the product sets of the given reactions in a
|
||||||
|
;;; reaction system.
|
||||||
|
;;;
|
||||||
|
;;; This function can be seen as producing the result of the
|
||||||
|
;;; application of the given reactions to a set. Clearly, it does not
|
||||||
|
;;; check whether the reactions are actually enabled.
|
||||||
|
(: union-products (-> ReactionSystem (Listof Symbol) (Setof Species)))
|
||||||
|
(define (union-products rs as)
|
||||||
|
(apply set-union
|
||||||
|
((inst set Species)) ; set-union requires at least one argument
|
||||||
|
(for/list : (Listof (Setof Species))
|
||||||
|
([a as]) (reaction-products (hash-ref rs a)))))
|
||||||
|
|
Loading…
Reference in a new issue