src/data/dataframe-array.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2012-10-09 03:17:34 tony>
   4 ;;; Creation:   <2009-03-12 17:14:56 tony>
   5 ;;; File:       dataframe-array.lisp
   6 ;;; Author:     AJ Rossini <blindglobe@gmail.com>
   7 ;;; Copyright:  (c)2009--, AJ Rossini. BSD, LLGPL, or GPLv2, depending
   8 ;;;             on how it arrives.
   9 ;;; Purpose:    real dataframe class using lisp-arrays as storage.
  10
  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.
  14
  15 ;;; This organization and structure is new to the 21st Century
  16 ;;; version..   Think, "21st Century Schizoid Man".
  17
  18 (in-package :cls-dataframe)
  19
  20 ;;;;; DATAFRAME-ARRAY
  21
  22 (defclass dataframe-array (dataframe-like)
  23   ((store :initform nil
  24           :initarg :storage
  25           :type (array * *)
  26           :accessor dataset
  27           :documentation "Data storage: typed as array.")
  28    (store-class :initform 'array
  29                 :accessor store
  30                 :documentation "Storage class is ARRAY."))
  31   (:documentation "example implementation of dataframe-like using storage
  32   based on lisp arrays.  An obvious alternative could be a
  33   dataframe-matrix-like which uses the lisp-matrix classes."))
  34
  35 (defmethod make-dataframe2 ((data dataframe-array)
  36                             &key vartypes varlabels caselabels doc)
  37   (check-dataframe-params data vartypes varlabels caselabels doc)
  38   (let ((newcaselabels (if caselabels
  39                            caselabels
  40                              (make-labels "C" (ncases data))))
  41           (newvarlabels (if varlabels
  42                             varlabels
  43                             (make-labels "V" (nvars data))))
  44           ;; also should determine most restrictive possible (compsci
  45           ;; and/or statistical) variable typing (integer, double,
  46           ;; string, symbol, *).  FIXME: until we get the mixed typing system in place, we will just leave null
  47           (newvartypes (if vartypes
  48                           vartypes
  49                           (make-labels "*" (nvars data)))))
  50       (make-instance 'dataframe-array
  51                      :storage data
  52                      :nrows (length newcaselabels)
  53                      :ncols (length newvarlabels)
  54                      :case-labels newcaselabels
  55                      :var-labels newvarlabels
  56                      :var-types newvartypes)))
  57
  58
  59 (defmethod nrows ((df dataframe-array))
  60   "specializes on inheritance from matrix-like in lisp-matrix."
  61   (array-dimension (dataset df) 0))
  62
  63 (defmethod ncols ((df dataframe-array))
  64   "specializes on inheritance from matrix-like in lisp-matrix."
  65   (array-dimension (dataset df) 1))
  66
  67 (defmethod xref ((df dataframe-array) &rest subscripts)
  68   "Returns a scalar in array, in the same vein as aref, mref, vref, etc.
  69 idx1/2 is row/col or case/var."
  70   (assert (>= 2 (length subscripts)))
  71 #| ;; needed?
  72   (assert (typep (elt subscripts 0) integer))
  73   (assert (typep (elt subscripts 1) integer))
  74 |#
  75   (aref (dataset df) (elt subscripts 0) (elt subscripts 1)))
  76
  77 (defmethod (setf xref) (value (df dataframe-array) &rest subscripts)
  78   "set value for df-ar."
  79   ;; (check-type val (elt (var-type df) index2))
  80   (setf (aref (dataset df) (elt subscripts 0) (elt subscripts 1)) value))
  81
  82 (defparameter *default-dataframe-class* 'dataframe-array)
  83
  84 (defmethod dfselect ((df dataframe-array)
  85                      &optional cases vars indices)
  86   "Extract the OR of cases, vars, or have a list of indices to extract"
  87   (if indices (error "Indicies not used yet"))
  88   (let ((newdf (make-instance *default-dataframe-class*
  89                 :storage (make-array (list  (length cases) (length vars)))
  90                 :nrows (length cases)
  91                 :ncols (length vars)
  92 #|
  93                 :case-labels (select-list caselist (case-labels df))
  94                 :var-labels (select-list varlist (var-labels df))
  95                 :var-types (select-list varlist (vartypes df))
  96 |#
  97                 )))
  98     (dotimes (i (length cases))
  99       (dotimes (j (length vars))
 100         (setf (xref newdf i j)
 101               (xref df
 102                     (position (elt cases i) (case-labels df))
 103                     (position (elt vars j) (var-labels df))))))))
 104