Update of /project/cells/cvsroot/cells/utils-kt In directory clnet:/tmp/cvs-serv9859/utils-kt
Modified Files: detritus.lisp flow-control.lisp utils-kt.lpr Log Message:
--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2006/10/11 22:16:22 1.11 +++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2006/12/12 15:58:43 1.12 @@ -20,12 +20,15 @@ (in-package :utils-kt)
(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(eval-now! export!))) + (export '(eval-now! export! assocd rassoca)))
(defmacro wdbg (&body body) `(let ((*dbg* t)) ,@body))
+(defun assocd (x y) (cdr (assoc x y))) +(defun rassoca (x y) (car (assoc x y))) + ;;;(defmethod class-slot-named ((classname symbol) slotname) ;;; (class-slot-named (find-class classname) slotname)) ;;; --- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2006/11/04 20:52:02 1.8 +++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2006/12/12 15:58:43 1.9 @@ -149,3 +149,33 @@ (defmethod instance-slots (self) (class-slots (class-of self))) ;; acl has this for structs
+;;; ---- without-repeating ---------------------------------------------- + +;; Returns a function that generates an elements from ALL each time it +;; is called. When a certain element is generated it will take at +;; least DECENT-INTERVAL calls before it is generated again. +;; +;; note: order of ALL is important for first few calls, could be fixed + +(defun without-repeating-generator (decent-interval all) + (let ((len (length all)) + (head (let ((v (copy-list all))) + (nconc v v)))) + (lambda () + (if (< len 2) + (car all) + (prog2 + (rotatef (car head) + (car (nthcdr (random (- len decent-interval)) + head))) + (car head) + (setf head (cdr head))))))) + +(export! without-repeating) + +(let ((generators (make-hash-table :test 'equalp))) + (defun without-repeating (key all &optional (decent-interval (floor (length all) 2))) + (funcall (or (gethash key generators) + (setf (gethash key generators) + (without-repeating-generator decent-interval all)))))) + --- /project/cells/cvsroot/cells/utils-kt/utils-kt.lpr 2006/11/13 05:28:09 1.20 +++ /project/cells/cvsroot/cells/utils-kt/utils-kt.lpr 2006/12/12 15:58:43 1.21 @@ -15,7 +15,8 @@ (make-instance 'module :name "flow-control.lisp") (make-instance 'module :name "detritus.lisp") (make-instance 'module :name "strings.lisp") - (make-instance 'module :name "datetime.lisp")) + (make-instance 'module :name "datetime.lisp") + (make-instance 'module :name "split-sequence.lisp")) :projects nil :libraries nil :distributed-files nil