rs: Convert to untyped racket with contracts.
This commit is contained in:
parent
d2121bd5e6
commit
c33cce731f
1 changed files with 18 additions and 26 deletions
44
rs.rkt
44
rs.rkt
|
@ -1,7 +1,5 @@
|
|||
#lang racket
|
||||
|
||||
(require typed/racket)
|
||||
|
||||
;;; dds/rs
|
||||
|
||||
;;; Definitions for working with reaction systems.
|
||||
|
@ -10,11 +8,17 @@
|
|||
|
||||
(provide
|
||||
;; Structures
|
||||
reaction
|
||||
;; Type names
|
||||
Species ReactionSystem
|
||||
(struct-out reaction)
|
||||
;; Functions
|
||||
enabled? list-enabled union-products apply-rs ht-str-triples->rs
|
||||
(contract-out [enabled? (-> reaction? (set/c symbol?) boolean?)]
|
||||
[list-enabled (-> reaction-system/c (set/c species?) (listof symbol?))]
|
||||
[union-products (-> reaction-system/c (listof symbol?) (set/c species?))]
|
||||
[apply-rs (-> reaction-system/c (set/c species?) (set/c species?))]
|
||||
[ht-str-triples->rs (-> (hash/c symbol? (list/c string? string? string?)) reaction-system/c)])
|
||||
;; Predicates
|
||||
(contract-out [species? (-> any/c boolean?)])
|
||||
;; Contracts
|
||||
(contract-out [reaction-system/c contract?])
|
||||
;; Syntax
|
||||
unorg-rs)
|
||||
|
||||
|
@ -23,28 +27,23 @@
|
|||
;;; =================
|
||||
|
||||
;;; A species is a symbol.
|
||||
(define-type Species Symbol)
|
||||
(define species? symbol?)
|
||||
|
||||
;;; A reaction is a triple of sets, giving the reactants, the
|
||||
;;; inhibitors, and the products, respectively.
|
||||
(struct reaction ([reactants : (Setof Symbol)]
|
||||
[inhibitors : (Setof Symbol)]
|
||||
[products : (Setof Symbol)])
|
||||
#:transparent)
|
||||
(struct reaction (reactants inhibitors products) #:transparent)
|
||||
|
||||
;;; A reaction is enabled on a set if all of its reactants are in the
|
||||
;;; set and none of its inhibitors are.
|
||||
(: enabled? (-> reaction (Setof Symbol) Boolean))
|
||||
(define/match (enabled? r s)
|
||||
[((reaction r i p) s)
|
||||
(and (subset? r s) (set-empty? (set-intersect i s)))])
|
||||
|
||||
;;; A reaction system is a dictionary mapping reaction names to
|
||||
;;; reactions.
|
||||
(define-type ReactionSystem (HashTable Symbol reaction))
|
||||
(define reaction-system/c (hash/c symbol? reaction?))
|
||||
|
||||
;;; Returns the list of reaction names enabled on a given set.
|
||||
(: list-enabled (-> ReactionSystem (Setof Species) (Listof Symbol)))
|
||||
(define (list-enabled rs s)
|
||||
(for/list ([(name reaction) (in-hash rs)]
|
||||
#:when (enabled? reaction s))
|
||||
|
@ -56,15 +55,12 @@
|
|||
;;; 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)))))
|
||||
(for/list ([a as])
|
||||
(reaction-products (hash-ref rs a)))))
|
||||
|
||||
;;; Applies a reaction system to a set.
|
||||
(: apply-rs (-> ReactionSystem (Setof Species) (Setof Species)))
|
||||
(define (apply-rs rs s)
|
||||
(let ([as (list-enabled rs s)])
|
||||
(union-products rs as)))
|
||||
|
@ -78,12 +74,10 @@
|
|||
;;; with org-mode.
|
||||
|
||||
;;; Reads a list of species from a string.
|
||||
(: read-symbol-list (-> String (Listof Species)))
|
||||
(define (read-symbol-list str)
|
||||
(cast (string->any (string-append "(" str ")")) (Listof Species)))
|
||||
(string->any (string-append "(" str ")")))
|
||||
|
||||
;;; Converts a triple of strings to a reaction.
|
||||
(: str-triple->reaction (-> (List String String String) reaction))
|
||||
(define/match (str-triple->reaction lst)
|
||||
[((list str-reactants str-inhibitors str-products))
|
||||
(reaction (list->set (read-symbol-list str-reactants))
|
||||
|
@ -92,11 +86,9 @@
|
|||
|
||||
;;; Converts a hash table mapping reaction names to triples of strings
|
||||
;;; to a reaction system.
|
||||
(: ht-str-triples->rs (-> (HashTable Symbol (List String String String)) ReactionSystem))
|
||||
(define (ht-str-triples->rs ht)
|
||||
(for/hash : ReactionSystem
|
||||
([(a triple) (in-hash ht)])
|
||||
(for/hash ([(a triple) (in-hash ht)])
|
||||
(values a (str-triple->reaction triple))))
|
||||
|
||||
;;; Chains ht-str-triples->rs with unorg.
|
||||
(define (unorg-rs str) (ht-str-triples->rs (unorg str)))
|
||||
(define-syntax-rule (unorg-rs str) (ht-str-triples->rs (unorg str)))
|
||||
|
|
Loading…
Reference in a new issue