;;; 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))
;(n153 (v%load = 2)
;      (equation-solver n152)
;      (n144 n145 n146 n147 n148 n149 n150 n151))
;(n152 (+ 16 (* -8 x-v%load))
;      (equation n154 n151)
;      (n144 n145 n146 n147 n148 n149 n150 n151))
;(n154 (zero-i = (+ 16 (* -8 x-v%load)))
;      (gnd:l2 n155 n156)
;      (n144 n145 n146 n151 n147 n148 n149 n150))
;(n151 (zero-i = 0) (premise) (n151))
;(n155 (i%gnd:l2 = (* -4 x-v%load))
;      (gnd:l2 n157 n158)
;      (n151 n147 n148 n149 n146 n144))
;(n156 (i%t2:Vs-gnd:l2 = (+ 16 (* -4 x-v%load)))
;      (current:Vs n151 n159)
;      (n145 n146 n151 n147 n148 n149 n150))
;(n157 (i%t2:load-gnd:l2 = (* -2 x-v%load))
;      (current:load n151 n160)
;      (n151 n147 n148))
;(n158 (i%t2:Rp:T-gnd:l2 = (* -2 x-v%load))
;      (current:Rp:T n151 n161)
;      (n151 n147 n148 n149 n146 n144))
;(n159 (i%t1:Vs-in:l2 = (+ -16 (* 4 x-v%load)))
;      (in:l2 n151 n162)
;      (n145 n146 n151 n147 n148 n149 n150))
;(n160 (i%t1:load-out:l2 = (* 2 x-v%load)) (ohm:load n147 n148) (n147 n148))
;(n161 (i%t1:Rp:T-mid:T = (* 2 x-v%load))
;      (ohm:Rp:T n163 n144)
;      (n151 n147 n148 n149 n146 n144))
;(n162 (i%t1:Rin:T-in:l2 = (+ 16 (* -4 x-v%load)))
;      (ohm:Rin:T n164 n150)
;      (n145 n146 n151 n147 n148 n149 n150))
;(n147 (v%load = x-v%load) (premise) (n147))
;(n148 (r%RL = 1/2) (premise) (n148))
;(n163 (v%Rp:T = (* 2 x-v%load))
;      (voltage:Rp:T n165 n146)
;      (n151 n147 n148 n149 n146))
;(n144 (r%RP = 1) (premise) (n144))
;(n164 (v%Rin:T = (+ 8 (* -2 x-v%load)))
;      (voltage:Rin:T n166 n165)
;      (n145 n146 n151 n147 n148 n149))
;(n150 (r%RI = 1/2) (premise) (n150))
;(n165 (e%mid:T = (* 2 x-v%load))
;      (voltage:Rout:T n167 n168)
;      (n146 n151 n147 n148 n149))
;(n146 (e%gnd:l2 = 0) (premise) (n146))
;(n166 (e%in:l2 = 8) (voltage:Vs n146 n145) (n146 n145))
;(n167 (e%out:l2 = x-v%load) (voltage:load n146 n147) (n146 n147))
;(n168 (v%Rout:T = x-v%load) (ohm:Rout:T n169 n149) (n151 n147 n148 n149))
;(n145 (v%VSS = 8) (premise) (n145))
;(n169 (i%t1:Rout:T-mid:T = (* 2 x-v%load))
;      (current:Rout:T n151 n170)
;      (n151 n147 n148))
;(n149 (r%RO = 1/2) (premise) (n149))
;(n170 (i%t2:Rout:T-out:l2 = (* -2 x-v%load))
;      (out:l2 n151 n160)
;      (n151 n147 n148))
|#

#|
;;; 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))
;(n131 (v%R6 = 4)
;      (voltage:R6 n130 n127)
;      (n120 n121 n122 n123 n124 n125 n126 n127 n128 n129))
;(n130 (e%n4:bt = 4)
;      (equation-solver n132)
;      (n120 n121 n122 n123 n124 n125 n126 n127 n128 n129))
;(n127 (e%gnd:bt = 0) (premise) (n127))
;(n132 (+ 870/49 (* -435/98 x-e%n4:bt))
;      (equation n135 n136)
;      (n120 n121 n122 n123 n124 n125 n126 n127 n128 n133 n129 n134))
;(n135 (+ (* 29/2 x-e%n3:bt) (* -29/4 x-e%n4:bt))
;      (equation n137 n138)
;      (n123 n124 n125 n126 n127 n128 n133 n129 n134))
;(n136 (+ -6 (* 49/10 x-e%n3:bt) (* -19/20 x-e%n4:bt))
;      (equation n139 n140)
;      (n120 n121 n122 n125 n128 n126 n134 n124 n127 n133 n129))
;(n137 (v%R7 = (+ (* 13 x-e%n3:bt) (* -5 x-e%n4:bt)))
;      (voltage:R7 n141 n133)
;      (n125 n126 n127 n128 n133 n129 n134))
;(n138 (v%R7 = (+ (* -3/2 x-e%n3:bt) (* 9/4 x-e%n4:bt)))
;      (ohm:R7 n142 n123)
;      (n123 n124 n127 n128 n133 n134 n129))
;(n139 (i%t2:Vs-gnd:bt = (+ (* 23/10 x-e%n3:bt) (* -3/20 x-e%n4:bt)))
;      (gnd:bt n129 n143)
;      (n122 n125 n128 n126 n134 n124 n127 n133 n129))
;(n140 (i%t2:Vs-gnd:bt = (+ 6 (* -13/5 x-e%n3:bt) (* 4/5 x-e%n4:bt)))
;      (current:Vs n129 n144)
;      (n120 n125 n126 n128 n133 n134 n121 n127 n129))
;(n141 (e%n2:bt = (+ (* 13 x-e%n3:bt) (* -4 x-e%n4:bt)))
;      (voltage:R3 n134 n145)
;      (n125 n126 n127 n128 n133 n129 n134))
;(n133 (e%n4:bt = x-e%n4:bt) (premise) (n133))
;(n142 (i%t1:R7-n2:bt = (+ (* -1/2 x-e%n3:bt) (* 3/4 x-e%n4:bt)))
;      (current:R7 n129 n146)
;      (n124 n127 n128 n133 n134 n129))
;(n123 (r%R7 = 3) (premise) (n123))
;(n129 (zero-i = 0) (premise) (n129))
;(n143 (i%gnd:bt = (+ (* -23/10 x-e%n3:bt) (* 3/20 x-e%n4:bt)))
;      (gnd:bt n147 n148)
;      (n122 n125 n128 n126 n134 n124 n127 n133 n129))
;(n144 (i%t1:Vs-n1:bt = (+ -6 (* 13/5 x-e%n3:bt) (* -4/5 x-e%n4:bt)))
;      (n1:bt n129 n149)
;      (n120 n125 n126 n128 n133 n134 n121 n127 n129))
;(n134 (e%n3:bt = x-e%n3:bt) (premise) (n134))
;(n145 (v%R3 = (+ (* 12 x-e%n3:bt) (* -4 x-e%n4:bt)))
;      (ohm:R3 n150 n125)
;      (n125 n126 n127 n128 n133 n134 n129))
;(n146 (i%t2:R7-n4:bt = (+ (* 1/2 x-e%n3:bt) (* -3/4 x-e%n4:bt)))
;      (n4:bt n151 n152)
;      (n124 n127 n128 n133 n134 n129))
;(n147 (i%gnd:bt = (+ (* -1 x-e%n3:bt) (* -1/4 x-e%n4:bt)))
;      (gnd:bt n153 n154)
;      (n126 n134 n124 n127 n133 n129))
;(n148 (i%t2:R2-gnd:bt = (+ (* -13/10 x-e%n3:bt) (* 2/5 x-e%n4:bt)))
;      (current:R2 n129 n155)
;      (n122 n125 n126 n127 n128 n133 n134 n129))
;(n149 (i%t1:R1-n1:bt = (+ 6 (* -13/5 x-e%n3:bt) (* 4/5 x-e%n4:bt)))
;      (ohm:R1 n156 n120)
;      (n120 n125 n126 n128 n133 n129 n134 n121 n127))
;(n150 (i%t1:R3-n2:bt = (+ (* 3/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (current:R3 n129 n157)
;      (n126 n127 n128 n133 n134 n129))
;(n125 (r%R3 = 8) (premise) (n125))
;(n151 (i%n4:bt = (+ (* 1/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (n4:bt n129 n158)
;      (n128 n133 n134 n129))
;(n152 (i%t1:R6-n4:bt = (* 1/4 x-e%n4:bt)) (ohm:R6 n159 n124) (n124 n127 n133))
;(n153 (i%t2:R6-gnd:bt = (* -1/4 x-e%n4:bt))
;      (current:R6 n129 n152)
;      (n124 n127 n133 n129))
;(n154 (i%t2:R4-gnd:bt = (* -1 x-e%n3:bt))
;      (current:R4 n129 n160)
;      (n126 n127 n134 n129))
;(n155 (i%t1:R2-n2:bt = (+ (* 13/10 x-e%n3:bt) (* -2/5 x-e%n4:bt)))
;      (ohm:R2 n161 n122)
;      (n122 n125 n126 n127 n128 n133 n129 n134))
;(n156 (v%R1 = (+ 30 (* -13 x-e%n3:bt) (* 4 x-e%n4:bt)))
;      (voltage:R1 n162 n141)
;      (n125 n126 n128 n133 n129 n134 n121 n127))
;(n120 (r%R1 = 5) (premise) (n120))
;(n157 (i%t2:R3-n3:bt = (+ (* -3/2 x-e%n3:bt) (* 1/2 x-e%n4:bt)))
;      (n3:bt n129 n163)
;      (n126 n127 n128 n133 n134 n129))
;(n158 (i%t2:R5-n4:bt = (+ (* -1/2 x-e%n3:bt) (* 1/2 x-e%n4:bt)))
;      (current:R5 n129 n164)
;      (n128 n133 n134 n129))
;(n159 (v%R6 = x-e%n4:bt) (voltage:R6 n133 n127) (n127 n133))
;(n124 (r%R6 = 4) (premise) (n124))
;(n160 (i%t1:R4-n3:bt = x-e%n3:bt) (ohm:R4 n165 n126) (n126 n127 n134))
;(n161 (v%R2 = (+ (* 13 x-e%n3:bt) (* -4 x-e%n4:bt)))
;      (voltage:R2 n141 n127)
;      (n125 n126 n127 n128 n133 n129 n134))
;(n122 (r%R2 = 10) (premise) (n122))
;(n162 (e%n1:bt = 30) (voltage:Vs n127 n121) (n121 n127))
;(n163 (i%n3:bt = (+ (* 3/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (n3:bt n164 n160)
;      (n126 n127 n128 n133 n134))
;(n164 (i%t1:R5-n3:bt = (+ (* 1/2 x-e%n3:bt) (* -1/2 x-e%n4:bt)))
;      (ohm:R5 n166 n128)
;      (n128 n133 n134))
;(n165 (v%R4 = x-e%n3:bt) (voltage:R4 n134 n127) (n127 n134))
;(n126 (r%R4 = 1) (premise) (n126))
;(n121 (v%VSS = 30) (premise) (n121))
;(n166 (v%R5 = (+ x-e%n3:bt (* -1 x-e%n4:bt)))
;      (voltage:R5 n134 n133)
;      (n133 n134))
;(n128 (r%R5 = 2) (premise) (n128))
;Unspecified return value

|#