3 ;;; Time-stamp: <2009-03-11 09:27:36 tony>
4 ;;; Creation: <2008-09-08 08:06:30 tony>
5 ;;; File: listoflist.lisp
6 ;;; Author: AJ Rossini <blindglobe@gmail.com>
7 ;;; Copyright: (c) 2007-2008, AJ Rossini <blindglobe@gmail.com>. BSD.
8 ;;; Purpose: Manipulating structures which are lists of lists
9 ;;; rather than arrays or matrix-likes,
11 ;;; What is this talk of 'release'? Klingons do not make software
12 ;;; 'releases'. Our software 'escapes', leaving a bloody trail of
13 ;;; designers and quality assurance people in its wake.
16 ;; Where should this go?
17 (in-package :cls-data
)
21 ;; Serious flaw -- need to consider that we are not really well
22 ;; working with the data structures, in that Luke created compound as
23 ;; a base class, which turns out to be slightly backward if we are to
24 ;; maintain the numerical structures as well as computational
27 ;; Currently, we assume that the list-of-list representation is in
28 ;; row-major form, i.e. that lists represent rows and not columns.
29 ;; The original lisp-stat had the other way around. We could augment
30 ;; the top-level list with a property to check orientation
31 ;; (row-major/column-major), but this hasn't been done yet.
39 (defparameter *x1
* (list 1 2 3))
40 (defparameter *x2
* (list 1 2 3))
41 (defparameter *x3
* (list 1 2 3 4))
42 (defparameter *x4
* (list 1 2 3))
43 (reduce #'(lambda (x y
)
45 (mapcar #'length
(list *x1
* *x2
* *x3
*)))
46 (reduce #'(lambda (x y
)
47 (if (= x y
) y -
1)) (list 2 3 2))
48 (lists-of-same-size *x1
* *x2
* *x4
*) ; => T
49 (lists-of-same-size *x1
* *x3
* *x4
*) ; => F
50 (lists-of-same-size *x1
* *x2
* *x3
*) ; => F
51 (lists-of-same-size *x3
* *x1
* *x3
*) ; => F
55 (defun lists-of-same-size (&rest list-of-list-names
)
56 "Check if the lengths of the lists are equal (T, otherwise NIL), to
57 justify further processing and initial conditions."
58 (if (< 0 (reduce #'(lambda (x y
) (if (= x y
) y -
1))
59 (mapcar #'length list-of-list-names
)))
63 ;; the following will be handy to help out folks adjust. It should
64 ;; provide a means to write code faster and better.
65 (defmacro make-data-set-from-lists
(datasetname
66 &optional
(force-overwrite nil
)
67 &rest lists-of-data-lists
)
68 "Create a cases-by-variables data frame consisting of numeric data,
69 from a ROW-MAJOR list-of-lists representation. A COLUMN-MAJOR
70 representation should be handled using the transpose-listoflists
72 (if (or (not (boundp datasetname
))
74 (if (lists-of-same-size lists-of-data-lists
)
75 `(defparameter ,datasetname
76 (make-matrix (length iron
) 2
78 (mapcar #'(lambda (x y
)
79 (list (coerce x
'double-float
)
80 (coerce y
'double-float
)))
81 ,@lists-of-data-lists
)))
82 (error "make-data-set-from-lists: no combining different length lists"))
83 (error "make-data-set-from-lists: proposed name exists")))
86 (macroexpand '(make-data-set-from-lists
93 (defun transpose-listoflists (listoflists)
94 "This function does the moral-equivalent of a matrix transpose on a
95 list-of-lists data structure"
96 (apply #'mapcar
#'list listoflists
))
98 ;; (defparameter LOL-2by3 (list (list 1 2) (list 3 4) (list 5 6)))
99 ;; (defparameter LOL-3by2 (list (list 1 3 5) (list 2 4 6)))
100 ;; (transpose-listoflists (transpose-listoflists LOL-2by3))
101 ;; (transpose-listoflists (transpose-listoflists LOL-3by2))
103 (defun equal-listoflists (x y
)
104 "FIXME: This function, when written, should walk through 2 listoflists and
105 return T/nil based on equality."
107 ;; top-level length same
110 ;; FIXME: within-level lengths same
112 ;; FIXME: flattened values same, walking through
113 (loop over x and verify same tree as y
)))
116 (defun make-datatable-from-listoflists (lol &key
(type 'row-major
))
117 "From a listoflists structure, make a datatable."
118 (let ((n (length lol
))
119 (p (length (elt lol
0))))
120 (let ((result (make-array n p
)))
123 (setf (aref result i j
) (elt (elt lol j
) i
))))
126 (defun ensure-consistent-datatable-type (dt lot
)
127 "given a datatable and a listoftypes, ensure that the datatble
128 variables are consistent."
129 (destructuring-bind (n p
)
130 (array-dimensions dt
)
133 (check-type (aref dt i j
) (elt lot j
))))))