-
Notifications
You must be signed in to change notification settings - Fork 4
/
megra-lifemodel.lisp
126 lines (115 loc) · 6.68 KB
/
megra-lifemodel.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
(in-package :megra)
;;;;;;;;;;;;;;;; Simple Artifical Life Model ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; some global parameters ...
(defparameter *global-resources* 100.0) ;; just guessing ...
(defparameter *global-regain* 0.2) ;; just guessing ... (also not used anywhere)
(defparameter *growth-cost* 1.0) ;; cost to grow one node
(defparameter *autophage-regain* 0.7) ;; resource regain when forced
(defparameter *apoptosis-regain* 0.5) ;; generic regain through planned expiration
(defparameter *default-local-resources* 8) ;; again just guessing
(defparameter *average-node-lifespan* 15) ;; a node survives this many steps on average
(defparameter *node-lifespan-variance* 0.1)
(defparameter *dont-let-die* t) ;; always keep at least one node ...
;; setters for global parameters ...
(defun global-resources (res)
(setf *global-resources* res))
(defun globres (res)
(setf *global-resources* res))
;; growing an eventprocessor using a resource model ... cold also be named
;; free energy model or something like that ...
(defclass lifemodel-control (event-processor-wrapper generic-population-control)
((growth-cycle :accessor lmc-growth-cycle :initarg :growth-cycle)
(lifecycle-count :accessor lmc-lifecycle-count :initform 0)
(apoptosis :accessor lmc-apoptosis :initarg :apoptosis :initform t)
(node-lifespan :accessor lmc-node-lifespan :initarg :node-lifespan :initform *average-node-lifespan*)
(node-lifespan-var :accessor lmc-node-lifespan-var :initarg :node-lifespan-var :initform *node-lifespan-variance*)
(autophagia :accessor lmc-autophagia :initarg :autophagia :initform t)
(local-resources :accessor lmc-local-resources :initarg :local-resources :initform *default-local-resources*)
(local-cost :accessor lmc-local-cost :initarg :local-cost-modifier :initform *growth-cost*)
(local-apoptosis-regain :accessor lmc-local-apoptosis-regain :initarg :apoptosis-regain :initform *apoptosis-regain*)
(local-autophagia-regain :accessor lmc-local-autophagia-regain :initarg :autophagia-regain :initform *autophage-regain*)))
(defun add-var (orig var)
(floor (+ orig (* (* (- 20000 (random 40000)) var) (/ orig 20000)))))
(defmethod post-processing ((l lifemodel-control) &key)
(incf (lmc-lifecycle-count l))
;; growth point reached
(let* ((cur-symbol (vom::query-result-symbol (last-transition (wrapper-wrapped-processor l))))
(eaten-node nil)) ;; node "eaten" by autophagia ...
;; growth or no growth ?
;; that is, is the growth period reached ...
(when (>= (lmc-lifecycle-count l) (lmc-growth-cycle l))
(setf (lmc-lifecycle-count l) 0) ;; reset growth cycle
(if (> (+ (lmc-local-resources l) *global-resources*) (lmc-local-cost l))
;; first case: enough resoures available for this generator to grow ...
(progn
;; grow graph
(grow-generator (wrapper-wrapped-processor l)
:var (population-control-var l)
:durs (population-control-durs l)
:method (population-control-method l)
:higher-order (if (< (random 100) (population-control-higher-order-probability l))
(+ 2 (random (- (population-control-higher-order-max-order l) 2)))
0))
;; decrease resources
(if (>= (lmc-local-resources l) (lmc-local-cost l))
(setf (lmc-local-resources l) (- (lmc-local-resources l) (lmc-local-cost l)))
(if (>= *global-resources* (lmc-local-cost l))
(setf *global-resources* (- *global-resources* (lmc-local-cost l)))
;; otherwise, split ...
(let ((tmp-cost (lmc-local-cost l)))
(setf tmp-cost (- tmp-cost (lmc-local-resources l)))
(setf (lmc-local-resources l) 0.0)
(setf *global-resources* (- *global-resources* tmp-cost))))))
;; else: autophagia if specified ...
(when (and (lmc-autophagia l) (> (length (vom::alphabet (inner-generator (wrapper-wrapped-processor l)))) 1))
;; send prune/shrink
(let ((rnd-symbol (alexandria::random-elt (vom::alphabet (inner-generator (wrapper-wrapped-processor l))))))
;;(incudine::msg error "AUTOPHAGIA: ~D~%" rnd-symbol)
(prune-generator (wrapper-wrapped-processor l) :node-id rnd-symbol)
(setf eaten-node rnd-symbol))
;; add regain to local
(setf (lmc-local-resources l)
(+ (lmc-local-resources l)
(lmc-local-autophagia-regain l)))))
;; handle apoptosis:
;;(incudine::msg error "PRE APOP ALPH ~D~%" (vom::alphabet (inner-generator (wrapper-wrapped-processor l))))
(when (and
(lmc-apoptosis l) ;; first, check if apoptosis is even specified ...
;; then, check if the whole generator can die (run out of symbols) or not ...
(or (> (length (vom::alphabet (inner-generator (wrapper-wrapped-processor l)))) 1) (not *dont-let-die*))
;; then, check if the symbol has ages enough ...
(> (gethash cur-symbol (ages (wrapper-wrapped-processor l))) (add-var (lmc-node-lifespan l) (lmc-node-lifespan-var l))))
;; unless the current symbol has randomly been eaten before, remove it ...
(unless (eql cur-symbol eaten-node)
;;(incudine::msg error "APOPTOSIS: ~D ~D~%" (name l) cur-symbol)
(prune-generator (wrapper-wrapped-processor l) :node-id cur-symbol)
;; add gained resources back ...
(setf (lmc-local-resources l) (+ (lmc-local-resources l) (lmc-local-apoptosis-regain l))))))))
;; lifemodel works more in minimalistic contexts rather than algorave,
;; i suppose ...
(defun life (growth-cycle lifespan var &rest rest)
(let ((method (find-keyword-val :method rest :default 'triloop))
(variance (find-keyword-val :var rest :default 0.2))
(autophagia (find-keyword-val :autophagia rest :default t))
(apoptosis (find-keyword-val :apoptosis rest :default t))
(durs (find-keyword-val :durs rest :default nil))
(hoe-max (find-keyword-val :hoe-max rest :default 4))
(hoe (find-keyword-val :hoe rest :default 4))
(exclude (find-keyword-val :exclude rest :default nil))
(proc (if (typep (alexandria::lastcar rest) 'function) (alexandria::lastcar rest))))
(lambda (&optional next)
(cond ((not next)
(make-instance 'lifemodel-control
:wrapped-processor (if proc (funcall proc))
:growth-cycle growth-cycle
:variance variance
:method method
:durs durs
:phoe hoe
:node-lifespan lifespan
:hoe-max hoe-max
:exclude exclude
:autophagia autophagia
:apoptosis apoptosis))
(proc (apply 'life growth-cycle lifespan var (nconc (butlast rest) (list (funcall proc next)))))
(t (apply 'life growth-cycle lifespan var (nconc rest (list next))))))))