Mutable Zone State

I explore here a Scheme version that deploys a mutable array of immutable zone states. The array has one cell per zone and that cell accesses the "current" LC.

(define (Do k proc)(let loop ((j 0)) (if (< j k)
  (begin (proc j) (loop (+ j 1))))))
(define (vg n) (let* ((n2 (* n n))(2n (+ n n))(s (make-vector n2 '()))
   (d (let ((f 1/4)) (lambda (n) (cons n f)))))
  (vector-set! s 0
      (list 0 (d 1) (d n)))
  (vector-set! s (- n 1)
      (list 0 (d (- n 2)) (d(- 2n 1))))
  (vector-set! s (- n2 n)
      (list 0 (d (- n2 2n)) (d (+ (- n2 n) 1))))
  (vector-set! s (- n2 1)
      (list 0 (d (- n2 2)) (d (- (- n2 n) 1))))
  (Do (- n 2)(lambda (j) (vector-set! s (+ j 1)
      (list 1/4 (d j) (d (+ j 2)) (d (+ j n 1))))
    (let ((k (- (+ j n2 1) n))) (vector-set! s k
      (list 1/4 (d (- k 1)) (d (+ k 1)) (d (- k n)))))
    (let ((k (* n (+ j 1)))) (vector-set! s k
      (list -1/4 (d (- k n)) (d (+ k n)) (d (+ k 1)))))
    (let ((k (- (+ (* n j) 2n) 1))) (vector-set! s k
      (list -1/4 (d (- k n)) (d (+ k n)) (d (- k 1)))))
    (Do (- n 2)(lambda (m) (let ((k (+ n 1 j (* n m)))) (vector-set! s k
       (list 0 (d (+ k 1))(d (- k 1))
           (d (+ k n))(d (- k n)))))))))
  (Do n2 (lambda (x) (if (null? (vector-ref s x)) (write (list x)))))
  ;(let ((t (make-vector n2 0)))
  ; (Do n2 (lambda (k) (map (lambda (n) (vector-set! t (car n)
  ;     (+ 1 (vector-ref t (car n))))) (cdr (vector-ref s k)))))
  ;  t)
  s
  ))
(define s (vg 5))
(define (merge-assim A B comp assim) (if (null? A) B (if (null? B) A
  (let ((t (comp (car A) (car B))))
    (cond ((positive? t) (cons (car A) (merge-assim (cdr A) B comp assim)))
      ((negative? t) (cons (car B) (merge-assim A (cdr B) comp assim)))
      (else (cons (assim (car A)(car B)) (merge-assim (cdr A) (cdr B) comp assim))))))))
(define (retire n)(let ((lc (vector-ref s n)))
  (for-each (lambda (N) (let* ((id (car N))(nlc (vector-ref s id))
     (f (let ff ((u (cdr nlc))) (if (= n (caar u)) u (let ((z (ff (cdr u))))
       (cons (car z) (cons (car u) (cdr z)))))))(g (cdar f)))
     (vector-set! s id (cons (+ (* (car lc) g) (car nlc)) (merge-assim (cdr lc) (cdr nlc) 
       (lambda (x y) (- (car x) (car y))) (lambda (x y) (+ (* g x) y))))))) (cdr lc))
    (vector-set! s n (cons "d" lc))))

The following verifies that the acquaintance is still symmetric. It requires the definition of ms. sl sorts a list of pairs of zone ids, i.e. a relation between zones. ln uses sl to test if the recorded relation is its own converse, i.e. symetric. In ln, c grows to become the list of pairs.

(define (sl a) ((ms (lambda (x y) (let ((s (- (car x) (car y))))
  (if (zero? s) (- (cdr x) (cdr y)) s))) (mer "bump")) a))
(define (ln s) (let ((c '()))
  (Do (vector-length s) (lambda (j) (let ((x (vector-ref s j)))
    (if (number? (car x)) (map (lambda (e) 
     (if (= (car e) j) ((mer "Reflexive!") j))
      (set! c (cons (cons j (car e)) c))) (cdr x))))))
   (let ((d (sl c))(e (sl (map (lambda (x) (cons (cdr x)(car x))) c))))
 (list (equal? d e) d e))))