163 lines
6 KiB
Racket
163 lines
6 KiB
Racket
#lang racket
|
|
|
|
;;; dds/rs
|
|
|
|
;;; Definitions for working with reaction systems.
|
|
|
|
(require graph "utils.rkt" "generic.rkt")
|
|
|
|
(provide
|
|
;; Structures
|
|
(struct-out reaction)
|
|
(struct-out state)
|
|
(struct-out dynamics)
|
|
;; Functions
|
|
(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)]
|
|
[rs->ht-str-triples (-> reaction-system/c (hash/c symbol? (list/c string? string? string?)))]
|
|
[dds-step-one (-> dynamics? state? (set/c state?))]
|
|
[dds-step-one-annotated (-> dynamics? state? (set/c (cons/c (set/c symbol?) state?)))]
|
|
[dds-step (-> dynamics? (set/c state? #:kind 'dont-care) (set/c state?))]
|
|
[dds-build-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) graph?)]
|
|
[dds-build-n-step-state-graph (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)]
|
|
[dds-build-state-graph-annotated (-> dynamics? (set/c state? #:kind 'dont-care) graph?)]
|
|
[dds-build-n-step-state-graph-annotated (-> dynamics? (set/c state? #:kind 'dont-care) number? graph?)])
|
|
;; Predicates
|
|
(contract-out [species? (-> any/c boolean?)])
|
|
;; Contracts
|
|
(contract-out [reaction-system/c contract?])
|
|
;; Syntax
|
|
unorg-rs org-rs)
|
|
|
|
;;; =================
|
|
;;; Basic definitions
|
|
;;; =================
|
|
|
|
;;; A species is a symbol.
|
|
(define species? symbol?)
|
|
|
|
;;; A reaction is a triple of sets, giving the reactants, the
|
|
;;; inhibitors, and the products, respectively.
|
|
(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.
|
|
(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 reaction-system/c (hash/c symbol? reaction?))
|
|
|
|
;;; Returns the list of reaction names enabled on a given set.
|
|
(define (list-enabled rs s)
|
|
(for/list ([(name reaction) (in-hash rs)]
|
|
#:when (enabled? reaction s))
|
|
name))
|
|
|
|
;;; Returns the union of the product sets of the given reactions in a
|
|
;;; reaction system. If no reactions are supplied, returns the empty
|
|
;;; set.
|
|
;;;
|
|
;;; 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.
|
|
(define (union-products rs as)
|
|
(if (empty? as)
|
|
(set)
|
|
(apply set-union
|
|
(for/list ([a as])
|
|
(reaction-products (hash-ref rs a))))))
|
|
|
|
;;; Applies a reaction system to a set.
|
|
(define (apply-rs rs s)
|
|
(let ([as (list-enabled rs s)])
|
|
(union-products rs as)))
|
|
|
|
|
|
;;; ====================
|
|
;;; Org-mode interaction
|
|
;;; ====================
|
|
|
|
;;; This section contains some useful primitives for Org-mode
|
|
;;; interoperability.
|
|
|
|
;;; Reads a list of species from a string.
|
|
(define (read-symbol-list str)
|
|
(string->any (string-append "(" str ")")))
|
|
|
|
;;; Converts a triple of strings to a reaction.
|
|
(define/match (str-triple->reaction lst)
|
|
[((list str-reactants str-inhibitors str-products))
|
|
(reaction (list->set (read-symbol-list str-reactants))
|
|
(list->set (read-symbol-list str-inhibitors))
|
|
(list->set (read-symbol-list str-products)))])
|
|
|
|
;;; Converts a hash table mapping reaction names to triples of strings
|
|
;;; to a reaction system.
|
|
(define (ht-str-triples->rs ht)
|
|
(for/hash ([(a triple) (in-hash ht)])
|
|
(values a (str-triple->reaction triple))))
|
|
|
|
;;; Chains ht-str-triples->rs with unorg.
|
|
(define-syntax-rule (unorg-rs str) (ht-str-triples->rs (unorg str)))
|
|
|
|
;;; Removes the first and the last symbol of a given string.
|
|
(define (drop-first-last str)
|
|
(substring str 1 (- (string-length str) 1)))
|
|
|
|
;;; Converts a reaction to a triple of strings.
|
|
(define/match (reaction->str-triple r)
|
|
[((reaction r i p))
|
|
(map (compose drop-first-last any->string set->list)
|
|
(list r i p))])
|
|
|
|
;;; Converts a reaction system to a hash table mapping reaction names
|
|
;;; to triples of strings.
|
|
(define (rs->ht-str-triples rs)
|
|
(for/hash ([(a r) (in-hash rs)])
|
|
(values a (reaction->str-triple r))))
|
|
|
|
;;; A shortcut for rs->ht-str-triples.
|
|
(define-syntax-rule (org-rs rs) (rs->ht-str-triples rs))
|
|
|
|
|
|
;;; ============================
|
|
;;; Dynamics of reaction systems
|
|
;;; ============================
|
|
|
|
;;; An interactive process of a reaction system is a sequence of
|
|
;;; states driven by a sequence of contexts in the following way. The
|
|
;;; reaction system starts with the initial context. Then, at every
|
|
;;; step, the result of applying the reaction system is merged with
|
|
;;; the next element of the context sequence, and the reaction system
|
|
;;; is then applied to the result of the union.
|
|
|
|
;;; A state of a reaction system is a set of species representing the
|
|
;;; result of the application of the reactions from the previous
|
|
;;; steps, plus the rest of the context sequence.
|
|
(struct state (result rest-contexts) #:transparent)
|
|
|
|
;;; The dynamics of the reaction system only stores the reaction
|
|
;;; system itself.
|
|
(struct dynamics (rs) #:transparent
|
|
#:methods gen:dds
|
|
[;; Since reaction systems are deterministic, a singleton set is
|
|
;; always produced. It is annotated by the list of rules which
|
|
;; were enabled in the current step.
|
|
(define (dds-step-one-annotated dyn st)
|
|
(let* ([rs (dynamics-rs dyn)]
|
|
[apply-rs-annotate
|
|
(λ (s rest-ctx)
|
|
(let ([en (list-enabled rs s)])
|
|
(set (cons (list->set en)
|
|
(state (union-products rs en) rest-ctx)))))])
|
|
(match st
|
|
[(state res (cons ctx rest-ctx))
|
|
(apply-rs-annotate (set-union res ctx) rest-ctx)]
|
|
[(state res '())
|
|
(apply-rs-annotate res '())])))])
|