scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

rs: Convert to untyped racket with contracts.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-03-01 20:41:11 +01:00
parent d2121bd5e6
commit c33cce731f
1 changed files with 18 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
rs.rkt
View file

@ -1,7 +1,5 @@
#lang racket #lang racket
(require typed/racket)
;;; dds/rs ;;; dds/rs
;;; Definitions for working with reaction systems. ;;; Definitions for working with reaction systems.
@ -10,11 +8,17 @@
(provide (provide
;; Structures ;; Structures
reaction (struct-out reaction)
;; Type names
Species ReactionSystem
;; Functions ;; 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 ;; Syntax
unorg-rs) unorg-rs)
@ -23,28 +27,23 @@
;;; ================= ;;; =================
;;; A species is a symbol. ;;; A species is a symbol.
(define-type Species Symbol) (define species? symbol?)
;;; A reaction is a triple of sets, giving the reactants, the ;;; A reaction is a triple of sets, giving the reactants, the
;;; inhibitors, and the products, respectively. ;;; inhibitors, and the products, respectively.
(struct reaction ([reactants : (Setof Symbol)] (struct reaction (reactants inhibitors products) #:transparent)
[inhibitors : (Setof Symbol)]
[products : (Setof Symbol)])
#:transparent)
;;; A reaction is enabled on a set if all of its reactants are in the ;;; A reaction is enabled on a set if all of its reactants are in the
;;; set and none of its inhibitors are. ;;; set and none of its inhibitors are.
(: enabled? (-> reaction (Setof Symbol) Boolean))
(define/match (enabled? r s) (define/match (enabled? r s)
[((reaction r i p) s) [((reaction r i p) s)
(and (subset? r s) (set-empty? (set-intersect i s)))]) (and (subset? r s) (set-empty? (set-intersect i s)))])
;;; 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 reaction-system/c (hash/c symbol? reaction?))
;;; Returns the list of reaction names enabled on a given set. ;;; Returns the list of reaction names enabled on a given set.
(: list-enabled (-> ReactionSystem (Setof Species) (Listof Symbol)))
(define (list-enabled rs s) (define (list-enabled rs s)
(for/list ([(name reaction) (in-hash rs)] (for/list ([(name reaction) (in-hash rs)]
#:when (enabled? reaction s)) #:when (enabled? reaction s))
@ -56,15 +55,12 @@
;;; This function can be seen as producing the result of the ;;; This function can be seen as producing the result of the
;;; application of the given reactions to a set. Clearly, it does not ;;; application of the given reactions to a set. Clearly, it does not
;;; check whether the reactions are actually enabled. ;;; check whether the reactions are actually enabled.
(: union-products (-> ReactionSystem (Listof Symbol) (Setof Species)))
(define (union-products rs as) (define (union-products rs as)
(apply set-union (apply set-union
((inst set Species)) ; set-union requires at least one argument (for/list ([a as])
(for/list : (Listof (Setof Species)) (reaction-products (hash-ref rs a)))))
([a as]) (reaction-products (hash-ref rs a)))))
;;; Applies a reaction system to a set. ;;; Applies a reaction system to a set.
(: apply-rs (-> ReactionSystem (Setof Species) (Setof Species)))
(define (apply-rs rs s) (define (apply-rs rs s)
(let ([as (list-enabled rs s)]) (let ([as (list-enabled rs s)])
(union-products rs as))) (union-products rs as)))
@ -78,12 +74,10 @@
;;; with org-mode. ;;; with org-mode.
;;; Reads a list of species from a string. ;;; Reads a list of species from a string.
(: read-symbol-list (-> String (Listof Species)))
(define (read-symbol-list str) (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. ;;; Converts a triple of strings to a reaction.
(: str-triple->reaction (-> (List String String String) reaction))
(define/match (str-triple->reaction lst) (define/match (str-triple->reaction lst)
[((list str-reactants str-inhibitors str-products)) [((list str-reactants str-inhibitors str-products))
(reaction (list->set (read-symbol-list str-reactants)) (reaction (list->set (read-symbol-list str-reactants))
@ -92,11 +86,9 @@
;;; Converts a hash table mapping reaction names to triples of strings ;;; Converts a hash table mapping reaction names to triples of strings
;;; to a reaction system. ;;; to a reaction system.
(: ht-str-triples->rs (-> (HashTable Symbol (List String String String)) ReactionSystem))
(define (ht-str-triples->rs ht) (define (ht-str-triples->rs ht)
(for/hash : ReactionSystem (for/hash ([(a triple) (in-hash ht)])
([(a triple) (in-hash ht)])
(values a (str-triple->reaction triple)))) (values a (str-triple->reaction triple))))
;;; Chains ht-str-triples->rs with unorg. ;;; 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)))