TODO.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-07-06 18:11:03 tony>
   4 ;;; Creation:   <2008-09-08 08:06:30 tony>
   5 ;;; File:       TODO.lisp
   6 ;;; Author:     AJ Rossini <blindglobe@gmail.com>
   7 ;;; Copyright:  (c) 2007-2008, AJ Rossini <blindglobe@gmail.com>.  BSD.
   8 ;;; Purpose: Stuff that needs to be made working sits inside the
   9 ;;;          progns... This file contains the current challenges to
  10 ;;;          solve, including a description of the setup and the work
  11 ;;;          to solve....
  12
  13 ;;; What is this talk of 'release'? Klingons do not make software
  14 ;;; 'releases'.  Our software 'escapes', leaving a bloody trail of
  15 ;;; designers and quality assurance people in its wake.
  16
  17 ;;; SET UP
  18
  19 (in-package :cl-user)
  20
  21 (defun init-CLS ()
  22   (asdf:oos 'asdf:load-op 'lispstat))
  23
  24 (defun init-CLS-graphics ()
  25   (init-CLS)
  26   (asdf:oos 'asdf:load-op 'cl-cairo2-x11)
  27   (asdf:oos 'asdf:load-op 'cl-2d))
  28
  29 (init-CLS-graphics)
  30
  31 ;;(asdf:oos 'asdf:load-op 'lisp-matrix)
  32 ;;(asdf:oos 'asdf:compile-op 'lispstat :force t)
  33 ;;(asdf:oos 'asdf:load-op 'lispstat)
  34
  35 (in-package :lisp-stat-unittests)
  36
  37 ;; tests = 80, failures = 8, errors = 15
  38 (run-tests :suite 'lisp-stat-ut)
  39 (describe (run-tests :suite 'lisp-stat-ut))
  40
  41 (describe 'lisp-stat-ut)
  42 (documentation 'lisp-stat-ut 'type)
  43
  44 ;; FIXME: Example: currently not relevant, yet
  45 ;;   (describe (lift::run-test :test-case  'lisp-stat-unittests::create-proto
  46 ;;                             :suite 'lisp-stat-unittests::lisp-stat-ut-proto))
  47
  48 (describe (lift::run-tests :suite 'lisp-stat-ut-dataframe))
  49 (lift::run-tests :suite 'lisp-stat-ut-dataframe)
  50
  51 (describe (lift::run-test
  52            :test-case  'lisp-stat-unittests::create-proto
  53            :suite 'lisp-stat-unittests::lisp-stat-ut-proto))
  54
  55
  56 (in-package :ls-user)
  57
  58
  59 (progn
  60   ;; REVIEW: general Lisp use guidance
  61
  62   (fdefinition 'make-matrix)
  63   (documentation 'make-matrix 'function)
  64
  65 #| Examples from CLHS, a bit of guidance.
  66
  67   ;; This function assumes its callers have checked the types of the
  68   ;; arguments, and authorizes the compiler to build in that assumption.
  69   (defun discriminant (a b c)
  70    (declare (number a b c))
  71    "Compute the discriminant for a quadratic equation."
  72    (- (* b b) (* 4 a c))) =>  DISCRIMINANT
  73   (discriminant 1 2/3 -2) =>  76/9
  74
  75   ;; This function assumes its callers have not checked the types of the
  76   ;; arguments, and performs explicit type checks before making any assumptions.
  77  (defun careful-discriminant (a b c)
  78    "Compute the discriminant for a quadratic equation."
  79    (check-type a number)
  80    (check-type b number)
  81    (check-type c number)
  82    (locally (declare (number a b c))
  83      (- (* b b) (* 4 a c)))) =>  CAREFUL-DISCRIMINANT
  84  (careful-discriminant 1 2/3 -2) =>  76/9
  85 |#
  86   )
  87
  88
  89 #+nil
  90 (progn ;; experiments with GSL and the Lisp interface.
  91   (asdf:oos 'asdf:load-op 'gsll)
  92   (asdf:oos 'asdf:load-op 'gsll-tests) ; requires lisp-unit
  93
  94   ;; the following should be equivalent
  95   (defparameter *t1*  (LIST 6.18d0 6.647777777777779d0 6.18d0))
  96   (defparameter *t2*  (MULTIPLE-VALUE-LIST
  97                (LET ((VEC
  98                       (gsll:make-marray 'DOUBLE-FLOAT
  99                                         :INITIAL-CONTENTS '(-3.21d0 1.0d0 12.8d0)))
 100                      (WEIGHTS
 101                       (gsll:MAKE-MARRAY 'DOUBLE-FLOAT
 102                                         :INITIAL-CONTENTS '(3.0d0 1.0d0 2.0d0))))
 103                  (LET ((MEAN (gsll:MEAN VEC)))
 104                    (LIST (gsll:ABSOLUTE-DEVIATION VEC)
 105                          (gsll:WEIGHTED-ABSOLUTE-DEVIATION VEC WEIGHTS)
 106                          (gsll:ABSOLUTE-DEVIATION VEC MEAN))))))
 107   (eql *t1* *t2*)
 108   (equal *t1* *t2*)
 109
 110   ;; from (gsll:examples 'gsll::numerical-integration) ...
 111   (gsll:integration-qng gsll::one-sine 0.0d0 PI)
 112
 113   (gsll:defun-single axpb (x) (+ (* 2 x) 3)) ;; a<-2, b<-3
 114   (gsll:integration-qng axpb 1d0 2d0)
 115
 116   (let ((a 2)
 117         (b 3))
 118     (defun-single axpb2 (x) (+ (* a x) b)))
 119   (gsll:integration-qng axpb2 1d0 2d0)
 120
 121   ;;   BAD
 122   ;;   (gsll:integration-qng
 123   ;;    (let ((a 2)
 124   ;;     (b 3))
 125   ;;      (defun-single axpb2 (x) (+ (* a x) b)))
 126   ;;    1d0 2d0)
 127
 128   ;; right, but weird expansion...
 129   (gsll:integration-qng
 130    (let ((a 2)
 131          (b 3))
 132      (defun axpb2 (x) (+ (* a x) b))
 133      (gsll:def-single-function axpb2)
 134      axpb2)
 135    1d0 2d0)
 136
 137   ;; Linear least squares
 138
 139   (gsll:gsl-lookup "gsl_linalg_LU_decomp") ; => gsll:lu-decomposition
 140   (gsll:gsl-lookup "gsl_linalg_LU_solve") ; => gsll:lu-solve
 141   )
 142
 143
 144 #+nil
 145 (progn
 146   (asdf:oos 'asdf:load-op 'versioned-objects)
 147   (asdf:oos 'asdf:load-op 'validations)
 148
 149   )
 150
 151
 152 ;; SETUP FOR PLOT EXAMPLE:
 153
 154
 155 (defpackage :cl-2d-user-x11
 156   (:use :cl :cl-cairo2  :cl-2d :cl-numlib :cl-colors :bind))
 157
 158 (in-package :cl-2d-user-x11)
 159
 160 ;; PLOT EXAMPLE
 161 #+nil
 162 (progn
 163
 164
 165   ;; this is how you create an X11 frame.  If you supply a
 166   ;; background-color to as-frame, each plot will clear the frame with
 167   ;; this color.
 168
 169   (defparameter *frame1* (as-frame (create-xlib-image-context 300 300)
 170                                   :background-color +white+))
 171
 172   ;; or netbook size, picture is similar but on a lower-res display window.
 173   (defparameter *frame2* (as-frame (create-xlib-image-context 200 200)
 174                                   :background-color +white+))
 175
 176   (plot-function *frame1*
 177                  #'exp (interval-of 0 2)
 178                  :x-title "x"
 179                  :y-title "exp(x)")
 180
 181   ;; split the frame, and you can draw on the subframes independently.
 182   ;; I do this a lot.
 183
 184   (bind ((#2A((f1 f2) (f3 f4))
 185              (split-frame *frame2* (percent 50) (percent 50))))
 186         (defparameter *f1* f1)
 187         (defparameter *f2* f2)
 188         (defparameter *f3* f3)
 189         (defparameter *f4* f4))
 190
 191
 192   (bind ((#2A((f1 f2) (f3 f4))
 193              (split-frame *frame2* (percent 75) (percent 25))))
 194         (defparameter *f1* f1)
 195         (defparameter *f2* f2)
 196         (defparameter *f3* f3)
 197         (defparameter *f4* f4))
 198
 199   (plot-function *f1* #'sin (interval-of 0 2) :x-title "x" :y-title "sin(x)")
 200   (plot-function *f2* #'cos (interval-of 0 2) :x-title "x" :y-title "cos(x)")
 201   (plot-function *f3* #'tan (interval-of 0 2) :x-title "x" :y-title "tan(x)")
 202   (plot-function *f4* #'/ (interval-of 0 2) :x-title "x" :y-title "1/x")
 203
 204   (clear *frame1*)
 205
 206
 207   (let* ((n 500)
 208          (xs (num-sequence :from 0 :to 10 :length n))
 209          (ys (map 'vector #'(lambda (x) (+ x 8 (random 4.0))) xs))
 210          (weights (replicate #'(lambda () (1+ (random 10))) n 'fixnum))
 211          (da (plot-simple *frame1* (interval-of 0 10) (interval-of 10 20)
 212                           :x-title "x" :y-title "y")))
 213     (draw-symbols da xs ys :weights weights))
 214
 215   (xlib-image-context-to-png (context *frame1*) "/home/tony/test1.png")
 216   (xlib-image-context-to-png (context *frame2*) "/home/tony/test2.png")
 217   )
 218
 219
 220 ;;; EXAMPLE FOR DSC2009
 221   (defparameter *frame2* (as-frame (create-xlib-image-context 400 400)
 222                                   :background-color +white+))
 223
 224   (bind ((#2A((f1 f2) (f3 f4))
 225              (split-frame *frame2* (percent 50) (percent 50))))
 226         (defparameter *f1* f1)
 227         (defparameter *f2* f2)
 228         (defparameter *f3* f3)
 229         (defparameter *f4* f4))
 230   (plot-function *f1* #'sin (interval-of 0 2) :x-title "x" :y-title "sin(x)")
 231   (plot-function *f2* #'cos (interval-of 0 2) :x-title "x" :y-title "cos(x)")
 232   (plot-function *f3* #'tan (interval-of 0 2) :x-title "x" :y-title "tan(x)")
 233
 234  (num-sequence :from 0 :to 10 :length 30)
 235
 236   (let* ((n 500)
 237          (xs (num-sequence :from 0 :to 10 :length n))
 238          (ys (map 'vector #'(lambda (x) (+ x 8 (random 4.0))) xs))
 239          (weights (replicate #'(lambda () (1+ (random 10))) n 'fixnum))
 240          (da (plot-simple *f4* (interval-of 0 10) (interval-of 10 20)
 241                           :x-title "x" :y-title "y")))
 242     (draw-symbols da xs ys :weights weights))
 243   (xlib-image-context-to-png (context *f1*) "/home/tony/test1.png")
 244   (xlib-image-context-to-png (context *frame2*) "/home/tony/test2.png")
 245   (destroy (context  *frame2*))
 246
 247
 248
 249 ;; back to normal application
 250 (in-package :ls-user)
 251
 252
 253
 254 #|
 255   (with-data dataset ((dsvarname1 [usevarname1])
 256                       (dsvarname2 [usevarname2]))
 257       @body)
 258 |#
 259
 260
 261
 262
 263 (defun testme (&key (a 3) (b (+ a 3)))
 264   b)
 265
 266 (testme)
 267 (testme :a 2)
 268 (testme :b 4)
 269 (testme :a 2 :b (* a 5))