dds/rs.rkt
Sergiu Ivanov 77c0106ea2 rs: Add some functions for showing RS as Org tables.
Also add an example to example.org.
2020-03-01 21:10:01 +01:00

114 lines
3.7 KiB
Racket

#lang racket
;;; dds/rs
;;; Definitions for working with reaction systems.
(require "utils.rkt")
(provide
;; Structures
(struct-out reaction)
;; 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?)))])
;; 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.
;;;
;;; 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)
(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))