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 (defconstant single-pi
   9   #.(coerce pi 'single-float))
  10
  11 (defun make-adorned-symbol (name &key prefix suffix asterisk package)
  12   (check-type name (or string symbol))
  13   (check-type prefix (or symbol string null))
  14   (check-type suffix (or symbol string null))
  15   (intern (concatenate 'string
  16                        (when prefix
  17                          (string prefix))
  18                        (when prefix  "-")
  19                        (string name)
  20                        (when suffix
  21                          "-")
  22                        (when suffix
  23                          (string suffix))
  24                        (when asterisk
  25                          (string "*")))
  26           (if package package *package*)))
  27
  28 (defmacro multiply-arguments (operator factor arguments)
  29   `(,operator ,@(mapcar (lambda (argument) `(* ,factor ,argument)) arguments)))
  30
  31 (defun matrix-symbol (i j &optional (prefix '#:e))
  32   (find-symbol (format NIL "~A~D~D" prefix i j)))
  33
  34 (defun matrix-minor (x y length &optional (prefix '#:e))
  35   (let ((symbol-prefix (format NIL "~A~D~:*~D" '#:matrix (1- length))))
  36     `(,(find-symbol (concatenate 'string symbol-prefix #.(string '#:-determinant*)))
  37       (,(find-symbol (concatenate 'string symbol-prefix #.(string '#:-values*)))
  38        ,@(iterate values
  39            (for i from 1 to length)
  40            (iterate
  41              (for j from 1 to length)
  42              (unless (or (eql i x) (eql j y))
  43                (in values (collect (matrix-symbol (1- i) (1- j) prefix))))))))))
  44
  45 (defun matrix-cofactors (length)
  46   (iterate values
  47     (for i from 1 to length)
  48     (iterate
  49       (for j from 1 to length)
  50       (for value = (matrix-minor i j length))
  51       (in values
  52           (collect (if (oddp (+ i j))
  53                        `(- ,value)
  54                        value))))))