src/data/listoflist.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-04-16 17:28:54 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.
  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 ;;; Thoughts for organization: there are 2 general flavors of
  16 ;;; activities.  The first is that we do list-of-list to list-of-list
  17 ;;; transforms, and these do not rely on external packages being in
  18 ;;; existence.  The second is that we do transformations from them
  19 ;;; into other similar rectangular or ragged data structures.
  20 ;;; Within-structure should include item-selection and subsetting,
  21 ;;; while between-structure should include copying and ideally,
  22 ;;; "pass-through" referential structures.  The latter is probably
  23 ;;; going to take a performance hit, but should allow for maximal
  24 ;;; memory use.
  25
  26 ;; Where should this go?
  27 (in-package :cls-data-listoflist)
  28
  29 ;; Currently, we assume that the list-of-list representation is in
  30 ;; row-major form, i.e. that lists represent rows and not columns.
  31 ;; The original lisp-stat had the other way around.  We could augment
  32 ;; the top-level list with a property to check orientation
  33 ;; (row-major/column-major), but this hasn't been done yet.
  34
  35 #|
  36 ;; Test cases:
  37  (and T T nil T)
  38  (and T T T)
  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)
  44               (if (= x y) y -1))
  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
  52 |#
  53
  54
  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)))
  60       T nil))
  61
  62
  63 (defun listoflist->array (lol &key (type 'row-major))
  64   "From a listoflists structure, make an array.
  65
  66 FIXME: need to verify that the listoflists is a valid structure (same
  67 size rows, typing if required, etc.
  68
  69 <example>
  70   (defparameter *mdfl-test*
  71       (list (list 'a 1 2.1)
  72             (list 'b 2 1.1)
  73             (list 'c 1 2.0)
  74             (list 'd 2 3.0)))
  75   (length *mdfl-test*)
  76   (length (elt *mdfl-test* 0))
  77
  78   (defparameter *mdfl-test-dt* (make-datatable-from-listoflists *mdfl-test*))
  79   (array-dimensions *mdfl-test-dt*)
  80 </example>"
  81   (let ((n (length lol))
  82         (p (length (elt lol 0))))
  83     (let ((result (make-array (list n p))))
  84       (dotimes (i n)
  85         (dotimes (j p)
  86           (if (equal  type :row-major)
  87               (setf (aref result i j) (elt (elt lol i) j))
  88               (setf (aref result i j) (elt (elt lol j) i)))))
  89       result)))
  90
  91
  92 (defun listoflist->matrix-like (lol &key
  93                                 (orientation :row-major)
  94                                 (coerce-to 'double-float))
  95   "From a listoflists structure of numbers, return a matrix-like.
  96
  97 FIXME: need to verify that the listoflists is a valid structure (same
  98 size rows, typing if required, etc.
  99
 100 FIXME: need to grep special variables to make the right kind of
 101 matrix-like.
 102
 103 <example>
 104   (defparameter *lol-ml-test*
 105       (list (list 1d0 1d0 2.1d0)
 106             (list 2d0 2d0 1.1d0)))
 107   (length *lol-ml-test*)
 108   (length (elt *lol-ml-test* 0))
 109
 110   (defparameter *lol-ml-result* (listoflist->matrix-like *lol-ml-test*))
 111   (matrix-dimensions *lol-ml-result*)
 112 </example>"
 113   (declare (ignorable coerce-to))
 114   (let ((n (length lol))
 115         (p (length (elt lol 0))))
 116     (let ((result (make-matrix  n p :initial-element 0d0)))
 117       (dotimes (i n)
 118         (dotimes (j p)
 119           (if (equal orientation :row-major)
 120               (setf (mref result i j) (coerce (elt (elt lol i) j) coerce-to))
 121               (setf (mref result i j) (coerce (elt (elt lol j) i) coerce-to)))))
 122       result)))
 123
 124
 125 ;; the following will be handy to help out folks adjust.  It should
 126 ;; provide a means to write code faster and better.
 127 (defun listoflist->dataframe (lol) ; &key (type :row-major))
 128   "Create a cases-by-variables data frame consisting of numeric data,
 129 from a ROW-MAJOR list-of-lists representation.  A COLUMN-MAJOR
 130 representation should be handled using the transpose-listoflists
 131 function."
 132   (if (lists-of-same-size lol)
 133       (make-dataframe  (listoflist->array lol))
 134       (error "make-data-set-from-lists: no combining different length lists"))
 135   (error "make-data-set-from-lists: proposed name exists"))
 136
 137
 138 (defun transpose-listoflist (listoflist)
 139   "This function does the moral-equivalent of a matrix transpose on a
 140 list-of-lists data structure"
 141   (apply #'mapcar #'list listoflist))
 142
 143 ;; (defparameter LOL-2by3 (list (list 1 2) (list 3 4) (list 5 6)))
 144 ;; (defparameter LOL-3by2 (list (list 1 3 5) (list 2 4 6)))
 145 ;; (transpose-listoflists (transpose-listoflists LOL-2by3))
 146 ;; (transpose-listoflists (transpose-listoflists LOL-3by2))
 147
 148 (defun equal-listoflist (x y)
 149   "FIXME: This function, when written, should walk through 2 listoflists and
 150 return T/nil based on equality."
 151   (and (= (list-length x) ;; top-level length same
 152           (list-length y))
 153        ;; FIXME: within-level lengths same
 154        ;; FIXME: flattened values same, walking through
 155        ;; (loop over x and verify same tree as y)
 156        ))
 157
 158
 159
 160 #|
 161   (defparameter *mdfl-test*
 162       (list (list 'a 1 2.1)
 163             (list 'b 2 1.1)
 164             (list 'c 1 2.0)
 165             (list 'd 2 3.0)))
 166   (length *mdfl-test*)
 167   (length (elt *mdfl-test* 0))
 168
 169   (defparameter *mdfl-test-dt* (make-datatable-from-listoflists *mdfl-test*))
 170   (array-dimensions *mdfl-test-dt*)
 171
 172 |#