;;; A nicer interface for electricity

(define (make-resistor ckt name R n1 n2)
  (let ((t1 (terminal (compound-name 't1 name) n1))
	(t2 (terminal (compound-name 't2 name) n2)))
    (let ((e1 (potential t1)) (i1 (current t1))
	  (e2 (potential t2)) (i2 (current t2)))
      (let ((v (make-voltage ckt name)))
	(make-adder ckt
		    (compound-name 'voltage name)
		    e1 e2 v)
	(make-adder ckt
		    (compound-name 'current name)
		    (zero-i ckt) i1 i2)
	(make-multiplier ckt
			 (compound-name 'ohm name)
			 v i1 R)))))

(define (make-voltage-source ckt name Vs n1 n2)
  (let ((t1 (terminal (compound-name 't1 name) n1))
	(t2 (terminal (compound-name 't2 name) n2)))
    (let ((e1 (potential t1)) (i1 (current t1))
	  (e2 (potential t2)) (i2 (current t2)))
      (make-adder ckt
		  (compound-name 'voltage name)
		  e1 e2 Vs)
      (make-adder ckt
		  (compound-name 'current name)
		  (zero-i ckt) i1 i2))))

(define (make-T-network ckt name Rin Rp Rout tin tg tout)
  (with-electrical-nodes ckt name '(mid)
    (lambda (n)
      (make-resistor ckt (compound-name 'Rin name)
		     Rin   tin  n)
      (make-resistor ckt (compound-name 'Rp name)
		     Rp    n    tg)
      (make-resistor ckt (compound-name 'Rout name)
		     Rout  n    tout))))

(define (with-electrical-circuit name receiver)
  (let ((ckt
	 (let* ((alg (algebraic-solver #f))
	        (cp
		 (cp:make-network 'ckt2
				  (alg 'value-model)))
		(zero-i
		 (cp:make-connector 'zero-i cp))) 
	   ;; Lets GJS associate these without planning!
	   (cp:assume-value zero-i 0)
	   (eq-put! cp 'zero-i zero-i)
	   (eq-put! cp 'algebra alg)
	   (eq-put! alg 'propagator cp)
	   cp)))
    (receiver ckt)
    ckt))

(define (zero-i ckt)
  (eq-get ckt 'zero-i))

(define (ckt:algebra ckt)
  (eq-get ckt 'algebra))

(define (with-electrical-nodes ckt ckt-name names rcvr)
  (let ((new-nodes
	 (map (lambda (name)
		(make-electrical-node
		 ckt (compound-name name ckt-name)))
	      names)))
    (let ((content (apply rcvr new-nodes)))
      (for-each finish-electrical-node new-nodes)
      content)))

(define (make-electrical-node ckt name)
  (let ((potential (make-potential ckt name))
	(currents '())
	(finished? #f))
    (lambda (message)
      (case message
	((terminal)
	 (if finished?
	     (error "Can't change a finished node."
		    ckt name))
	 (lambda (tname)
	   (let ((current
		  (make-current ckt
				(symbol tname '- name))))
	     (set! currents (cons current currents))
	     (cons potential current))))
	((potential) potential)
	((currents) currents)
	((finish)
	 (if finished?
	     (error "Can't finish a finished node."
		    ckt name))
	 (set! finished? #t)
	 (make-nary-sum=0 ckt name currents))
	(else
	 (error "Unknown message -- electrical-node"))))))

(define (make-nary-sum=0 ckt name currents)
  (cond ((= (length currents) 0)
	 (error "Node with no terminals?" ckt name))
	((= (length currents) 1)
	 (cp:assume-value (car currents) 0))
	(else
	 ;; Quick and dirty... a tree is better.
	 (let lp ((currents currents))
	   (cond ((= (length currents) 2)
		  (make-adder ckt name
			      (zero-i ckt)
			      (car currents)
			      (cadr currents)))
		 (else
		  (let ((i (make-current ckt name)))
		    (make-adder ckt name
				i
				(car currents)
				(cadr currents))
		    (lp (cons i (cddr currents))))))))))

(define (terminal name node)
  ((node 'terminal) name))

(define (potential terminal)
  (car terminal))

(define (current terminal)
  (cdr terminal))

(define (finish-electrical-node node)
  (node 'finish))

;;; Later we can add value models to the connectors, to
;;; allow for units and useful magnitudes.

(define (make-potential ckt name)
  (cp:make-connector (symbol 'e% name) ckt))

(define (make-voltage ckt name)
  (cp:make-connector (symbol 'v% name) ckt))

(define (make-current ckt name)
  (cp:make-connector (symbol 'i% name) ckt))
    
(define (make-resistance ckt name)
  (cp:make-connector (symbol 'r% name) ckt))

(define (make-adder ckt name sum a1 a2)
  (cp:make-constraint cp:adder name ckt sum a1 a2))

(define (make-multiplier ckt name product m1 m2)
  (cp:make-constraint cp:multiplier name ckt product m1 m2))

(define (compound-name . stuff)
  (apply symbol
	 (let lp ((stuff stuff))
	   (if (null? (cdr stuff))
	       stuff
	       (cons (car stuff)
		     (cons ': (lp (cdr stuff))))))))

(define (make-directory ckt)
  (map (lambda (conn)
	 (list (cp:connector-name conn) conn))
       (cp:network-connectors ckt)))

(define (connector-named name ckt)
  (find-matching-item (cp:network-connectors ckt)
    (lambda (conn)
      (eq? (cp:connector-name conn) name))))

#|
;;; Example

(define (ladder2)
  (with-electrical-circuit 'ladder2
   (lambda (ckt)
     (with-electrical-nodes ckt 'l2 '(in gnd out)
       (lambda (in gnd out)
	 (let ((vss (make-voltage ckt 'VSS))
	       (ri (make-resistance ckt 'RI))
	       (rp (make-resistance ckt 'RP))
	       (ro (make-resistance ckt 'RO))
	       (rl (make-resistance ckt 'RL)))
	   (make-voltage-source ckt 'Vs vss in gnd)
	   (make-T-network ckt 'T ri rp ro in gnd out)
	   (make-resistor ckt 'load rl out gnd)))))))

(define l2 (ladder2))

(define l2-directory (make-directory l2))

(for-each (compose pp-comment car) l2-directory)
;i%gnd:l2
;v%load
;i%t1:load-out:l2
;i%t2:load-gnd:l2
;i%mid:T
;v%Rout:T
;i%t1:Rout:T-mid:T
;i%t2:Rout:T-out:l2
;v%Rp:T
;i%t1:Rp:T-mid:T
;i%t2:Rp:T-gnd:l2
;v%Rin:T
;i%t1:Rin:T-in:l2
;i%t2:Rin:T-mid:T
;e%mid:T
;i%t1:Vs-in:l2
;i%t2:Vs-gnd:l2
;v%VSS
;r%RI
;r%RP
;r%RO
;r%RL
;e%out:l2
;e%gnd:l2
;e%in:l2
;zero-i
;Unspecified return value

(cp:assume-value (connector-named 'r%RI l2) 1/2)

(cp:assume-value (connector-named 'r%RP l2) 1)

(cp:assume-value (connector-named 'r%RO l2) 1/2)

(cp:assume-value (connector-named 'r%RL l2) 1/2)

(cp:assume-value (connector-named 'v%VSS l2) 8)

(cp:assume-value (connector-named 'e%gnd:l2 l2) 0)

(cp:has-value? (connector-named 'v%load l2))
;Value: #f

(((ckt:algebra l2) 'plunk-connector)
 (connector-named 'v%load l2))

(cp:has-value? (connector-named 'v%load l2))
;value: #t

(cp:value-of (connector-named 'v%load l2))
;Value: 2

;;; Correct!

(cp:why? (connector-named 'v%load l2))
;(n129 (v%load = 2)
;      (equation-solver n128)
;      (n121 n122 n123 n124 n125 n126 n127))
;(n128 (+ -16 (* 8 x-v%load))
;      (additional n131 n132)
;      (n121 n122 n123 n124 n125 n126 n130 n127))
;(n131 (i%t2:Rin:T-mid:T = (* -4 x-v%load))
;      (mid:T n127 n133)
;      (n123 n124 n125 n126 n130 n127))
;(n132 (i%t2:Rin:T-mid:T = (+ -16 (* 4 x-v%load)))
;      (current:Rin:T n127 n134)
;      (n121 n124 n126 n130 n122 n125 n127))
;(n127 (zero-i = 0) (premise) (n127))
;(n133 (i%mid:T = (* 4 x-v%load))
;      (mid:T n135 n136)
;      (n123 n124 n125 n126 n130 n127))
;(n134 (i%t1:Rin:T-in:l2 = (+ 16 (* -4 x-v%load)))
;      (ohm:Rin:T n137 n121)
;      (n121 n124 n126 n127 n130 n122 n125))
;(n135 (i%t1:Rout:T-mid:T = (* 2 x-v%load))
;      (current:Rout:T n127 n138)
;      (n126 n130 n127))
;(n136 (i%t1:Rp:T-mid:T = (* 2 x-v%load))
;      (ohm:Rp:T n139 n123)
;      (n123 n124 n126 n127 n130 n125))
;(n137 (v%Rin:T = (+ 8 (* -2 x-v%load)))
;      (voltage:Rin:T n140 n141)
;      (n124 n126 n127 n130 n122 n125))
;(n121 (r%RI = 1/2) (premise) (n121))
;(n138 (i%t2:Rout:T-out:l2 = (* -2 x-v%load))
;      (out:l2 n127 n142)
;      (n126 n130 n127))
;(n139 (v%Rp:T = (* 2 x-v%load))
;      (voltage:Rp:T n141 n125)
;      (n124 n126 n127 n130 n125))
;(n123 (r%RP = 1) (premise) (n123))
;(n140 (e%in:l2 = 8) (voltage:Vs n125 n122) (n122 n125))
;(n141 (e%mid:T = (* 2 x-v%load))
;      (voltage:Rout:T n143 n144)
;      (n124 n126 n127 n130 n125))
;(n142 (i%t1:load-out:l2 = (* 2 x-v%load)) (ohm:load n130 n126) (n126 n130))
;(n125 (e%gnd:l2 = 0) (premise) (n125))
;(n122 (v%VSS = 8) (premise) (n122))
;(n143 (e%out:l2 = x-v%load) (voltage:load n125 n130) (n130 n125))
;(n144 (v%Rout:T = x-v%load) (ohm:Rout:T n135 n124) (n124 n126 n130 n127))
;(n130 (v%load = x-v%load) (premise) (n130))
;(n126 (r%RL = 1/2) (premise) (n126))
;(n124 (r%RO = 1/2) (premise) (n124))
;Unspecified return value
|#

#|
;;; Example

(define (bt)
  (with-electrical-circuit 'bt
   (lambda (ckt)
     (with-electrical-nodes ckt 'bt '(gnd n1 n2 n3 n4)
       (lambda (gnd n1 n2 n3 n4)
	 (let ((vss (make-voltage ckt 'VSS))
	       (r1 (make-resistance ckt 'R1))
	       (r2 (make-resistance ckt 'R2))
	       (r3 (make-resistance ckt 'R3))
	       (r4 (make-resistance ckt 'R4))
	       (r5 (make-resistance ckt 'R5))
	       (r6 (make-resistance ckt 'R6))
	       (r7 (make-resistance ckt 'R7)))
	   (make-voltage-source ckt 'Vs vss n1 gnd)
	   (make-resistor ckt 'R1 r1 n1 n2)
	   (make-resistor ckt 'R2 r2 n2 gnd)
	   (make-resistor ckt 'R3 r3 n2 n3)
	   (make-resistor ckt 'R4 r4 n3 gnd)
	   (make-resistor ckt 'R5 r5 n3 n4)
	   (make-resistor ckt 'R6 r6 n4 gnd)
	   (make-resistor ckt 'R7 r7 n2 n4)))))))

(define ckt3 (bt))

(define ckt3-directory (make-directory ckt3))

(for-each (compose pp-comment car) ckt3-directory)
;i%n4:bt
;i%n3:bt
;i%n2:bt
;i%n2:bt
;i%gnd:bt
;i%gnd:bt
;v%R7
;i%t1:R7-n2:bt
;i%t2:R7-n4:bt
;v%R6
;i%t1:R6-n4:bt
;i%t2:R6-gnd:bt
;v%R5
;i%t1:R5-n3:bt
;i%t2:R5-n4:bt
;v%R4
;i%t1:R4-n3:bt
;i%t2:R4-gnd:bt
;v%R3
;i%t1:R3-n2:bt
;i%t2:R3-n3:bt
;v%R2
;i%t1:R2-n2:bt
;i%t2:R2-gnd:bt
;v%R1
;i%t1:R1-n1:bt
;i%t2:R1-n2:bt
;i%t1:Vs-n1:bt
;i%t2:Vs-gnd:bt
;v%VSS
;r%R1
;r%R2
;r%R3
;r%R4
;r%R5
;r%R6
;r%R7
;e%n4:bt
;e%n3:bt
;e%n2:bt
;e%n1:bt
;e%gnd:bt
;zero-i
;Unspecified return value

(cp:assume-value (connector-named 'r%R1 ckt3) 5)

(cp:assume-value (connector-named 'r%R2 ckt3) 10)

(cp:assume-value (connector-named 'r%R3 ckt3) 8)

(cp:assume-value (connector-named 'r%R4 ckt3) 1)

(cp:assume-value (connector-named 'r%R5 ckt3) 2)

(cp:assume-value (connector-named 'r%R6 ckt3) 4)

(cp:assume-value (connector-named 'r%R7 ckt3) 3)

(cp:assume-value (connector-named 'v%VSS ckt3) 30)



(cp:assume-value (connector-named 'e%gnd:bt ckt3) 0)


(((ckt:algebra ckt3) 'plunk-connector) (connector-named 'e%n4:bt ckt3))

(((ckt:algebra ckt3) 'plunk-connector) (connector-named 'e%n3:bt ckt3))

(cp:value-of (connector-named 'v%R4 ckt3))
;Value: 2

(cp:value-of (connector-named 'v%R6 ckt3))
;Value: 4

(cp:value-of (connector-named 'v%R2 ckt3))
;Value: 10

;;; Correct...

(cp:why? (connector-named 'v%R6 ckt3))
;(n85 (v%R6 = 4)
;     (voltage:R6 n84 n81)
;     (n74 n75 n76 n77 n78 n79 n80 n81 n82 n83))
;(n84 (e%n4:bt = 4)
;     (equation-solver n86)
;     (n74 n75 n76 n77 n78 n79 n80 n81 n82 n83))
;(n81 (e%gnd:bt = 0) (premise) (n81))
;(n86 (+ -870/49 (* 435/98 x-e%n4:bt))
;     (equation n89 n90)
;     (n74 n75 n76 n77 n78 n79 n80 n81 n82 n87 n83 n88))
;(n89 (+ (* -29/2 x-e%n3:bt) (* 29/4 x-e%n4:bt))
;     (additional n91 n92)
;     (n77 n78 n79 n80 n81 n82 n87 n83 n88))
;(n90 (+ -6 (* 49/10 x-e%n3:bt) (* -19/20 x-e%n4:bt))
;     (additional n93 n94)
;     (n74 n75 n76 n79 n82 n80 n88 n78 n81 n87 n83))
;(n91 (v%R7 = (+ (* 13 x-e%n3:bt) (* -5 x-e%n4:bt)))
;     (voltage:R7 n95 n87)
;     (n79 n80 n81 n82 n87 n83 n88))
;(n92 (v%R7 = (+ (* -3/2 x-e%n3:bt) (* 9/4 x-e%n4:bt)))
;     (ohm:R7 n96 n77)
;     (n77 n78 n81 n82 n87 n88 n83))
;(n93 (i%t2:Vs-gnd:bt = (+ (* 23/10 x-e%n3:bt) (* -3/20 x-e%n4:bt)))
;     (gnd:bt n83 n97)
;     (n76 n79 n82 n80 n88 n78 n81 n87 n83))
;(n94 (i%t2:Vs-gnd:bt = (+ 6 (* -13/5 x-e%n3:bt) (* 4/5 x-e%n4:bt)))
;     (current:Vs n83 n98)
;     (n74 n79 n80 n82 n87 n88 n75 n81 n83))
;(n95 (e%n2:bt = (+ (* 13 x-e%n3:bt) (* -4 x-e%n4:bt)))
;     (voltage:R3 n88 n99)
;     (n79 n80 n81 n82 n87 n83 n88))
;(n87 (e%n4:bt = x-e%n4:bt) (premise) (n87))
;(n96 (i%t1:R7-n2:bt = (+ (* -1/2 x-e%n3:bt) (* 3/4 x-e%n4:bt)))
;     (current:R7 n83 n100)
;     (n78 n81 n82 n87 n88 n83))
;(n77 (r%R7 = 3) (premise) (n77))
;(n83 (zero-i = 0) (premise) (n83))
;(n97 (i%gnd:bt = (+ (* -23/10 x-e%n3:bt) (* 3/20 x-e%n4:bt)))
;     (gnd:bt n101 n102)
;     (n76 n79 n82 n80 n88 n78 n81 n87 n83))
;(n98 (i%t1:Vs-n1:bt = (+ -6 (* 13/5 x-e%n3:bt) (* -4/5 x-e%n4:bt)))
;     (n1:bt n83 n103)
;     (n74 n79 n80 n82 n87 n88 n75 n81 n83))
;(n88 (e%n3:bt = x-e%n3:bt) (premise) (n88))
;(n99 (v%R3 = (+ (* 12 x-e%n3:bt) (* -4 x-e%n4:bt)))
;     (ohm:R3 n104 n79)
;     (n79 n80 n81 n82 n87 n88 n83))
;(n100 (i%t2:R7-n4:bt = (+ (* 1/2 x-e%n3:bt) (* -3/4 x-e%n4:bt)))
;      (n4:bt n105 n106)
;      (n78 n81 n82 n87 n88 n83))
;(n101 (i%gnd:bt = (+ (* -1 x-e%n3:bt) (* -1/4 x-e%n4:bt)))
;      (gnd:bt n107 n108)
;      (n80 n88 n78 n81 n87 n83))
;(n102 (i%t2:R2-gnd:bt = (+ (* -13/10 x-e%n3:bt) (* 2/5 x-e%n4:bt)))
;      (current:R2 n83 n109)
;      (n76 n79 n80 n81 n82 n87 n88 n83))
;(n103 (i%t1:R1-n1:bt = (+ 6 (* -13/5 x-e%n3:bt) (* 4/5 x-e%n4:bt)))
;      (ohm:R1 n110 n74)
;      (n74 n79 n80 n82 n87 n83 n88 n75 n81))
;(n104 (i%t1:R3-n2:bt = (+ (* 3/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (current:R3 n83 n111)
;      (n80 n81 n82 n87 n88 n83))
;(n79 (r%R3 = 8) (premise) (n79))
;(n105 (i%n4:bt = (+ (* 1/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (n4:bt n83 n112)
;      (n82 n87 n88 n83))
;(n106 (i%t1:R6-n4:bt = (* 1/4 x-e%n4:bt)) (ohm:R6 n113 n78) (n78 n81 n87))
;(n107 (i%t2:R6-gnd:bt = (* -1/4 x-e%n4:bt))
;      (current:R6 n83 n106)
;      (n78 n81 n87 n83))
;(n108 (i%t2:R4-gnd:bt = (* -1 x-e%n3:bt))
;      (current:R4 n83 n114)
;      (n80 n81 n88 n83))
;(n109 (i%t1:R2-n2:bt = (+ (* 13/10 x-e%n3:bt) (* -2/5 x-e%n4:bt)))
;      (ohm:R2 n115 n76)
;      (n76 n79 n80 n81 n82 n87 n83 n88))
;(n110 (v%R1 = (+ 30 (* -13 x-e%n3:bt) (* 4 x-e%n4:bt)))
;      (voltage:R1 n116 n95)
;      (n79 n80 n82 n87 n83 n88 n75 n81))
;(n74 (r%R1 = 5) (premise) (n74))
;(n111 (i%t2:R3-n3:bt = (+ (* -3/2 x-e%n3:bt) (* 1/2 x-e%n4:bt)))
;      (n3:bt n83 n117)
;      (n80 n81 n82 n87 n88 n83))
;(n112 (i%t2:R5-n4:bt = (+ (* -1/2 x-e%n3:bt) (* 1/2 x-e%n4:bt)))
;      (current:R5 n83 n118)
;      (n82 n87 n88 n83))
;(n113 (v%R6 = x-e%n4:bt) (voltage:R6 n87 n81) (n81 n87))
;(n78 (r%R6 = 4) (premise) (n78))
;(n114 (i%t1:R4-n3:bt = x-e%n3:bt) (ohm:R4 n119 n80) (n80 n81 n88))
;(n115 (v%R2 = (+ (* 13 x-e%n3:bt) (* -4 x-e%n4:bt)))
;      (voltage:R2 n95 n81)
;      (n79 n80 n81 n82 n87 n83 n88))
;(n76 (r%R2 = 10) (premise) (n76))
;(n116 (e%n1:bt = 30) (voltage:Vs n81 n75) (n75 n81))
;(n117 (i%n3:bt = (+ (* 3/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (n3:bt n118 n114)
;      (n80 n81 n82 n87 n88))
;(n118 (i%t1:R5-n3:bt = (+ (* 1/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (ohm:R5 n120 n82)
;      (n82 n87 n88))
;(n119 (v%R4 = x-e%n3:bt) (voltage:R4 n88 n81) (n81 n88))
;(n80 (r%R4 = 1) (premise) (n80))
;(n75 (v%VSS = 30) (premise) (n75))
;(n120 (v%R5 = (+ x-e%n3:bt (* -1 x-e%n4:bt))) (voltage:R5 n88 n87) (n87 n88))
;(n82 (r%R5 = 2) (premise) (n82))
;Unspecified return value

|#