;;; hopfield.scm               Dave Reed ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define HOPFIELD-NET
  '((A (B -1) (C 1) (D -1))
    (B (A -1) (D 3))
    (C (A 1) (D -1) (E 2) (F 1))
    (D (A -1) (B 3) (C -1) (F -2) (G 3))
    (E (C 2) (F 1))
    (F (C 1) (D -2) (E 1) (G -1))
    (G (D 3) (F -1))))
    

(define (relax active)
  
  (define (neighbor-sum neighbors active)
    (cond ((null? neighbors) 0)
          ((member (caar neighbors) active) 
           (+ (cadar neighbors) (neighbor-sum (cdr neighbors) active)))
          (else (neighbor-sum (cdr neighbors) active))))
  
  (define (get-unstables net active)
    (cond ((null? net) '())
          ((and (member (caar net) active) (< (neighbor-sum (cdar net) active) 0))
           (cons (caar net) (get-unstables (cdr net) active)))
          ((and (not (member (caar net) active)) 
                (> (neighbor-sum (cdar net) active) 0))
           (cons (caar net) (get-unstables (cdr net) active)))
          (else (get-unstables (cdr net) active))))
  
  (let ((unstables (get-unstables HOPFIELD-NET active)))
    (if (null? unstables)
        active
        (let ((selected (list-ref unstables (random (length unstables)))))
          (if (member selected active)
              (relax (remove selected active))
              (relax (cons selected active)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (remove item arblist)
  (cond ((null? arblist) '())
        ((equal? (car arblist) item) (cdr arblist))
        (else (cons (car arblist) (remove item (cdr arblist))))))