I've been learning Common Lisp lately and I've implemented ANFIS network based on Sugeno model I.Network layout and details can be read in these slides by Adriano Oliveira Cruz.I use sigmoid as the fuzzy set membership function of each input (in layer 1)\$\mu(x) = \sigma(x) = \frac{1}{(1 + e^{b * (x - a)})}\$T-norm is a simple product (layer 2)\$w = \prod_i^n\mu(x_i)\$then those results are normalized in layer 3\$\overline{w_i} = \frac{w_i}{\sum_j^rw_j}\$which are used in layer 4 as a consequent of a rule which then outputs:\$\overline{w}f = \overline{w}*(px + qy + r)\$Final 5th layer just sums all the \$r\$ rules' consequents:\$\sum_i^r\overline{w_i}f_i\$Parameters \$a, b, p, q, r\$ are optimized using (online) gradient descent using this (for input dimension being 2):\$\delta = (t - o)\$\$a_i^{(k+1)} \leftarrow a_i^{(k)} + \eta\delta\frac{\sum_{j \neq i}^r w_j(f_i - f_j)}{(\sum_j^rw_j)^2}\mu_i(y)b_i\mu_i(x)(1 - \mu_i(x))\$\$b_i^{(k+1)} \leftarrow b_i^{(k)} - \eta\delta\frac{\sum_{j \neq i}^r w_j(f_i - f_j)}{(\sum_j^rw_j)^2}\mu_i(y)(x - a_i)\mu_i(x)(1 - \mu_i(x))\$\$p_i^{(k+1)} \leftarrow p_i^{(k)} + \eta\delta\overline{w_i}x\$\$q_i^{(k+1)} \leftarrow q_i^{(k)} + \eta\delta\overline{w_i}y\$\$r_i^{(k+1)} \leftarrow r_i^{(k)} + \eta\delta\overline{w_i}\$where \$t\$ is expected and \$o\$ network output and \$k\$ is iteration. For batch gradient descent just add sum for all samples after \$\eta\$.Parameters in code are stored as 2 arrays. One array for premise parameters \$a, b\$ for each rule and input dimension. So if dimension of input is \$n\$ and there are \$r\$ rules array length is \$2*n*r\$.The other array is consequent parameters which are stored in this order: \$r, p, q\$ per rule and the length of array is \$3*r\$.Here is the implementation:(defclass anfis ()  ((rules :initarg :rules :reader rules      :type (integer 1) :documentation Number of rules.)   (input-dim :initarg :input-dim :reader input-dim          :type (integer 1) :documentation Dimension of the input)   (fuzzy-set :initarg :fuzzy-set :reader fuzzy-set          :type (cons (function (sequence number) (double-float 0.0d0 1.0d0))              (integer 1))          :documentation Parametrized membership function.)   (t-norm :initarg :t-norm :reader t-norm       :type (function (double-float double-float) (double-float 0.0d0 1.0d0))       :documentation T-norm function.)   (premise-params :initarg :premise-params :accessor premise-params           :type (vector double-float)           :documentation Vector of parameter values for fuzzy sets.)   (consequent-params :initarg :consequent-params :accessor consequent-params              :type (vector double-float)              :documentation Vector of consequent parameter values.)))(defun random-vector (size random-fun)  Crates a vector of given SIZE using provided generator RANDOM-FUN.  (declare (type (integer 0) size)       (type (function) random-fun))  (let ((vec (make-array size)))    (dotimes (i size vec)      (setf (elt vec i) (funcall random-fun)))))(defun make-anfis (&key input-dim rules fuzzy-set t-norm)  Takes numbers of INPUT-DIM and RULES, cons of membership function and numberof parameters in FUZZY-SET and T-NORM function.  (let* ((fuzzy-fun (car fuzzy-set))     (fuzzy-params (cdr fuzzy-set))     (premise-params (* input-dim rules fuzzy-params))     (consequent-params (* (1+ input-dim) rules)))    (make-instance 'anfis           :input-dim input-dim           :rules rules           :t-norm t-norm           :fuzzy-set fuzzy-fun           :premise-params (random-vector premise-params                          (lambda () (1- (random 2.0d0))))           :consequent-params (random-vector consequent-params                             (lambda () (1- (random 2.0d0)))))))(defun sigmoid (params x)  Sigmoid function for argument X with sequence of parameters PARAMS.  (declare (type (real) x))  (let ((a (elt params 0))    (b (elt params 1)))    (/ 1 (1+ (exp (* b (- x a)))))))(defun output-premise-layer (anfis input)  Filters the INPUT through given ANFIS network premise layer of each rule.  (declare (type anfis anfis)       (type list input))  (let* ((premise-params (premise-params anfis))     (input-dim (input-dim anfis))     (rules (rules anfis))     (fuzzy-params (/ (array-total-size premise-params) input-dim rules))     (fuzzy-fun (fuzzy-set anfis)))    (loop for r from 0 below rules collecting     (loop for i from 0 below input-dim        for in in input        for start = (+ (* r input-dim fuzzy-params) (* i fuzzy-params))        for params = (subseq premise-params start (+ start fuzzy-params))        collecting (funcall fuzzy-fun params in)))))(defun output-consequent-layer (anfis prev-output input)  Filters the INPUT and PREV-OUTPUT of previous layer through given ANFISnetwork consequent layer of each rule.  (declare (type anfis anfis)       (type list prev-output input))  (let ((consequent-params (consequent-params anfis))    (param-len (1+ (input-dim anfis))))    (loop for out in prev-output       for start from 0 by param-len       for params = (subseq consequent-params start (+ start param-len))       collecting (* out (weighted-sum (cons 1 input) params)))))(defun weighted-sum (x w)  Return summed pairs of elements between given sequences X and W.  (reduce #'+ (map 'list #'* x w)))(defun output-t-norm-layer (anfis input)  Filters given INPUT, received from premise layer, through t-norm layer ofgiven ANFIS network.  (declare (type anfis anfis)       (type list input))  (let ((t-norm (t-norm anfis)))    (loop for in in input collect     (reduce t-norm in))))(defun normalize (input)  Performs mathematical vector normalization on given sequence.  (let ((sum (reduce #'+ input)))    (mapcar (lambda (in) (/ in sum)) input)))(defun output-anfis (anfis input)  Filters the INPUT pair (input . output) through the given ANFIS network.Returns values of each layer in reverse (the first value is the final output).  (declare (type anfis anfis)       (type list input))  (check-type anfis anfis)  (check-type input list)  (let* ((layer1 (output-premise-layer anfis input))     (layer2 (output-t-norm-layer anfis layer1))     (layer3 (normalize layer2))     (layer4 (output-consequent-layer anfis layer3 input))     (layer5 (reduce #'+ layer4)))    (values layer5 layer4 layer3 layer2 layer1)))(defun target-function (x y)  Function of 2 arguments X and Y (which is being optimized via anfis network).  (* (+ (* (+ x 2) (+ x 2)) (- (* (- y 1) (- y 1))) (* 5 x y) -2)     (sin (/ x 5)) (sin (/ x 5))))(defun generate-samples (fun start end)  Return pairs of input and output for given FUN of 2 arguments where eachinput dimension is generated from START to END.  (loop for x from start upto end appending       (loop for y from start upto end collecting        (cons (list x y) (funcall fun x y)))))(defparameter *train-data* (generate-samples #'target-function -4 4))(defparameter *train-expected* (mapcar #'cdr *train-data*))(defun consequent-delta (input out ws-norm)  Return the deltas for parameters p, q and r in anfis consequent layer basedon given INPUT pair (input . output), anfis layer 5 OUT and layer 3 WS-NORM.  (declare (type list input ws-norm)       (type real out))  (let* ((xs (cons 1 (car input)))     (expected (cdr input))     (err (- expected out))     (param-size (* (length xs) (length ws-norm)))     (deltas (make-array param-size)))    (loop for w-norm in ws-norm and start = 0 then (+ start (length xs)) do     (loop for x in xs and i = start then (1+ i) do          (setf (elt deltas i) (* err w-norm x))))    deltas))(defun premise-delta (input out consequents ws-norm ws memberships premise-params)  Calculate the deltas for parameters a and b in premises based on givenINPUT, every anfis layer output OUT, CONSEQUENTS, WS-NORM, WS and MEMBERSHIPSas well as PREMISE-PARAMS.  (declare (type list input consequents ws-norm ws memberships)       (type vector premise-params)       (type real out))  (let* ((xs (car input))     (expected (cdr input))     (err (- expected out))     (param-size (length premise-params))     (deltas (make-array param-size)))    (loop for ms in memberships and start = 0 then (+ start (* 2 (length xs)))       and i = 0 then (1+ i) do     (loop for x in xs and pari = start then (+ 2 pari)        and j = 0 then (1+ j) do          (progn        (let* ((ai (elt premise-params pari))               (bi (elt premise-params (1+ pari)))               (w-delta (w-delta ws ws-norm consequents i))               (m-delta (membership-delta ms j)))          (setf (elt deltas pari) (* err w-delta m-delta bi))          (setf (elt deltas (1+ pari)) (* err w-delta m-delta                          (- ai x)))))))    deltas))(defun w-delta (ws ws-norm consequents index)  Take anfis layer 2 outputs WS, layer 3 WS-NORM, layer 4 CONSEQUENTS andINDEX. Returns sum of ws * (f-index - fs) divided with squared sum of ws.  (declare (type list ws ws-norm consequents)       (type (integer 0) index))  (let* ((fs (mapcar #'/ consequents ws-norm))     (fi (elt fs index))     (sum-ws (reduce #'+ ws))     (wd 0.0d0))    (loop for w in ws and f in fs and i = 0 then (1+ i) do     (unless (= i index)       (incf wd (* w (- fi f)))))    (/ wd (* sum-ws sum-ws))))(defun membership-delta (memberships index)  Calculates product of MEMBERSHIPS values for sample but also multiplieswith 1 - membership on given INDEX.  (declare (type list memberships)       (type (integer 0) index))  (let ((prod 1.0d0))    (loop for mem in memberships and i = 0 then (1+ i) do     (if (= i index)         (setf prod (* prod mem (- 1 mem)))         (setf prod (* prod mem))))    prod))(defun batch-learning (anfis input iterations min-error eta)  Perform batch gradient learning on given ANFIS instance, sequence of INPUTpairs (input . output) across number of ITERATIONS or until MIN-ERROR isreached. ETA determines learn rate. Returns modified anfis instance.  (declare (type anfis anfis)       (type list input)       (type (integer 1) iterations)       (type real min-error eta))  (check-type anfis anfis)  (check-type input list)  (check-type iterations (integer 1))  (check-type min-error real)  (check-type eta real)  (dotimes (iter iterations anfis)    (let ((cons-delta (make-array               (length (consequent-params anfis))               :initial-element 0.0d0))      (prem-delta (make-array               (length (premise-params anfis))               :initial-element 0.0d0)))      (dolist (in input)    (multiple-value-bind (out layer4 layer3 layer2 layer1)        (output-anfis anfis (car in))      (let* ((premise-params (premise-params anfis))         (cd (consequent-delta in out layer3))         (pd (premise-delta in out layer4 layer3 layer2 layer1 premise-params)))        (map-into cons-delta #'+ cons-delta cd)        (map-into prem-delta #'+ prem-delta pd))))      (map-into (consequent-params anfis) (lambda (w d) (+ w (* eta d)))        (consequent-params anfis) cons-delta)      (map-into (premise-params anfis) (lambda (w d) (+ w (* eta d)))        (premise-params anfis) prem-delta)      (let ((mse (mean-square-error anfis input)))    (print mse)    (when (<= mse min-error) (return anfis))))))(defun online-learning (anfis input epochs min-error eta)  Perform online gradient learning for given ANFIS instance using sequenceof INPUT (input . output) across number of EPOCHS or until MIN-ERROR is reached.ETA determines learn rate. Returns modified anfis instace.  (declare (type anfis anfis)       (type list input)       (type (integer 1) epochs)       (type real min-error eta))  (check-type anfis anfis)  (check-type input list)  (check-type epochs (integer 1))  (check-type min-error real)  (check-type eta real)  (dotimes (iter epochs anfis)    (dolist (in input)      (multiple-value-bind (out layer4 layer3 layer2 layer1)          (output-anfis anfis (car in))        (let* ((premise-params (premise-params anfis))               (cd (consequent-delta in out layer3))               (pd (premise-delta in out layer4 layer3 layer2 layer1 premise-params)))          (map-into (consequent-params anfis) (lambda (w d) (+ w (* eta d)))                (consequent-params anfis) cd)          (map-into (premise-params anfis) (lambda (w d) (+ w (* eta d)))                (premise-params anfis) pd))))    (let ((mse (mean-square-error anfis input)))      (print mse)      (when (<= mse min-error) (return anfis)))))(defun mean-square-error (anfis inputs)  Returns mean square error for ANFIS instance over sequence of INPUTS whichcontains (input . output) pairs.  (declare (type anfis anfis)       (type list inputs))  (check-type anfis anfis)  (check-type inputs list)  (let ((outputs (mapcar (lambda (in) (output-anfis anfis (car in))) inputs))    (expected (mapcar #'cdr inputs)))    (/ (reduce #'+ (mapcar (lambda (e o) (* (- e o) (- e o)))               expected outputs))       (length expected))))(defun sample-errors (anfis inputs)  Return pair of input and ANFIS instance output difference using INPUTSsequence of (input . output) pairs.  (declare (type anfis anfis)       (type list inputs))  (check-type anfis anfis)  (check-type inputs list)  (let ((outputs (mapcar (lambda (in) (output-anfis anfis (car in))) inputs)))    (mapcar (lambda (in o) (cons (car in) (- (cdr in) o))) inputs outputs)))And my question or rather a request is for you to comment on the:code style (idiomatic Common Lisp suggestions)potential generalizations of code/anfis networkpotential places for macro definitions (perhaps a macro for both types of learning methods?)
ANFIS network based on Sugeno model I
beginner;lisp;common lisp;machine learning