share/physics/elec.lisp

   1 ;;; -*- LISP -*-                                5 October 1979
   2 ;;;
   3 ;;; Electrical
   4
   5 ;;; Setup for the Macsyma world
   6
   7 ;; Make PARALLEL(arg1,arg2,...,argN) mean arg1 | arg2 | arg3 | ... | argN
   8
   9 (meval '(($ALIAS) $PARALLEL &/| ))
  10
  11  ;; Make "|" be an N-ary operator
  12
  13 ($NARY '&/|)
  14
  15  ;; Redefine label chars...
  16  ;;  (Cn) => (INn)
  17  ;;  (Dn) => (OUTn)
  18  ;;  (En) => (AUXn)
  19
  20 (SETQ $INCHAR '$IN $OUTCHAR '$OUT $LINECHAR '$AUX)
  21
  22  ;; Set up variables
  23
  24 ;;; Supporting Macros
  25
  26  ;; (MAKE-CIRCULAR-LIST <list>) returns a pointer to a circular list with
  27  ;;  elements of <list>
  28
  29 (DEFUN MAKE-CIRCULAR-LIST MACRO (FORM)
  30        `((LAMBDA (X) (NCONC X X)) (APPEND ,(CADR FORM) NIL)))
  31
  32 ;;; Define a "|" function which computes parallel resistances.
  33
  34 (DEFUN $/| N
  35        (LET ((COMPONENTS (LISTIFY N)))
  36             `((MQUOTIENT)
  37               ((MTIMES) ,@COMPONENTS)
  38               ((MPLUS)  ,@(PERMUTATIONS-OF-<N-1> N COMPONENTS)))))
  39
  40 (DEFUN PERMUTATIONS-OF-<N-1> (N-COMPONENTS COMPONENTS-LIST)
  41   (DO ((RETURN-VALUE ())
  42        (I 1. (1+ I))
  43        (CYCLE (MAKE-CIRCULAR-LIST COMPONENTS-LIST)
  44               (CDR CYCLE)))
  45       ((> I N-COMPONENTS) RETURN-VALUE)
  46     (PUSH (DO ((I 2. (1+ I))
  47                (RETURN-VALUE () (CONS (CAR L) RETURN-VALUE))
  48                (L CYCLE (CDR L)))
  49               ((> I N-COMPONENTS)
  50                (CONS '(MTIMES) RETURN-VALUE)))
  51           RETURN-VALUE)))