One way would be to define Lisp functions to calculate the resistance of two resistors in series, and of two resistors in parallel:

(defun series (x y) (+ x y)) (defun parallel (x y) (/ (+ (/ x) (/ y))))

Note that in Lisp (/ x) is a shorter way of writing (/ 1 x).

Now we can use these functions to express the complete circuit:

> (parallel (series 5 6) (series (parallel 10 15) 5)) 11/2

and the answer is 11/2 or 5.5 Ω.

This approach seems like it's getting the user to do most of the work. A more intuitive and general way to represent a resistor network would be to label each of the nodes a, b, c, etc and then represent it as a list of the resistances between each pair of nodes. Using this approach the above network becomes:

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

The list **(a d ?)** represents the resistance we want to calculate.

It will be useful to have a function **split-set**, that takes a list and an index i, and returns the ith division of the set into two subsets.

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

For a list of length n the total possible number of subsets is 2^{n}. The function **split-set** works by expressing the index i as a binary number, and it then puts each element into one of the two sets according to whether the bit corresponding to that element is a 0 or a 1. So, for example, 13 in binary is **1101** so the 13th split of the list of four elements (a b c d) is:

CL-USER > (split-set '(a b c d) 13) (A B D) (C)

To simplify the network we successively combine pairs of resistors according to the rules of parallel and series resistors. To do this we look at every possible pair of resistors and see if they can be combined into a single resistor. For example, the two parallel resistors between a and b could be merged into a single resistor.

Here's the routine **series-parallel** to combine two resistors x and y. It also takes the entire circuit as a parameter so we can check for other connections between the same nodes:

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

For two resistors in parallel we simply need to check that their start and end nodes are the same. For example, here it combines the resistors between a and b:

CL-USER > (series-parallel *circuit* '(a b 10) '(b a 15)) ((A B 6))

For two resistors in series we also need to check that no other resistor is connected to the node between the two resistors; this is what **countlinks** does:

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

For example, here we combine the two resistors between a, c, and d:

CL-USER > (series-parallel *circuit* '(a c 5) '(c d 6)) ((A D 11))

If it's not possible to combine the resistors **series-parallel** returns nil:

CL-USER > (series-parallel *circuit* '(a b 10) '(b d 5)) NIL

To simplify a circuit we use **split-set** to check every possible pair of resistors to see if they can be combined by **series-parallel**:

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

This function **simplify** takes a list representing the network, a function for combining resistors, and a number of resistors to combine, and returns the simplified network.

Finally to solve the network we call **simplify** repeatedly until there's no more work to do:

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

Here it is working on the above network:

CL-USER > (solve *circuit*) ((A D 11/2) (A D ?))

So the network reduces to a single resistor of 5.5Ω.

I thought I'd solved the problem, but then discovered that there are some networks that this approach can't solve. For example:

This can be represented as the list:

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

Trying to solve it gives:

CL-USER > (solve *c2*) ((A D ?) (A B 32) (B C 24) (A C 25) (B D 32) (C D 40))

It fails because the circuit doesn't contain any series or parallel configurations that can be simplified.

The solution is to do what's called a Delta-Wye transformation, which converts a triangle configuration, or delta, into a Y or wye configuration by adding an extra node ^{[1]}:

To solve these configurations the function **delta-wye** checks three links, and if they qualify as a delta network, they are transformed into a wye:

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

The function **delta-wye** uses a gensym for the fourth node.

Testing it with x=1, y=2, and z=3 gives:

CL-USER > (delta-wye nil '(a b 3) '(b c 1) '(c a 2)) ((A #:G847 1) (B #:G847 1/2) (C #:G847 1/3))

The **solve** function can be updated to incorporate **delta-wye** as follows:

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

I've also added a function **floating** to remove resistors with only one end connected to the network, which can arise from delta-wye transformations:

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

Testing the new version of **solve** on the network ***c2***:

CL-USER > (solve *c2*) ((D A 32) (A D ?))

and the resistance between a and d is 32Ω.

Finally, try this network containing two deltas:

Here's a complete copy of the Lisp program to solve resistor networks: Resistor network program

- ^ Delta-Wye resistor networks on Khan Academy.

After finding an article on the web that warned that writing your own floating-point output routine was a foolhardy enterprise ^{[2]} I decided to avoid the problem by getting **snprintf()** to write the float to a string buffer with:

snprintf(buffer, bufmax, "%g", f);

and then print the string in uLisp.

This worked nicely on the Arduino Due which I was using to test the code, although it added an overhead of over 10Kbytes to my code. However, I discovered that on most other platforms the floating-point support in **snprintf()** was disabled by default, so this wasn't going to be a solution I could use.

I therefore set out to write a floating-point output routine in C. The aim was that it should give the same output as **princ** in LispWorks Common Lisp, subject to differences in precision; my implementation has 32-bit short floats.

I prototyped the logic in Lisp before coding it in C. It's written in C-like Lisp to make it easy to translate into C once it's working.

After a few false starts I managed to get a reasonably compact version that seems to produce the correct output in all the test cases I've tried. I'd be interested if anyone can find a case that fails:

(defun pmantissa (f) (let* ((sig (floor (log f 10))) (mul (expt 10 (- 5 sig))) (i (round (* f mul))) d point) (when (= i 1000000) (setq i 100000) (incf sig)) (when (< sig 0) (princ "0.") (setq point t) (dotimes (j (1- (- sig))) (princ "0"))) (setq mul 100000) (dotimes (j 7) (setq d (truncate i mul)) (princ (code-char (+ (char-code #\0) d))) (setq i (- i (* d mul))) (when (zerop i) (unless point (princ ".0")) (return)) (when (and (= j sig) (>= sig 0)) (princ ".") (setf point t)) (setq mul (/ mul 10))))) (defun print-float (f) (let ((e 0)) (when (= f 0.0) (princ "0") (return-from print-float)) (when (< f 0) (princ "-") (setq f (- f))) ;; Calculate the exponent (when (or (< f 1e-3) (>= f 1e5)) (setq e (floor (log f 10))) (setq f (/ f (expt 10 e)))) (pmantissa f) ;; Print the exponent (when (/= e 0) (princ "e") (princ e))) (values))

Some examples:

CL-USER > (print-float 12345.6789) 12345.7 CL-USER > (print-float 123456.789) 1.23457e5 CL-USER > (print-float 0.00123456789) 0.00123457 CL-USER > (print-float 0.000123456789) 1.23457e-4 CL-USER > (print-float 0.99999999) 1.0

- ^ uLisp - Lisp for the Arduino, Micro Bit, and MSP430.
- ^ Printing Floating-Point Numbers on RyanJuckett.com.

My starting point was this routine on Rosetta Code ^{[2]}:

(defun fft (x) (if (<= (length x) 1) x (let* ((even (fft (loop for i from 0 below (length x) by 2 collect (nth i x)))) (odd (fft (loop for i from 1 below (length x) by 2 collect (nth i x)))) (aux (loop for k from 0 below (/ (length x) 2) collect (* (exp (/ (* (complex 0 -2) pi k ) (length x))) (nth k odd))))) (append (mapcar #'+ even aux) (mapcar #'- even aux)))))

The formatting of the original suggests it was written by a C programmer rather than a Lisp programmer, and I've tidied it up a bit above.

The test case is this simple waveform:

(fft '(1 1 1 1 0 0 0 0))

which gives:

CL-USER > (pprint (fft '(1 1 1 1 0 0 0 0))) (#C(4.0D0 -0.0D0) #C(1.0D0 -2.414213562373095D0) #C(0.0D0 0.0D0) #C(1.0D0 -0.4142135623730949D0) #C(0.0D0 0.0D0) #C(0.9999999999999999D0 0.4142135623730949D0) #C(0.0D0 0.0D0) #C(0.9999999999999997D0 2.414213562373095D0))

However, in searching for solutions to this problem I found an elegant version in Scheme using a purely functional style of programming with no variable assignments, by Prasenjit Saha ^{[3]}.

Inspired by his version here's a functional Common Lisp version that avoids variable assignments, or the use of the **loop** macro, and to my mind is much easier to understand:

(defun evens (f) (if (null f) nil (cons (car f) (evens (cddr f))))) (defun odds (f) (if (null f) nil (cons (cadr f) (odds (cddr f))))) (defun rotate (fun k l lis) (if (null lis) nil (cons (funcall fun k l (car lis)) (rotate fun (1+ k) l (cdr lis))))) (defun ph (k l j) (* (exp (/ (* (complex 0 -2) (* pi k)) l)) j)) (defun plusminus (a b) (append (mapcar #'+ a b) (mapcar #'- a b))) (defun fft2 (x) (if (= (length x) 1) x (plusminus (fft2 (evens x)) (rotate #'ph 0 (length x) (fft2 (odds x))))))

The routines **evens** and **odds** return lists containing every alternate element:

CL-USER > (evens '(0 1 2 3 4 5 6 7)) (0 2 4 6) CL-USER > (odds '(0 1 2 3 4 5 6 7)) (1 3 5 7)

The function **rotate** is a bit more complicated. It takes four parameters: The first is a function, the second and third are integers, and the fourth is a list. It applies the function to the first two parameters and each element of the list, with the first number incremented in successive calls. For example:

CL-USER > (rotate #'list 0 'x '(a b c d e)) ((0 X A) (1 X B) (2 X C) (3 X D) (4 X E))

The function **ph** performs the central calculation of the FFT, and **plusminus** takes two lists of equal length, and returns a single list of their pairwise sums followed by their pairwise differences:

CL-USER > (plusminus '(1 3 5) '(0 2 4)) (1 5 9 1 1 1)

Finally **fft2** recursively applies the Cooley–Tukey algorithm to calculate the FFT.

Result:

CL-USER > (pprint (fft2 '(1 1 1 1 0 0 0 0))) (#C(4.0D0 -0.0D0) #C(1.0D0 -2.414213562373095D0) #C(0.0D0 0.0D0) #C(1.0D0 -0.4142135623730949D0) #C(0.0D0 0.0D0) #C(0.9999999999999999D0 0.4142135623730949D0) #C(0.0D0 0.0D0) #C(0.9999999999999997D0 2.414213562373095D0))

- ^ uLisp - Lisp for the Arduino, Micro Bit, and MSP430.
- ^ Fast Fourier transform - Common Lisp on Rosetta Code.
- ^ A Fast Fourier Transform in Lisp on physik.uzh.ch.