utils.lisp

   1 (in-package :cl-tuples)
   2
   3 ;; float that fits within range of x86 hardware register minus tag (rather sbcl oriented)
   4 (deftype fast-float ()
   5   #+sbcl `(single-float   (#.(- (expt 2f0 64))) (#.(expt 2f0 64)))
   6   #-sbcl single-float)
   7
   8 (defun make-adorned-symbol (name &key prefix suffix asterisk package)
   9   (check-type name (or string symbol))
  10   (check-type prefix (or symbol string null))
  11   (check-type suffix (or symbol string null))
  12   (intern (concatenate 'string
  13                        (when prefix
  14                          (string prefix))
  15                        (when prefix  "-")
  16                        (string name)
  17                        (when suffix
  18                          "-")
  19                        (when suffix
  20                          (string suffix))
  21                        (when asterisk
  22                          (string "*")))
  23           (if package package *package*)))
  24
  25 (defmacro multiply-arguments (operator factor arguments)
  26   `(,operator ,@(mapcar (lambda (argument) `(* ,factor ,argument)) arguments)))
  27
  28 (defun matrix-symbol (i j &optional (prefix '#:e))
  29   (find-symbol (format NIL "~A~D~D" prefix i j)))
  30
  31 (defun matrix-minor (x y length &optional (prefix '#:e))
  32   (let ((symbol-prefix (format NIL "~A~D~:*~D" '#:matrix (1- length))))
  33     `(,(find-symbol (concatenate 'string symbol-prefix #.(string '#:-determinant*)))
  34       (,(find-symbol (concatenate 'string symbol-prefix #.(string '#:-values*)))
  35        ,@(iterate values
  36            (for i from 1 to length)
  37            (iterate
  38              (for j from 1 to length)
  39              (unless (or (eql i x) (eql j y))
  40                (in values (collect (matrix-symbol (1- i) (1- j) prefix))))))))))
  41
  42 (defun matrix-cofactors (length)
  43   (iterate values
  44     (for i from 1 to length)
  45     (iterate
  46       (for j from 1 to length)
  47       (for value = (matrix-minor i j length))
  48       (in values
  49           (collect (if (oddp (+ i j))
  50                        `(- ,value)
  51                        value))))))