Documentation organization
[CommonLispStat.git] / ladata.lsp
blob303f2a9d95fb0aee7d9edf6d867c81410f4fe366
1 ;;; -*- mode: lisp -*-
2 ;;; Copyright (c) 2005--2007, by A.J. Rossini <blindglobe@gmail.com>
3 ;;; See COPYRIGHT file for any additional restrictions (BSD license).
4 ;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp.
6 ;;;; ladata -- Data handling functions for linear algebra interface
7 ;;;;
8 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
9 ;;;; unrestricted use.
11 ;;;;
12 ;;;; Package Setup
13 ;;;;
15 (in-package #:lisp-stat-basics)
17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18 ;;;;
19 ;;;; Data Mode Functions
20 ;;;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;;;
24 ;;;; These constants need to be redefined if IN, RE or CX in linalg.h
25 ;;;; are changed.
26 ;;;;
28 ;;; FIXME:AJR: This is how Luke got around having appropriate
29 ;;; approaches for Linear Algebra. We want to cheat and instead use
30 ;;; CLEM or MATLISP as the underlying linear algebra package.
32 (defparameter +mode-in+ 0)
33 (defparameter +mode-re+ 1)
34 (defparameter +mode-cx+ 2)
36 (defun mode-of (x)
37 (etypecase x
38 (fixnum +mode-in+)
39 (rational +mode-re+)
40 (float +mode-re+)
41 (complex +mode-cx+)))
43 (defun la-data-mode (data)
44 (let ((data (compound-data-seq data))
45 (mode 0))
46 (cond
47 ((vectorp data)
48 (let ((n (length data)))
49 (declare (fixnum n))
50 (dotimes (i n mode)
51 (declare (fixnum i))
52 (setf mode (max mode (mode-of (aref data i)))))))
53 ((consp data) (dolist (x data mode) (setf mode (max mode (mode-of x)))))
54 (t (error "bad sequence - ~s" data)))))
57 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58 ;;;;
59 ;;;; Internal Allocation Funcitons
60 ;;;;
61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 (defvar *la-allocations* nil)
65 (defun la-allocate (n m)
66 (let ((p (la-base-allocate n m)))
67 (if (null-ptr-p p) (error "allocation failed"))
68 (if (member p *la-allocations* :test #'ptr-eq)
69 (error "pointer is already on the list"))
70 (push p *la-allocations*)
71 p))
73 (defun la-free (p)
74 (when (and (not (null-ptr-p p)) (member p *la-allocations* :test #'ptr-eq))
75 (setf *la-allocations* (delete p *la-allocations* :test #'ptr-eq))
76 (la-base-free p)))
78 (defun la-cleanup-allocations ()
79 (let ((allocs (copy-list *la-allocations*)))
80 (dolist (p allocs) (la-free p))))
82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
83 ;;;;
84 ;;;; C Vector and Array Allocation
85 ;;;;
86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88 (defun la-vector(n mode) (la-allocate n (la-mode-size mode)))
89 (defun la-free-vector (v) (la-free v))
91 (defun la-matrix (n m mode)
92 (let ((matrix (la-allocate n (la-mode-size +mode-in+))))
93 (dotimes (i n)
94 (la-put-pointer matrix i (la-allocate m (la-mode-size mode))))
95 matrix))
97 (defun la-free-matrix (matrix n)
98 (dotimes (i n)
99 (la-free (la-get-pointer matrix i)))
100 (la-free matrix))
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
104 ;;;;
105 ;;;; C to/from Lisp Data Conversion
106 ;;;;
107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
109 (defun la-data-to-vector (data mode)
110 (check-sequence data)
111 (let* ((n (length data))
112 (vec (la-vector n mode))
113 (d (make-next-element data)))
114 (declare (fixnum n))
115 (cond
116 ((= mode +mode-in+)
117 (dotimes (i n)
118 (declare (fixnum i))
119 (la-put-integer vec i (get-next-element d i))))
120 ((= mode +mode-re+)
121 (dotimes (i n)
122 (declare (fixnum i))
123 (la-put-double vec i (get-next-element d i))))
124 ((= mode +mode-cx+)
125 (dotimes (i n)
126 (declare (fixnum i))
127 (let ((x (get-next-element d i)))
128 (la-put-complex vec i (realpart x) (imagpart x))))))
129 vec))
131 (defun la-data-to-matrix (data mode)
132 (check-matrix data)
133 (let* ((n (num-rows data))
134 (m (num-cols data))
135 (mat (la-matrix n m mode)))
136 (declare (fixnum n m))
137 (cond
138 ((= mode +mode-in+)
139 (dotimes (i n)
140 (declare (fixnum i))
141 (let ((vec (la-get-pointer mat i)))
142 (dotimes (j m)
143 (la-put-integer vec j (aref data i j))))))
144 ((= mode +mode-re+)
145 (dotimes (i n)
146 (declare (fixnum i))
147 (let ((vec (la-get-pointer mat i)))
148 (dotimes (j m)
149 (la-put-double vec j (aref data i j))))))
150 ((= mode +mode-cx+)
151 (dotimes (i n)
152 (declare (fixnum i))
153 (let ((vec (la-get-pointer mat i)))
154 (dotimes (j m)
155 (let ((x (aref data i j)))
156 (la-put-complex vec i (realpart x) (imagpart x))))))))
157 mat))
159 (defun la-vector-to-data (vec n mode data)
160 (declare (fixnum n))
161 (check-sequence data)
162 (let ((d (make-next-element data))
163 (gf (cond
164 ((= mode +mode-in+) #'la-get-integer)
165 ((= mode +mode-re+) #'la-get-double)
166 ((= mode +mode-cx+) #'la-get-complex))))
167 (dotimes (i n)
168 (declare (fixnum i))
169 (set-next-element d i (funcall gf vec i))))
170 data)
172 (defun la-matrix-to-data (mat n m mode result)
173 (declare (fixnum n m))
174 (check-matrix result)
175 (let ((gf (cond
176 ((= mode +mode-in+) #'la-get-integer)
177 ((= mode +mode-re+) #'la-get-double)
178 ((= mode +mode-cx+) #'la-get-complex))))
179 (dotimes (i n)
180 (declare (fixnum i))
181 (let ((vec (la-get-pointer mat i)))
182 (dotimes (j m)
183 (declare (fixnum j))
184 (setf (aref result i j) (funcall gf vec j))))))
185 result)