src/unittests/unittests-data.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-10-30 08:01:50 tony>
   4 ;;; Creation:   <2009-10-30 07:52:31 tony>
   5 ;;; File:       unittests-data.lisp
   6 ;;; Author:     AJ Rossini <blindglobe@gmail.com>
   7 ;;; Copyright:  (c)2008--, AJ Rossini.  This instance licensed under
   8 ;;;             the MIT license.  See file LICENSE.mit in top-level
   9 ;;;             directory for information.
  10 ;;; Purpose:    unittests for abstract data
  11
  12 ;;; What is this talk of 'release'? Klingons do not make software
  13 ;;; 'releases'.  Our software 'escapes', leaving a bloody trail of
  14 ;;; designers and quality assurance people in its wake.
  15
  16 (in-package :lisp-stat-unittests)
  17
  18 (deftestsuite lisp-stat-ut-data (lisp-stat-ut)
  19   ((my-statvar-emp-1
  20     (make-instance 'empirical-statistical-variable
  21                    :nobs 12))
  22    (my-statvar-mb-2
  23     (make-instance 'modelbased-statistical-variable
  24                    :pdmf #'(lambda (x) 1.0d0)
  25                    :drawf #'random))))
  26
  27 ;;; Ensure helper-functions work
  28
  29 (addtest (lisp-stat-ut-data) emp-stat-var-class
  30          (ensure
  31           (equal (nobs my-statvar-emp-1)
  32                  12)))
  33
  34 (describe (run-test :name 'emp-stat-var-class :suite 'lisp-stat-ut-data))
  35
  36 (addtest (lisp-stat-ut-dataframe) repeatseq
  37          (ensure
  38           (equal (cls-dataframe::repeat-seq 3 "d")
  39                  (list "d" "d" "d")))
  40                  (ensure
  41           (equal (cls-dataframe::repeat-seq 3 'd)
  42                  (list 'd 'd 'd))))
  43
  44
  45 (addtest (lisp-stat-ut-dataframe) make-labels
  46          (ensure
  47           (equal (cls-dataframe::make-labels "c" 3)
  48                  (list "c1" "c2" "c3")))
  49          (ensure-error
  50            (cls-dataframe::make-labels 'c 3)))
  51
  52
  53 ;;; Dataframe tests
  54
  55 (addtest (lisp-stat-ut-dataframe) df-equalp
  56          (ensure
  57           (equalp (dataset (make-instance 'dataframe-array
  58                                           :storage #2A(('a 'b)
  59                                                        ('c 'd))))
  60                   #2A(('a 'b)
  61                       ('c 'd)))))
  62
  63 (addtest (lisp-stat-ut-dataframe) df-consdata
  64          (ensure
  65           (consistent-dataframe-p my-df-1)))
  66
  67 (addtest (lisp-stat-ut-dataframe) df-consdata
  68          (ensure-error
  69            (slot-value my-df-1 'store)))
  70
  71 (addtest (lisp-stat-ut-dataframe) df-consdata
  72          (ensure
  73           (slot-value my-df-1 'cls-dataframe::store)))
  74
  75 (addtest (lisp-stat-ut-dataframe) df-consdata
  76          (ensure
  77           (dataset my-df-1)))
  78
  79 (addtest (lisp-stat-ut-dataframe) df-consdata
  80          (ensure
  81           (equalp
  82            (slot-value my-df-1 'cls-dataframe::store)
  83            (cls-dataframe::dataset my-df-1))))
  84
  85 (addtest (lisp-stat-ut-dataframe) df-consdata
  86          (ensure
  87           (eq (cls-dataframe::dataset my-df-1)
  88               (slot-value my-df-1 'cls-dataframe::store))))
  89
  90 ;; NEVER REACH INTO CLASS INTERIORS, NO PROMISE
  91 ;; GUARANTEE OF LATER CONSISTENCY...
  92
  93 (addtest (lisp-stat-ut-dataframe) df-consdata
  94          (ensure
  95           (cls-dataframe::doc-string my-df-1))
  96          (ensure-error
  97            (doc-string my-df-1)))
  98
  99 (addtest (lisp-stat-ut-dataframe) df-consdata
 100          (ensure
 101           (cls-dataframe::case-labels my-df-1))
 102          (ensure-error
 103            (case-labels my-df-1)))
 104
 105 (addtest (lisp-stat-ut-dataframe) df-consdata
 106          (ensure
 107           (cls-dataframe::var-labels my-df-1))
 108          (ensure-error
 109            (var-labels my-df-1)))
 110
 111 ;; need to ensure that for things like the following, that we protect
 112 ;; this a bit more so that the results are not going to to be wrong.
 113 ;; That would be a bit nasty if the dataframe-array becomes
 114 ;; inconsistent.
 115
 116 (addtest (lisp-stat-ut-dataframe) badAccess9
 117          (ensure
 118           (setf (cls-dataframe::var-labels my-df-1)
 119                 (list "a" "b"))))
 120
 121 (addtest (lisp-stat-ut-dataframe) badAccess10
 122          (ensure
 123           (progn
 124             ;; no error, but corrupts structure
 125             (setf (cls-dataframe::var-labels my-df-1)
 126                   (list "a" "b" "c"))
 127             ;; error happens here
 128             (not (consistent-dataframe-p my-df-1))))) ;; Nil
 129
 130 (addtest (lisp-stat-ut-dataframe) badAccess12
 131          (ensure
 132           (setf (cls-dataframe::var-labels my-df-1)
 133                 (list "a" "b"))))
 134
 135 (addtest (lisp-stat-ut-dataframe) badAccess13
 136          (ensure
 137           (consistent-dataframe-p my-df-1))) ;; T
 138
 139 ;; This is now done by:
 140 (addtest (lisp-stat-ut-dataframe) badAccess14
 141          (ensure-error
 142            (let ((old-varnames (varNames my-df-1)))
 143              (setf (varNames my-df-1) (list "a" "b")) ;; should error
 144              (setf (varNames my-df-1) old-varnames)
 145              (error "don't reach this point in badaccess14"))))
 146
 147
 148 ;; NEED TO CONFIRM THERE IS AN ERROR.
 149 (addtest (lisp-stat-ut-dataframe) badAccess15
 150          (ensure-error
 151           (let ((origCaseNames (caselabels my-df-1)))
 152             (setf (caselabels my-df-1) (list "a" "b" "c" 4 5))
 153             (caselabels my-df-1)
 154             (ignore-errors
 155               (setf (caselabels my-df-1)
 156                     (list "a" "b" 4 5)))
 157             (setf (caselabels my-df-1) origCaseNames))))
 158
 159 ;;;
 160 ;; (run-tests)
 161 ;; (describe (run-tests))
 162
 163
 164
 165   (equalp (dataset
 166            (make-instance 'dataframe-array
 167                           :storage #2A(('a 'b)
 168                                        ('c 'd))))
 169           #2A(('a 'b)
 170               ('c 'd)) )
 171
 172   (equalp (dataset
 173           (make-instance 'dataframe-array
 174                          :storage #2A((1 2)
 175                                       (3 4))))
 176                  #2A((1 2)
 177                      (3 4)))
 178
 179   (equalp (dataset
 180           (make-instance 'dataframe-array
 181                          :storage #2A((1d0 2d0)
 182                                       (3d0 4d0))))
 183                  #2A((1d0 2d0)
 184                      (3d0 4d0)))
 185