rs: Convert to untyped racket with contracts.

This commit is contained in:
Sergiu Ivanov 2020-03-01 20:41:11 +01:00
parent d2121bd5e6
commit c33cce731f

44
rs.rkt
View File

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