dds/networks.rkt
2020-02-23 09:19:45 +01:00

233 lines
9.7 KiB
Racket
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#lang racket
;;; dds/networks
;;; This module provides some quick definitions for and analysing
;;; network models. A network is a set of variables which are updated
;;; according to their corresponding update functions. The variables
;;; to be updated at each step are given by the mode.
;;;
;;; This model can generalise Boolean networks, TBANs, multivalued
;;; networks, etc.
(require "utils.rkt" graph)
(provide
;; Functions
(contract-out [update (-> network? state? (listof variable?) state?)]
[make-state (-> (listof (cons/c symbol? any/c)) state?)]
[make-network-from-functions (-> (listof (cons/c symbol? update-function/c)) network?)]
[update-function-form->update-function (-> update-function-form? update-function/c)]
[network-form->network (-> network-form? network?)]
[make-network-from-forms (-> (listof (cons/c symbol? update-function-form?))
network?)]
[list-interactions (-> network-form? variable? (listof variable?))]
[build-interaction-graph (-> network-form? graph?)]
[build-all-states (-> domain-mapping/c (listof state?))]
[make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))]
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
[get-interaction-sign (-> network-form? domain-mapping/c variable? variable? (or/c '+ '- '0))]
[build-signed-interaction-graph (-> network-form? domain-mapping/c graph?)])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
[update-function-form? (-> any/c boolean?)]
[network-form? (-> any/c boolean?)])
;; Contracts
(contract-out [state/c contract?]
[network/c contract?]
[update-function/c contract?]
[domain-mapping/c contract?])
;; Syntax
st nn)
;;; =================
;;; Basic definitions
;;; =================
(define variable? symbol?)
;;; A state of a network is a mapping from the variables of the
;;; network to their values.
(define state? variable-mapping?)
(define state/c (flat-named-contract 'state state?))
;;; An update function is a function computing a value from the given
;;; state.
(define update-function/c (-> state? any/c))
;;; A network is a mapping from its variables to its update functions.
(define network? variable-mapping?)
(define network/c (flat-named-contract 'network network?))
;;; Given a state s updates all the variables from xs. This
;;; corresponds to a parallel mode.
(define (update network s xs)
(for/fold ([new-s s])
([x xs])
(let ([f (hash-ref network x)])
(hash-set new-s x (f s)))))
;;; A version of make-immutable-hash restricted to creating network
;;; states (see contract).
(define (make-state mappings) (make-immutable-hash mappings))
;;; A shortcut for make-state.
(define-syntax-rule (st mappings) (make-state mappings))
;;; A version of make-immutable-hash restricted to creating networks.
(define (make-network-from-functions funcs) (make-immutable-hash funcs))
;;; =================================
;;; Syntactic description of networks
;;; =================================
;;; An update function form is any form which can appear as a body of
;;; a function and which can be evaluated with eval. For example,
;;; '(and x y (not z)) or '(+ 1 a (- b 10)).
(define update-function-form? any/c)
;;; A Boolean network form is a mapping from its variables to the
;;; forms of their update functions.
(define network-form? variable-mapping?)
;;; Build an update function from an update function form.
(define (update-function-form->update-function form)
(λ (s) (eval-with s form)))
;;; Build a network from a network form.
(define (network-form->network bnf)
(for/hash ([(x form) bnf])
(values x (update-function-form->update-function form))))
;;; Build a network from a list of pairs of forms of update functions.
(define (make-network-from-forms forms)
(network-form->network (make-immutable-hash forms)))
;;; A shortcut for make-network-from-forms.
(define-syntax-rule (nn forms) (make-network-from-forms forms))
;;; ============================
;;; Inferring interaction graphs
;;; ============================
;;; I allow any syntactic forms in definitions of Boolean functions.
;;; I can still find out which Boolean variables appear in those
;;; syntactic form, but I have no reliable syntactic means of finding
;;; out what kind of action do they have (inhibition or activation)
;;; since I cannot do Boolean minimisation (e.g., I cannot rely on not
;;; appearing before a variable, since (not (not a)) is equivalent
;;; to a). On the other hand, going through all Boolean states is
;;; quite resource-consuming and thus not always useful.
;;;
;;; In this section I provide inference of both unsigned and signed
;;; interaction graphs, but since the inference of signed interaction
;;; graphs is based on analysing the dynamics of the networks, it may
;;; be quite resource-consuming.
;;; Lists the variables of the network form appearing in the update
;;; function form for x.
(define (list-interactions nf x)
(set-intersect
(extract-symbols (hash-ref nf x))
(hash-keys nf)))
;;; Builds the graph in which the vertices are the variables of a
;;; given network, and which contains an arrow from a to b whenever a
;;; appears in (list-interactions a).
(define (build-interaction-graph n)
(transpose
(unweighted-graph/adj
(for/list ([(var _) n]) (cons var (list-interactions n var))))))
;;; A domain mapping is a hash set mapping variables to the lists of
;;; values in their domains.
(define domain-mapping/c (hash/c variable? list?))
;;; Given a hash-set mapping variables to generic sets of their
;;; possible values, constructs the list of all possible states.
(define (build-all-states vars-domains)
(let* ([var-dom-list (hash->list vars-domains)]
[vars (map car var-dom-list)]
[domains (map cdr var-dom-list)])
(for/list ([s (apply cartesian-product domains)])
(make-state (for/list ([var vars] [val s])
(cons var val))))))
;;; Makes a hash set mapping all variables to a single domain.
(define (make-same-domains vars domain)
(for/hash ([var vars]) (values var domain)))
;;; Makes a hash set mapping all variables to the Boolean domain.
(define (make-boolean-domains vars)
(make-same-domains vars '(#f #t)))
;;; Given two interacting variables of a network form and the domains
;;; of the variables, returns '+ if the interaction is monotonously
;;; increasing, '- if it is monotonously decreasing, and '0 otherwise.
;;;
;;; This function does not check whether the two variables indeed
;;; interact. Its behaviour is undefined if the variables do not
;;; interact.
;;;
;;; /!\ This function iterates through almost all of the states of the
;;; network, so its performance decreases very quickly with network
;;; size.
(define (get-interaction-sign network-form doms x y)
(let* ([dom-x (hash-ref doms x)]
[dom-y (hash-ref doms y)]
[network (network-form->network network-form)]
;; Replace the domain of x by a dummy singleton.
[doms-no-x (hash-set doms x '(#f))]
;; Build all the states, but as if x were not there: since I
;; replace its domain by a singleton, all states will contain
;; the same value for x.
[states-no-x (build-all-states doms-no-x)]
;; Go through all states, then through all ordered pairs of
;; values of x, generate pairs of states (s1, s2) such that x
;; has a smaller value in s1, and check that updating y in s1
;; yields a smaller value than updating y in s2. I rely on
;; the fact that the domains are ordered.
[x-y-interactions (for*/list ([s states-no-x]
[x1 dom-x] ; ordered pairs of values of x
[x2 (cdr (member x1 dom-x))])
(let* ([s1 (hash-set s x x1)] ; s1(x) < s2(x)
[s2 (hash-set s x x2)]
[y1 ((hash-ref network y) s1)]
[y2 ((hash-ref network y) s2)])
;; y1 <= y2?
(<= (index-of dom-y y1) (index-of dom-y y2))))])
(cond
;; If, in all interactions, y1 <= y2, then we have an
;; increasing/promoting interaction between x and y.
[(andmap (λ (x) (eq? x #t)) x-y-interactions) '+]
;; If, in all interactions, y1 > y2, then we have an
;; decreasing/inhibiting interaction between x and y.
[(andmap (λ (x) (eq? x #f)) x-y-interactions) '-]
;; Otherwise the interaction is neither increasing nor
;; decreasing.
[else '0])))
;;; Constructs a signed interaction graph of a given network form,
;;; given the ordered domains of its variables. The order on the
;;; domains determines the signs which will appear on the interaction
;;; graph.
;;;
;;; /!\ This function iterates through almost all states of the
;;; network for every arrow in the unsigned interaction graph, so its
;;; performance decreases very quickly with the size of the network.
(define (build-signed-interaction-graph network-form doms)
(let ([ig (build-interaction-graph network-form)])
(weighted-graph/directed
(for/list ([e (in-edges ig)])
(match-let ([(list x y) e])
(list (match (get-interaction-sign network-form doms x y)
['+ 1] ['- -1] ['0 0])
x y))))))
;1. Define the contract/predicate for domain mapping
;1. Remove build-all-states-same-domain.
;2. Add a short test to example.org