;
; Solving resistor networks
; see http://www.lispology.com/show?29VK
;

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

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

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

(defun series-parallel (l x y)
  (cond
   ((or (eq (caddr x) '?) (eq (caddr y) '?))
    nil)
   ;; Check four possible labellings
   ((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)))
          (return-from series-parallel
            (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))))
          (return-from series-parallel
            (list (list (second x) (second y) (+ (third x) (third y)))))))))
   (t nil)))

(defun countlinks (l x)
  (count-if #'(lambda (i) (or (eq x (first i)) (eq x (second i)))) l))

(defun simplify (list function n)
  (let* ((l (length list))
         (k (expt 2 l)))
    (dotimes (i k list)
      (multiple-value-bind (in out) (split-set list i)        
        (when (= (length in) n)
          (let ((c (apply function list in)))
            (when c (return (append c out)))))))))

(defun delta-wye (l x y z)
  (declare (ignore l))
  (cond
   ((or (eq (caddr x) '?) (eq (caddr y) '?) (eq (caddr z) '?))
    nil)
   ;; Check eight possible labellings
   ((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 (gensym)))
              (return-from delta-wye
                (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))))))))))
   (t nil)))

(defun floating (l)
  (remove-if #'(lambda (x) 
                 (or 
                  (= (countlinks l (first x)) 1) 
                  (= (countlinks l (second x)) 1)))
             l))

(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))