rs: Add some functions for showing RS as Org tables.

Also add an example to example.org.
This commit is contained in:
Sergiu Ivanov 2020-03-01 21:10:01 +01:00
parent 0051380f2b
commit 77c0106ea2
3 changed files with 36 additions and 3 deletions

View file

@ -487,6 +487,17 @@ tab
(hash 'a (reaction (set 'x 't) (set 'y) (set 'z)) 'b (reaction (set 'x) (set 'q) (set 'z))) (hash 'a (reaction (set 'x 't) (set 'y) (set 'z)) 'b (reaction (set 'x) (set 'q) (set 'z)))
:END: :END:
Here is how we can put it back into an Org-mode table:
#+BEGIN_SRC racket :results table drawer :var input-rs=munch-table(rs1)
(org-rs (unorg-rs input-rs))
#+END_SRC
#+RESULTS:
:RESULTS:
| a | "t x" | "y" | "z" |
| b | "x" | "q" | "z" |
:END:
* Local Variables :noexport: * Local Variables :noexport:
# Local Variables: # Local Variables:

View file

@ -20,4 +20,6 @@
(test-case "Org-mode interaction" (test-case "Org-mode interaction"
(check-equal? (ht-str-triples->rs #hash((a . ("x t" "y" "z")))) (check-equal? (ht-str-triples->rs #hash((a . ("x t" "y" "z"))))
(make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))) (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))
(check-equal? (rs->ht-str-triples (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))
#hash((a . ("t x" "y" "z")))))

24
rs.rkt
View file

@ -14,13 +14,14 @@
[list-enabled (-> reaction-system/c (set/c species?) (listof symbol?))] [list-enabled (-> reaction-system/c (set/c species?) (listof symbol?))]
[union-products (-> reaction-system/c (listof symbol?) (set/c species?))] [union-products (-> reaction-system/c (listof symbol?) (set/c species?))]
[apply-rs (-> reaction-system/c (set/c species?) (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)]) [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 ;; Predicates
(contract-out [species? (-> any/c boolean?)]) (contract-out [species? (-> any/c boolean?)])
;; Contracts ;; Contracts
(contract-out [reaction-system/c contract?]) (contract-out [reaction-system/c contract?])
;; Syntax ;; Syntax
unorg-rs) unorg-rs org-rs)
;;; ================= ;;; =================
;;; Basic definitions ;;; Basic definitions
@ -92,3 +93,22 @@
;;; Chains ht-str-triples->rs with unorg. ;;; Chains ht-str-triples->rs with unorg.
(define-syntax-rule (unorg-rs str) (ht-str-triples->rs (unorg str))) (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))