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