(defun geta (key list &optional default) (or (cdr (assoc key list)) default)) (defmacro doitems ((one n list &optional out) &body body ) `(let ((,n -1)) (dolist (,one ,list ,out) (incf ,n) ,@body))) (defun list2array (l) (let* ((len (length l)) (a (make-array `(,len)))) (doitems (one n l a) (setf (aref a n) one)))) (defun shuffle (l) (dotimes (i (length l) l) (rotatef (elt l i) (elt l (random (length l)))))) (defun tally (l &key (key #'eql)) (let ((h (make-hash-table :test key))) (dolist (one l h) (incf (gethash one h 0))))) (defun remove-nths (doomeds l &optional (n 0)) (if (null doomeds) l (remove-nths1 doomeds (first l) (rest l) n))) (defun remove-nths1 (doomeds first rest n) (if (= n (first doomeds)) (remove-nths (rest doomeds) rest (1+ n)) (cons first (remove-nths doomeds rest (1+ n))))) ;(deftest test-remove-nths () ; (check ; (equal (remove-nths '(0 1 5) '(a b c d e f g)) '(c d e g)) ; (equal (remove-nths '(0 1 5 6) '(a b c d e f g)) '(c d e)) ; (equal (remove-nths '() '(a b c d e f g)) '(a b c d e f g)))) (defun rank (l &key (ranks (make-hash-table)) (n 0)) (if (null l) ranks (let (repeats sum now) (labels ((walk () (incf n) (pop l)) (new () (setf repeats 1) (setf sum n)) (same () (incf sum n) (incf repeats)) (spin () (when (eql now (car l)) (walk) (same) (spin)))) (setf now (walk)) (new) (spin) (setf (gethash now ranks) (/ sum repeats)) (rank l :ranks ranks :n n ))))) (defun allbut (l n) (if (zerop n) (values (rest l) (first l)) (cons (first l) (allbut (rest l) (1- n)))))