3 ;;; File: data-clos.lisp
4 ;;; Author: AJ Rossini <blindglobe@gmail.com>
5 ;;; Copyright: (c)2008, AJ Rossini. BSD, LLGPL, or GPLv2, depending
7 ;;; Purpose: data package for lispstat
8 ;;; Time-stamp: <2008-03-12 17:18:42 user>
9 ;;; Creation: <2008-03-12 17:18:42 user>
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.
15 ;;; This organization and structure is new to the 21st Century
20 ;;; redoing data structures in a CLOS based framework.
22 ;;; No real basis for work, there is a bit of new-ness and R-ness to
23 ;;; this work. In particular, the notion of relation is key and
24 ;;; integral to the analysis. Tables are related and matched
25 ;;; vectors,for example. "column" vectors are related observations
26 ;;; (by measure/recording) while "row" vectors are related readings
30 ;;; Relational structure -- can we capture a completely unnormalized
31 ;;; data strucutre to propose possible modeling approaches, and
32 ;;; propose appropriate models and inferential strategies?
35 ;; verb-driven schema for data collection. Should encode independence
36 ;; or lack of when possible.
40 :tables
(list (list t1
)
44 :stat-relation
'(t1 (:nest-within t2
) (:nest-within t3
))
51 (defpackage :lisp-stat-data-clos
55 (:export statistical-dataset
;; primary class for working.
57 modifyData
;; metadata mods
58 importData
;; get it in
59 reshapeData
;; data mods
61 consistent-statistical-dataset-p
62 varNames caseNames
;; metadata explicit modifiers
65 ;; and later, we remove the following, exposing only
66 ;; through the above method.
67 extract-1 extract-row extract-col extract-idx
70 (in-package :lisp-stat-data-clos
)
72 ;; Need to figure out typed vectors. We then map a series of typed
73 ;; vectors over to tables where columns are equal typed. In a sense,
74 ;; this is a relation (1-1) of equal-typed arrays. For the most part,
75 ;; this ends up making the R data.frame into a relational building
76 ;; block (considering 1-1 mappings using row ID as a relation).
77 ;; Is this a worthwhile generalization?
79 (defclass statistical-dataset
()
83 :documentation
"Data storage slot. Should be an array or a
85 (documentation-string :initform nil
88 :documentation
"Information about statistical-dataset.")
89 (case-labels :initform nil
92 :documentation
"labels used for describing cases (doc
93 metadata), possibly used for merging.")
94 (var-labels :initform nil
97 :documentation
"Variable names."))
98 (:documentation
"Standard Cases by Variables Statistical-Dataset."))
101 ;; statistical-dataset is the basic cases by variables framework.
102 ;; Need to embed this within other structures which allow for
103 ;; generalized relations. Goal is to ensure that relations imply and
104 ;; drive the potential for statistical relativeness such as
105 ;; correlation, interference, and similar concepts.
107 ;; Actions on a statistical data structure.
110 (defgeneric consistent-statistical-dataset-p
(ds)
111 (:documentation
"methods to check for consistency."))
113 (defmethod consistent-statistical-dataset-p ((ds statistical-dataset
))
114 "Test that statistical-dataset is internally consistent with metadata.
115 Ensure that dims of stored data are same as case and var labels."
116 (equal (array-dimensions (dataset ds
))
117 (list (length (var-labels ds
))
118 (length (case-labels ds
)))))
122 (defun extract-1 (sds idx1 idx2
)
124 (aref (dataset sds
) idx1 idx2
))
126 (defun extract-1-as-sds (sds idx1 idx2
)
127 "Need a version which returns a dataset."
128 (make-instance 'statistical-dataset
131 :initial-contents
(extract-1 sds idx1 idx2
))
132 ;; ensure copy for this and following
133 :doc
(doc-string sds
)
134 :case-labels
(caseNames sds
)
135 :var-labels
(varNames sds
)))
137 (defun gen-seq (n &optional
(start 1))
138 "There has to be a better way -- I'm sure of it! Always count from 1."
140 (append (gen-seq (- n
1) start
) (list n
))))
149 (defun extract-col (sds index
)
150 "Returns data as sequence."
152 #'(lambda (x) (extract-1 sds index x
))
153 (gen-seq (nth 2 (array-dimensions (dataset sds
))))))
155 (defun extract-col-as-sds (sds index
)
156 "Returns data as SDS, copied."
158 #'(lambda (x) (extract-1 sds index x
))
159 (gen-seq (nth 2 (array-dimensions (dataset sds
))))))
161 (defun extract-row (sds index
)
162 "Returns row as sequence."
164 #'(lambda (x) (extract-1 sds x index
))
165 (gen-seq (nth 1 (array-dimensions (dataset sds
))))))
167 (defun extract-idx (sds idx1Lst idx2Lst
)
168 "return an array, row X col dims. FIXME TESTME"
169 (let ((my-pre-array (list)))
172 (append my-pre-array
(extract-1 sds x y
))))
173 (make-array (list (length idx1Lst
) (length idx2Lst
))
174 :initial-contents my-pre-array
)))
177 (defun extract-idx-sds (sds idx1Lst idx2Lst
)
178 "return a dataset encapsulated version of extract-idx."
179 (make-instance 'statistical-dataset
181 (list (length idx1Lst
) (length idx2Lst
))
182 :initial-contents
(dataset sds
))
183 ;; ensure copy for this and following
184 :doc
(doc-string sds
)
185 :case-labels
(caseNames sds
)
186 :var-labels
(varNames sds
)))
188 (defgeneric extract
(sds whatAndRange
)
189 (:documentation
"data extraction approach"))
191 ;;; Printing methods and support.
193 (defun print-as-row (seq)
194 "Print a sequence formated as a row in a table."
195 (format t
"~{~D~T~}" seq
))
197 ;; (print-as-row (list 1 2 3))
199 (defun print-structure-table (ds)
200 "example of what we want the methods to look like. Should be sort
201 of like a spreadsheet if the storage is a table."
202 (print-as-row (var-labels ds
))
204 (dolist (i (case-labels ds
))
205 (print-as-row (append (list i
)
206 (extract-row (dataset ds
) (incf j
)))))))
209 (defun print-structure-relational (ds)
210 "example of what we want the methods to look like. Should be sort
211 of like a graph of spreadsheets if the storage is a relational
213 (dolist (k (relations ds
))
214 (let ((currentRelationSet (getRelation ds k
)))
215 (print-as-row (var-labels currentRelationSet
))
217 (dolist (i (case-labels currentRelationSet
))
220 (extract-row (dataset currentRelationSet
)
225 ;;; Shaping for computation
227 (defgeneric reshapeData
(dataform into-form as-copy
)
228 (:documentation
"pulling data into a new form"))
230 (defmethod reshapeData ((sds statistical-dataset
) what into-form
))
232 (defmethod reshapeData ((ds array
) (sp list
) copy-p
)
233 "Array via specList specialization: similar to the common R
234 approaches to redistribution.")
236 (defclass data-format
() ())
238 (defun row-order-as-list (ary)
239 "Pull out data in row order into a list."
240 (let ((result (list))
241 (nrows (nth 0 (array-dimensions ary
)))
242 (ncols (nth 1 (array-dimensions ary
))))
245 (nappend result
(aref ary i j
))))))
247 (defun col-order-as-list (ary)
248 "Pull out data in row order into a list."
249 (let ((result (list))
250 (nrows (nth 0 (array-dimensions ary
)))
251 (ncols (nth 1 (array-dimensions ary
))))
254 (nappend result
(aref ary i j
))))))
256 (defun transpose (ary)
258 (make-array (reverse (array-dimensions ary
))
259 :initial-contents
(col-order-as-list ary
)))
262 ;;; verbs vs semantics for dt conversion -- consider the possibily of
263 ;;; how adverbs and verbs relate, where to put which semantically to
264 ;;; allow for general approach.
266 ;;; eg. Kasper's talk on the FUSION collection of parsers.
273 ;;; Need to consider modification APIs
276 ;;; - get/set row names (case names)
277 ;;; - column names (variable names)
279 ;;; - annotation/metadata
280 ;;; - make sure that we do coherency checking in the exported
283 ;;; - reshapeData/reformat/reshapr a reformed version of the dataset (no
284 ;;; additional input).
285 ;;; - either overwriting or not, i.e. with or without copy.
286 ;;; - check consistency of resulting data with metadata and related
287 ;;; data information.
290 ;;; Variable-name handling for Tables. Needs error checking.
294 (defun set-varNames (ds vN
)
295 (if (= (length (var-labels ds
))
297 (setf (var-labels ds
) vN
)
298 (error "wrong size.")))
300 (defsetf varNames set-varNames
)
302 ;;; Case-name handling for Tables. Needs error checking.
303 (defun caseNames (ds)
306 (defun set-caseNames (ds vN
)
307 (if (= (length (case-labels ds
))
309 (setf (case-labels ds
) vN
)
310 (error "wrong size.")))
312 (defsetf caseNames set-caseNames
)
314 ;;; General modification approaches.
316 (defgeneric importData
(source featureList
)
317 (:documentation
"command to get data into CLS. Specific methods
318 will need to handle pathnames, internal data structures, and
319 external services such as DBMS's. We would like to be able to do
321 (importData MyPathName '(:formattype 'csvString))
322 (importData '(sqlConnection :server host.domain.net :port 666)
328 (defun pathname-example (name)
329 (let ((my-path (parse-namestring name
)))
330 (values (pathname-name my-path
:case
:common
)
331 (pathname-name my-path
:case
:local
))))
333 (defvar sourceTypes
(list 'csv
'lisp
'tsv
'special
)
334 "list of possible symbols used to specify source formats that might
335 be supported for input. CSV and TSV are standard, LISP refers to
336 forms, and SPECIAL refers to a FUNCTION which parses as
340 (defmethod importData ((fileHandle pathname
)
341 (fmt list
)) ;sourceTypes))
342 "File-based input for data.
344 (importData (parse-namestring 'path/to/file')
347 (importData myPathName (list :format 'lisp))
349 (let* ((fmtType (getf fmt
:format
))
350 (newData (getDataAsLists fileHandle fmtType
)))
355 ('special
(let ((parserFcn (getf fmt
:special-parser
)))))
356 (:default
(error "no standard default importData format")))))
358 (defmethod importData ((ds array
) (fmt list
))
359 "mapping arrays into CLS data.")
361 (defmethod importData ((dsSpec DBMSandSQLextract
)
363 "mapping DBMS into CLS data.")
366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
370 (in-package :cl-user
)
372 ;; if needed, but need to set the ASDf path first...!
373 ;; (asdf:oos 'asdf:load-op :lift)
375 (defpackage :lisp-stat-data-clos-example
377 :lift
:lisp-stat-unittests
378 :lisp-stat-data-clos
))
380 (in-package :lisp-stat-data-clos-example
)
383 ;;; Use of this package: To see what gets exported for use in others,
384 ;;; and how much corruption can be done to objects within a package.
387 (deftestsuite lisp-stat-dataclos
() ()) ;;(lisp-stat) ())
389 (addtest (lisp-stat-dataclos) genseq
391 (equal (lisp-stat-data-clos::gen-seq
4) (list 1 2 3 4))))
393 (addtest (lisp-stat-dataclos) genseq-null
395 (equal (lisp-stat-data-clos::gen-seq
0) nil
)))
397 (addtest (lisp-stat-dataclos) genseq-offset
399 (equal (lisp-stat-data-clos::gen-seq
4 2) (list 2 3 4))))
401 (addtest (lisp-stat-dataclos) equaltestnameData
403 (equal (lisp-stat-data-clos::dataset
404 (make-instance 'statistical-dataset
405 :storage
#2A
(('a
'b
) ('c
'd
))))
406 #2A
(('a
'b
) ('c
'd
)))))
409 "test ds for experiment.")
410 (setf my-ds-1
(make-instance 'statistical-dataset
))
415 "test ds for experiment.")
416 (setf my-ds-2
(make-instance 'statistical-dataset
417 :storage
#2A
((1 2 3 4 5) (10 20 30 40 50))
418 :doc
"This is an interesting statistical-dataset"
419 :case-labels
(list "a" "b" "c" "d" "e")
420 :var-labels
(list "x" "y")))
422 (make-array (list 3 5))
424 (array-dimensions (lisp-stat-data-clos::dataset my-ds-2
))
427 (addtest (lisp-stat-dataclos) consData
429 (consistent-statistical-dataset-p my-ds-2
)))
431 (addtest (lisp-stat-dataclos) badAccess1
433 (slot-value my-ds-2
'store
)))
435 (addtest (lisp-stat-dataclos) badAccess2
437 (slot-value my-ds-2
'store
)))
439 (addtest (lisp-stat-dataclos) badAccess3
441 (lisp-stat-data-clos::dataset my-ds-2
)))
443 (addtest (lisp-stat-dataclos) badAccess4
446 (slot-value my-ds-2
'lisp-stat-data-clos
::store
)
447 (lisp-stat-data-clos::dataset my-ds-2
))))
450 (addtest (lisp-stat-dataclos) badAccess5
452 (eq (lisp-stat-data-clos::dataset my-ds-2
)
453 (slot-value my-ds-2
'lisp-stat-data-clos
::store
))))
456 ;; NEVER DO THE FOLLOWING, UNLESS YOU WANT TO MUCK UP STRUCTURES...
457 (addtest (lisp-stat-dataclos) badAccess6
459 (lisp-stat-data-clos::doc-string my-ds-2
)))
461 (addtest (lisp-stat-dataclos) badAccess7
463 (lisp-stat-data-clos::case-labels my-ds-2
)))
465 (addtest (lisp-stat-dataclos) badAccess8
467 (lisp-stat-data-clos::var-labels my-ds-2
)))
469 ;; need to ensure that for things like the following, that we protect
470 ;; this a bit more so that the results are not going to to be wrong.
471 ;; That would be a bit nasty if the statistical-dataset becomes
474 (addtest (lisp-stat-dataclos) badAccess9
476 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
479 (addtest (lisp-stat-dataclos) badAccess10
482 ;; no error, but corrupts structure
483 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
485 ;; error happens here
486 (not (consistent-statistical-dataset-p my-ds-2
))))) ;; Nil
488 (addtest (lisp-stat-dataclos) badAccess12
490 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
493 (addtest (lisp-stat-dataclos) badAccess13
495 (consistent-statistical-dataset-p my-ds-2
))) ;; T
497 ;; This is now done by:
498 (addtest (lisp-stat-dataclos) badAccess14
500 (let ((old-varnames (varNames my-ds-2
)))
501 (setf (varNames my-ds-2
) (list "a" "b")) ;; should error
502 (setf (varNames my-ds-2
) old-varnames
)
503 (error "don't reach this point in badaccess14"))))
506 (defvar origCaseNames nil
)
508 (addtest (lisp-stat-dataclos) badAccess15
511 (setf origCaseNames
(caseNames my-ds-2
))
512 (setf (caseNames my-ds-2
) (list "a" "b" "c" 4 5))
514 (ignore-errors (setf (caseNames my-ds-2
) (list "a" "b" 4 5)))
515 (setf (caseNames my-ds-2
) origCaseNames
))))
518 ;; (describe (run-tests))