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