# cl-permutation / utilities.lisp

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136``` ```;;;; utilities.lisp ;;;; Copyright (c) 2011-2012 Robert Smith ;;;; Utilities. (in-package #:cl-permutation) (defun iota (n) "Generate a list of numbers between 0 and N-1." (loop :for i :below n :collect i)) (defun iota-vector (n) "Generate the equivalent of (COERCE (IOTA N) 'VECTOR)." (loop :with a := (make-array n :initial-element 0) :for i :below n :do (setf (aref a i) i) :finally (return a))) (defun iota+1 (n) "Generate a list of numbers between 1 and N." (loop :for i :from 1 :to n :collect i)) (defun random-between (a b) "Generate a random integer between A and B, inclusive." (assert (>= b a)) (if (= a b) a (+ a (random (- (1+ b) a))))) (defun nshuffle (vector &optional (parity :any)) "Shuffle the permutation vector VECTOR with specified parity PARITY. PARITY may be * :ANY for any permutation * :EVEN for only even permutations * :ODD for only odd permutations" (assert (member parity '(:any :even :odd))) (let ((n (length vector)) (any? (eql parity :any))) (loop :for i :below (if any? n (1- n)) :for r := (random-between i (1- n)) :when (/= i r) :do (progn (rotatef (svref vector i) (svref vector r)) (unless any? (rotatef (svref vector (- n 1)) (svref vector (- n 2))))) :finally (progn (when (eql parity :odd) (rotatef (svref vector 0) (svref vector 1))) (return vector))))) (defun maximum (list &key (key 'identity)) "Compute the maximum of LIST, optionally via the function KEY." (loop :for x :in list :maximizing (funcall key x))) (defun product (seq &key (key 'identity)) "Compute the product of the items in SEQ, optionally via the function KEY." (reduce '* seq :key key :initial-value 1)) (defun sign (x) "Return the sign of X." (cond ((plusp x) 1) ((zerop x) 0) (t -1))) (defun hash-table-key-exists-p (hash-table key) "Check of KEY exists in HASH-TABLE." (multiple-value-bind (val existsp) (gethash key hash-table) (declare (ignore val)) existsp)) (defun hash-table-keys (hash-table) "Return a list of the hash table keys of HASH-TABLE." (loop :for k :being :the :hash-keys :of hash-table :collect k)) (defun hash-table-values (hash-table) "Return a list of the hash table values of HASH-TABLE." (loop :for v :being :the :hash-values :of hash-table :collect v)) (defun print-hash-table (hash-table) (loop :for k :being :the :hash-keys :of hash-table :for v := (gethash k hash-table) :do (format t "~S ==> ~S~%" k v)) (terpri)) (defun index-to-hash-table-key (hash-table n) "Get the Nth key from HASH-TABLE. Ordering is not specified. This function just guarantees we can map N to some hash table key." (maphash (lambda (k v) (declare (ignore v)) (when (zerop n) (return-from index-to-hash-table-key k)) (decf n)) hash-table)) (defun random-hash-table-key (hash-table) "Obtain a random hash table key." (index-to-hash-table-key hash-table (random (hash-table-count hash-table)))) (defun random-hash-table-value (hash-table) "Obtain a random hash table value." (gethash (random-hash-table-key hash-table) hash-table)) (define-condition hash-table-access-error (cell-error) ((table :initarg :table :reader hash-table-access-error-table) (key :initarg :key :reader hash-table-access-error-key)) (:documentation "An error to be signalled if a key doesn't exist in a hash-table.")) (defun safe-gethash (key hash-table) "Throw an error in the event that KEY foes not exist in HASH-TABLE. Othwerwise return the value." (multiple-value-bind (val existsp) (gethash key hash-table) (if existsp val (error 'hash-table-access-error :name 'gethash :table hash-table :key key)))) (defun singletonp (x) "Does X contain one element?" (typecase x (sequence (= 1 (length x))) (t nil))) ```