;;; net.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)
  (car (bfs-nocycles active)))

(define (GET-MOVES active)
  (define (get-moves-help unstables)
    (cond ((null? unstables) '())
          ((member (car unstables) active) (cons (remove (car unstables) active) 
                                                 (get-moves-help (cdr unstables))))
          (else (cons (cons (car unstables) active) 
                      (get-moves-help (cdr unstables))))))
  (get-moves-help (get-unstables HOPFIELD-NET active)))

(define (GOAL? active)
  (null? (get-unstables HOPFIELD-NET 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))))

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

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

(define (BFS-nocycles startState)
  
  (define (BFS-paths paths)
    (cond ((null? paths) #f)
          ((GOAL? (caar paths)) (car paths))
          (else (BFS-paths (append (cdr paths)
                                   (extend-all (car paths) 
                                               (GET-MOVES (caar paths))))))))
  
  (define (extend-all path nextStates)
    (cond ((null? nextStates) '())
          ((member (car nextStates) path) (extend-all path (cdr nextStates)))
          (else (cons (cons (car nextStates) path)
                      (extend-all path (cdr nextStates))))))
  
  (BFS-paths (list (list startState))))