File: main.lisp

package info (click to toggle)
cl-rlc 0.1.2-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 48 kB
  • ctags: 15
  • sloc: lisp: 118; makefile: 44; sh: 28
file content (136 lines) | stat: -rw-r--r-- 4,005 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          rlc.lisp
;;;; Purpose:       RLC Functions
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Jan 2003
;;;;
;;;; $Id: kboot.lisp 8414 2003-12-28 19:46:57Z kevin $
;;;; *************************************************************************

(in-package #:rlc)

(defun plot-series-rlc-current (v r l c t-inc t-end &optional (t-start 0)
				(graph-function 'run-xgraph))
  (let ((path (make-pathname
	       :directory '(:absolute "tmp")
	       :name
	       (concatenate 'string "rlc-data-"
			    (write-to-string (get-universal-time)))
	       :type "dat")))
    (write-series-rlc-current-graph path v r l c t-inc t-end t-start)
    (funcall graph-function path)
    (sleep 2)
    (delete-file path)))

(defun run-xgraph (path)
  (kl::run-shell-command "xgraph ~A" (namestring path)))
    
(defun write-series-rlc-current-graph (path v r l c t-inc t-end
				       &optional (t-start 0))
  (with-open-file (out path :direction :output :if-exists :supersede
		   :if-does-not-exist :create)
    (write-series-rlc-current-graph-stream out v r l c t-inc t-end t-start)))

(defun write-series-rlc-current-graph-stream (out v r l c t-inc t-end
				       &optional (t-start 0))
  (multiple-value-bind (x y)
      (series-rlc-current-graph-data v r l c t-inc t-end t-start)
    (dotimes (i (length x))
      (format out "~D ~D~%" (aref x i) (aref y i)))))

(defun series-rlc-current-graph-data (v r l c t-inc t-end &optional (t-start 0))
  (let* ((formula-list (series-rlc-current-formula v r l c))
	 (formula-eval (eval formula-list))
	 (formula (compile nil formula-eval))
	 (n (ceiling (- t-end t-start) t-inc)))
    (do ((i 0 (1+ i))
	 (tm t-start (+ tm t-inc))
	 (x-pts (make-array n))
	 (y-pts (make-array n)))
	((= i n)
	 (values x-pts y-pts))
      (setf (aref x-pts i) tm)
      (setf (aref y-pts i) (funcall formula tm)))))

(defun series-rlc-current-time (v r l c tm)
  (let* ((formula-list (series-rlc-current-formula v r l c))
	 (formula (eval formula-list)))
    (funcall formula tm)))

(defun circuit-type (r l c)
   (cond
    ((and (zerop r) (zerop l) (zerop c))
     :null)
    ((and (/= 0 r) (zerop l) (zerop c))
     :r)
    ((and (zerop r) (/= 0 l) (zerop c))
     :l)
    ((and (zerop r) (zerop l) (/= 0 c))
     :c)
    ((and (/= 0 r) (/= 0 l) (zerop c))
     :rl)
    ((and (/= 0 r) (zerop l) (/= 0 c)) 
     :rc)
    ((and (zerop r) (/= 0 l) (/= 0 c))
     :lc)
    (t
     :rlc)))
  
(defun series-rlc-current-formula (v r l c)
  "Returns formula for currrent through a series RLC circuit with a step-voltage applied at time 0."
  (ecase (circuit-type r l c)
    (:null
     `(lambda (tm) (declare (ignore tm)) ,v))
    (:r
     `(lambda (tm) (declare (ignore tm)) ,(/ v r)))
    (:c
     `(lambda (tm)
	(if (zerop tm)
	    ,(* v c)
	  0)))
    (:l
     `(lambda (tm)
	(* ,(/ v l) tm)))
    (:rl
      `(lambda (tm)
	 (* ,(/ v r) (- 1 (exp (- (* tm ,(/ r l))))))))
    (:rc
     `(lambda (tm) (* ,(/ v r) (exp (- (* tm ,(/ 1 r c)))))))
     (:lc
      (let ((lc-root (sqrt (* l c))))
	`(lambda (tm)
	   (* ,(/ (* v lc-root) l) (sin (* tm ,(/ 1 lc-root)))))))
     (:rlc
      (let* ((r/2l (when (/= 0 l) (/ r (+ l l))))
	     (rr/4ll (when r/2l (* r/2l r/2l)))
	     (v/l (when (/= 0 l) (/ v l)))
	     (1/lc (when (and (/= 0 l) (/= 0 c)) (/ 1 (* l c)))))
	
	(cond
	 ;; RLC over-damped
	 ((> rr/4ll 1/lc)
	  (let* ((root (sqrt (- rr/4ll 1/lc)))
		 (p1 (+ (- r/2l) root))
		 (p2 (- (- r/2l) root)))
	    `(lambda (tm)
	       (* ,(/ v/l (- p1 p2))
		  (- (exp (* ,p1 tm)) (exp (* ,p2 tm)))))))
	 ;; RLC critcally-damped
	 ((= rr/4ll 1/lc)
	  `(lambda (tm)
	     (* tm
		,v/l
		(exp (- (* tm ,r/2l))))))
	 ;; RLC under-damped
	 (t
	  (let ((diff (- 1/lc rr/4ll)))
	    `(lambda (tm)
	       (* ,(/ v/l (sqrt diff))
		  (exp (- (* tm ,r/2l)))
		  (sin (* tm ,(sqrt diff))))))))))))