;
; Solving resistor networks
; 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))
(t nil)))
(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))