main.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          rlc.lisp
   6 ;;;; Purpose:       RLC Functions
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Jan 2003
   9 ;;;;
  10 ;;;; $Id: kboot.lisp 8414 2003-12-28 19:46:57Z kevin $
  11 ;;;; *************************************************************************
  12
  13 (in-package #:rlc)
  14
  15 (defun plot-series-rlc-current (v r l c t-inc t-end &optional (t-start 0))
  16   (let ((path (make-pathname
  17                :directory '(:absolute "tmp")
  18                :name
  19                (concatenate 'string "rlc-data-"
  20                             (write-to-string (get-universal-time)))
  21                :type "dat")))
  22     (write-series-rlc-graph path v r l c t-inc t-end t-start)
  23     (run-xgraph path)
  24     (sleep 2)
  25     (delete-file path)))
  26
  27 (defun run-xgraph (path)
  28   (kl::run-shell-command "xgraph ~A" (namestring path)))
  29
  30 (defun write-series-rlc-current-graph (path v r l c t-inc t-end
  31                                        &optional (t-start 0))
  32   (multiple-value-bind (x y)
  33       (series-rlc-current-graph-data v r l c t-inc t-end t-start)
  34     (with-open-file (out path :direction :output :if-exists :supersede
  35                          :if-does-not-exist :create)
  36       (dotimes (i (length x))
  37         (format out "~D ~D~%" (aref x i) (aref y i))))))
  38
  39 (defun series-rlc-current-graph-data (v r l c t-inc t-end &optional (t-start 0))
  40   (let* ((formula-list (series-rlc-current-formula v r l c))
  41          (formula-eval (eval formula-list))
  42          (formula (compile nil formula-eval))
  43          (n (ceiling (- t-end t-start) t-inc)))
  44     (do ((i 0 (1+ i))
  45          (tm t-start (+ tm t-inc))
  46          (x-pts (make-array n))
  47          (y-pts (make-array n)))
  48         ((= i n)
  49          (values x-pts y-pts))
  50       (setf (aref x-pts i) tm)
  51       (setf (aref y-pts i) (funcall formula tm)))))
  52
  53 (defun series-rlc-current-time (v r l c tm)
  54   (let* ((formula-list (series-rlc-current-formula v r l c))
  55          (formula (eval formula-list)))
  56     (funcall formula tm)))
  57
  58 (defun circuit-type (r l c)
  59    (cond
  60     ((and (zerop r) (zerop l) (zerop c))
  61      :null)
  62     ((and (/= 0 r) (zerop l) (zerop c))
  63      :r)
  64     ((and (zerop r) (/= 0 l) (zerop c))
  65      :l)
  66     ((and (zerop r) (zerop l) (/= 0 c))
  67      :c)
  68     ((and (/= 0 r) (/= 0 l) (zerop c))
  69      :rl)
  70     ((and (/= 0 r) (zerop l) (/= 0 c))
  71      :rc)
  72     ((and (zerop r) (/= 0 l) (/= 0 c))
  73      :lc)
  74     (t
  75      :rlc)))
  76
  77 (defun series-rlc-current-formula (v r l c)
  78   "Returns formula for currrent through a series RLC circuit with a step-voltage applied at time 0."
  79   (ecase (circuit-type r l c)
  80     (:null
  81      `(lambda (tm) ,v))
  82     (:r
  83      `(lambda (tm) ,(/ v r)))
  84     (:c
  85      `(lambda (tm)
  86         (if (zerop rm)
  87             ,(* v c)
  88           0)))
  89     (:l
  90      `(lambda (tm)
  91         (* ,(/ v l) t)))
  92     (:rl
  93       `(lambda (tm)
  94          (* ,(/ v r) (- 1 (exp (- (* tm ,(/ r l))))))))
  95     (:rc
  96      `(lambda (tm) (* ,(/ v r) (exp (- (* tm ,(/ 1 r c)))))))
  97      (:lc
  98       (let ((lc-root (sqrt (* l c))))
  99         `(lambda (tm)
 100            (* ,(/ (* v lc-root) l) (sin (* tm ,(/ 1 lc-root)))))))
 101      (:rlc
 102       (let* ((r/2l (when (/= 0 l) (/ r (+ l l))))
 103              (rr/4ll (when r/2l (* r/2l r/2l)))
 104              (v/l (when (/= 0 l) (/ v l)))
 105              (1/lc (when (and (/= 0 l) (/= 0 c)) (/ 1 (* l c)))))
 106
 107         (cond
 108          ;; RLC over-damped
 109          ((> rr/4ll 1/lc)
 110           (let* ((root (sqrt (- rr/4ll 1/lc)))
 111                  (p1 (+ (- r/2l) root))
 112                  (p2 (- (- r/2l) root)))
 113             `(lambda (tm)
 114                (* ,(/ v/l (- p1 p2))
 115                   (- (exp (* ,p1 tm)) (exp (* ,p2 tm)))))))
 116          ;; RLC critcally-damped
 117          ((= rr/4ll 1/lc)
 118           `(lambda (tm)
 119              (* tm
 120                 ,v/l
 121                 (exp (- (* tm ,r/2l))))))
 122          ;; RLC under-damped
 123          (t
 124           (let ((diff (- 1/lc rr/4ll)))
 125             `(lambda (tm)
 126                (* ,(/ v/l (sqrt diff))
 127                   (exp (- (* tm ,r/2l)))
 128                   (sin (* tm ,(sqrt diff))))))))))))
 129
 130
 131