; Solving resistor networks v2
; see http://www.ulisp.com/show?2A61
;

(defvar *circuit* '((a d ?) (a b 10) (b a 15) (b d 5) (a c 5) (c d 6)))

(defvar *c2* '((a d ?) (a b 32) (b c 24) (a c 25) (b d 32) (c d 40)))

(defun split-set (lis i)
  (let (in out (ll (reverse lis)))
    (dotimes (j (length lis))
      (if (oddp i) (push (nth j ll) in) (push (nth j ll) out))
      (setq i (ash i -1)))
    (list in out)))

(defun series-parallel (l x y)
  (cond
   ((or (eq (caddr x) '?) (eq (caddr y) '?))
    nil)
   ;; Check four possible labellings
   (t (let (result)
        (dolist (x (list x (list (second x) (first x) (third x))))
          (dolist (y (list y (list (second y) (first y) (third y))))
            ;; Resistors in parallel
            (when (and (eq (first x) (first y))
                       (eq (second x) (second y)))
              (setq result
                    (list 
                     (list
                      (first x) (second x) (/ (+ (/ (third x)) (/ (third y))))))))
            ;; Resistors in series
            (when (and (eq (first x) (first y))
                       (= (countlinks l (first x)) 2)
                       (not (eq (second x) (second y))))
              (setq result
                    (list (list (second x) (second y) (+ (third x) (third y))))))))
        result))))

(defun countlinks (l x)
  (let ((n 0))
    (mapc (lambda (i) (when (or (eq x (first i)) (eq x (second i))) (incf n))) l)
    n))

(defun simplify (lis function n)
  (let* ((l (length lis))
         (k (expt 2 l)))
    (dotimes (i k lis)
      (let* ((s (split-set lis i))
             (in (first s))
             (out (second s)))
        (when (= (length in) n)
          (let ((c (apply function lis in)))
            (when c (return (append c out)))))))))

(defvar *newnode* 0)

(defun delta-wye (l x y z)
  (cond
   ((or (eq (caddr x) '?) (eq (caddr y) '?) (eq (caddr z) '?))
    nil)
   ;; Check eight possible labellings
   (t (let (result)
        (dolist (x (list x (list (second x) (first x) (third x))))
          (dolist (y (list y (list (second y) (first y) (third y))))
            (dolist (z (list z (list (second z) (first z) (third z))))
              (when (and (eq (first x) (second z))
                         (eq (first y) (second x)) 
                         (eq (first z) (second y)))
                (let ((sum (+ (third x) (third y) (third z)))
                      (newsymbol (incf *newnode*)))
                  (setq result
                        (list 
                         (list 
                          (first x) newsymbol (/ (* (third x) (third z)) sum))
                         (list 
                          (first y) newsymbol (/ (* (third x) (third y)) sum))
                         (list 
                          (first z) newsymbol (/ (* (third y) (third z)) sum)))))))))
        result))))

(defun floating (l)
  (let (result)
    (dolist (x l result)
      (unless
          (or 
           (= (countlinks l (first x)) 1) 
           (= (countlinks l (second x)) 1))
        (push x result)))))

(defun solve (circuit)
  (let (len)
    (loop
     (setq len (length circuit))
     (setq circuit (simplify circuit #'delta-wye 3))
     (setq circuit (simplify circuit #'series-parallel 2))
     (setq circuit (floating circuit))
     (when (= (length circuit) len) (return)))
    circuit))