;;;-*-Lisp-*-

;;; Copyright 1995 Point and Click Solutions, Inc. All Rights Reserved.

;;; Instructions:
;;; *************
;;; 
;;; Compile and load this file and type (meter-sequences "lisp-product-name")

#+lucid (in-package :user)
#-lucid (in-package :common-lisp-user)

(eval-when (load compile)
  (unless (find-symbol "DEF-METER-TEST")
    (format t "~&meter-substrate wasn't loaded - loading it now")
    (load "meter-substrate")))

;;; Clear any existing tests

(setq *fns-to-test* nil)

;;; The calibration loop

(def-standard-test)

(defun meter-sequences (product-name &key (pathname "/usr2/davo/meter/")
			          (optimize-list +optimize-list+))
  (meter-product (format nil "~A-sequences" product-name)
                 :pathname pathname
                 :optimize-list optimize-list))

(defvar *52-element-list*
    (loop for i from 1 to 52 collect i))

(defun new-seq-list ()
  (copy-list *52-element-list*))

(defun new-seq-vector ()
  (let ((a (make-array (list 52) :element-type t)))
    (loop for i from 0 below 52
	do (setf (aref a i) (1+ i)))
    a))

(defun new-seq-string ()
  (copy-seq "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; List Sequences
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; NOT destructive
(def-meter-test seq-list-concatenate "(concatenate a b)"
  :vars ((a (new-seq-list))
	 (b (new-seq-list)))
  :form (concatenate 'list a b)
  :n-iterations 100)

(def-meter-test seq-list-copy-seq "(copy-seq seq)"
  :vars ((a (new-seq-list)))
  :form (copy-seq a)
  :n-iterations 100)

(def-meter-test seq-list-count "(count 50 seq)"
  :vars ((a (new-seq-list)))
  :form (count 50 a)
  :result 1
  :n-iterations 100)

;;; Destructive - only first delete will work
(def-meter-test seq-list-delete "(delete 51 a)"
   :vars ((a (new-seq-list)))
   :form (setq a (delete 51 a))
   :n-iterations 100)

(def-meter-test seq-list-delete-duplicates "(delete-duplicates a)"
   :vars ((a (new-seq-list)))
   :form (setq a (delete-duplicates a))
   :n-iterations 20)

(def-meter-test seq-list-elt "(elt a 50)"
  :vars ((a (new-seq-list)))
   :form (elt a 50)
   :result 51
   :n-iterations 1000)

(def-meter-test seq-list-fill "(fill a 7)"
  :vars ((a (new-seq-list)))
  :form (fill a 7)
  :n-iterations 1000)

(def-meter-test seq-list-find "(find n a)"
  :vars ((a (new-seq-list)))
  :form (find 49 a)
  :result 49
  :n-iterations 1000)

(def-meter-test seq-list-length "(length list)"
  :vars ((a (new-seq-list)))
  :form (length a)
  :result 52
  :n-iterations 1000)

;;; Destructive - but we are undoing
(def-meter-test seq-list-map "(map 'list #'- a)"
  :vars ((a (new-seq-list)))
  :form (progn
	  (setq a (map 'list #'- a))
	  (setq a (map 'list #'- a)))
  :n-iterations 50)

;;; Destructive
(def-meter-test seq-list-merge "(merge a b)"
  :vars ((a (new-seq-list))
	 (b (new-seq-list)))
  :form (merge 'list a b #'<)
  :n-iterations 1)

(def-meter-test seq-list-position "(position n a)"
  :vars ((a (new-seq-list)))
  :form (position 51 a)
  :result 50
  :n-iterations 1000)

;;; Possibly destrcutive
(def-meter-test seq-list-nreverse "(setq a (nreverse a))"
  :vars ((a (new-seq-list)))
  :form (progn
	  (setq a (nreverse a))
	  (setq a (nreverse a)))
  :n-iterations 100)

(def-meter-test seq-list-nsubstitute "(nsubstitute new old a)"
   :vars ((a (new-seq-list)))
   :form (progn
           (setq a (nsubstitute 50 51 a))
           (setq a (nsubstitute 51 50 a)))
   :n-iterations 100)

(def-meter-test seq-list-reduce "(reduce '+ '(1 2 3 4))"
   :vars ((a (new-seq-list)))
   :form (reduce '+ a)
   :n-iterations 100)

(def-meter-test seq-list-replace "(replace old new)"
  :vars ((a (new-seq-list)))
  :form (progn
	  (setq a (replace a '(2 1 2)))
	  (setq a (replace a '(1 2 3))))
  :n-iterations 100)

(def-meter-test seq-list-remove "(remove 51 a)"
   :vars ((a (new-seq-list)))
   :form (setq a (remove 51 a))
   :n-iterations 100)

(def-meter-test seq-list-remove-duplicates "(remove-duplicates a)"
  :vars ((a (new-seq-list)))
  :form (progn 
	  (setq a (remove-duplicates a))
	  (setq a (remove-duplicates a)))
  :n-iterations 20)

(def-meter-test seq-list-reverse "(reverse seq)"
  :vars ((a (new-seq-list)))
  :form (progn
	  (setq a (reverse a))
	  (setq a (reverse a)))
  :n-iterations 100)

(def-meter-test seq-list-search "(search a b)"
  :vars ((a (new-seq-list))
	 (b (new-seq-list)))
  :form (search a b)
  :n-iterations 10)

(def-meter-test seq-list-some "(some #'oddp a)"
  :vars ((a (new-seq-list)))
  :form (progn
	  (some #'oddp a)
	  (some #'evenp a))
  :n-iterations 100)

(def-meter-test seq-list-sort "(sort a)"
   :vars ((a (new-seq-list)))
   :form (progn
           (setq a (sort a #'>))
           (setq a (sort a #'<)))
   :n-iterations 20)

(def-meter-test seq-list-subseq "(subseq seq 48 50)"
  :vars ((a (new-seq-list)))
  :form (progn
	  (subseq a 48 50)
	  (subseq a 42 45))
  :n-iterations 100)

(def-meter-test seq-list-substitute "(substitute new old a)"
   :vars ((a (new-seq-list)))
   :form (progn
           (setq a (substitute 50 51 a))
           (setq a (substitute 51 50 a)))
   :n-iterations 100)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Vector Sequences
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(def-meter-test seq-vector-delete "(delete 51 a)"
   :vars ((a (new-seq-vector)))
   :form (setq a (delete 51 a))
   :n-iterations 100)

(def-meter-test seq-vector-delete-duplicates "(delete-duplicates a)"
   :vars ((a (new-seq-vector)))
   :form (setq a (delete-duplicates a))
   :n-iterations 20)

(def-meter-test seq-vector-elt "(elt a 50)"
  :vars ((a (new-seq-vector)))
   :form (elt a 50)
   :result 51
   :n-iterations 1000)

(def-meter-test seq-vector-fill "(fill a 7)"
  :vars ((a (new-seq-vector)))
  :form (fill a 7)
  :n-iterations 1000)

(def-meter-test seq-vector-find "(find n a)"
  :vars ((a (new-seq-vector)))
  :form (find 49 a)
  :result 49
  :n-iterations 1000)

(def-meter-test seq-vector-length "(length a)"
  :vars ((a (new-seq-vector)))
  :form (length a)
  :result 52
  :n-iterations 1000)

;;; Destructive - but we are undoing
(def-meter-test seq-vector-map "(map '(vector t 52) #'- a)"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (setq a (map '(vector t 52) #'- a))
	  (setq a (map '(vector t 52) #'- a)))
  :n-iterations 50)

;;; Destructive
(def-meter-test seq-vector-merge "(merge '(vector t 52) a b)"
  :vars ((a (new-seq-vector))
	 (b (new-seq-vector)))
  :form (merge '(vector t 104) a b #'<)
  :n-iterations 1)

(def-meter-test seq-vector-position "(position n a)"
  :vars ((a (new-seq-vector)))
  :form (position 51 a)
  :result 50
  :n-iterations 1000)

;;; Possibly destrcutive
(def-meter-test seq-vector-nreverse "(setq a (nreverse a))"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (setq a (nreverse a))
	  (setq a (nreverse a)))
  :n-iterations 100)

(def-meter-test seq-vector-nsubstitute "(nsubstitute new old a)"
   :vars ((a (new-seq-vector)))
   :form (progn
           (setq a (nsubstitute 50 51 a))
           (setq a (nsubstitute 51 50 a)))
   :n-iterations 100)

(def-meter-test seq-vector-reduce "(reduce '+ '(1 2 3 4))"
   :vars ((a (new-seq-vector)))
   :form (reduce '+ a)
   :n-iterations 100)

(def-meter-test seq-vector-replace "(replace old new)"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (setq a (replace a '(2 1 2)))
	  (setq a (replace a '(1 2 3))))
  :n-iterations 100)

(def-meter-test seq-vector-remove "(remove 51 a)"
   :vars ((a (new-seq-vector)))
   :form (setq a (remove 51 a))
   :n-iterations 100)

(def-meter-test seq-vector-remove-duplicates "(remove-duplicates a)"
  :vars ((a (new-seq-vector)))
  :form (progn 
	  (setq a (remove-duplicates a))
	  (setq a (remove-duplicates a)))
  :n-iterations 20)

(def-meter-test seq-vector-reverse "(reverse seq)"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (setq a (reverse a))
	  (setq a (reverse a)))
  :n-iterations 100)

(def-meter-test seq-vector-search "(search a b)"
  :vars ((a (new-seq-vector))
	 (b (new-seq-vector)))
  :form (search a b)
  :n-iterations 10)

(def-meter-test seq-vector-some "(some #'oddp a)"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (some #'oddp a)
	  (some #'evenp a))
  :n-iterations 100)

(def-meter-test seq-vector-sort "(sort a)"
   :vars ((a (new-seq-vector)))
   :form (progn
           (setq a (sort a #'>))
           (setq a (sort a #'<)))
   :n-iterations 20)

(def-meter-test seq-vector-subseq "(subseq seq 48 50)"
  :vars ((a (new-seq-vector)))
  :form (progn
	  (subseq a 48 50)
	  (subseq a 42 45))
  :n-iterations 100)

(def-meter-test seq-vector-substitute "(substitute new old a)"
   :vars ((a (new-seq-vector)))
   :form (progn
           (setq a (substitute 50 51 a))
           (setq a (substitute 51 50 a)))
   :n-iterations 100)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; String Sequences
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(def-meter-test seq-string-delete "(delete 51 a)"
   :vars ((a (new-seq-string)))
   :form (setq a (delete #\x a))
   :n-iterations 100)

(def-meter-test seq-string-delete-duplicates "(delete-duplicates a)"
   :vars ((a (new-seq-string)))
   :form (setq a (delete-duplicates a))
   :n-iterations 20)

(def-meter-test seq-string-elt "(elt a 50)"
  :vars ((a (new-seq-string)))
   :form (elt a 50)
   :result #\Y
   :n-iterations 1000)

(def-meter-test seq-string-fill "(fill a 7)"
  :vars ((a (new-seq-string)))
  :form (fill a #\a)
  :n-iterations 1000)

(def-meter-test seq-string-find "(find n a)"
  :vars ((a (new-seq-string)))
  :form (find #\z a)
  :n-iterations 1000)

(def-meter-test seq-string-length "(length a)"
  :vars ((a (new-seq-string)))
  :form (length a)
  :result 52
  :n-iterations 1000)

;;; Destructive - but we are undoing
(def-meter-test seq-string-map "(map '(string t 52) #'- a)"
  :vars ((a (new-seq-string)))
  :form (progn
	  (setq a (map 'string #'char-upcase a))
	  (setq a (map 'string #'char-downcase a)))
  :n-iterations 50)

;;; Destructive
(def-meter-test seq-string-merge "(merge '(string t 52) a b)"
  :vars ((a (new-seq-string))
	 (b (new-seq-string)))
  :form (merge 'string a b #'char<)
  :n-iterations 1)

(def-meter-test seq-string-position "(position n a)"
  :vars ((a (new-seq-string)))
  :form (position 51 a)
  :n-iterations 1000)

;;; Possibly destrcutive
(def-meter-test seq-string-nreverse "(setq a (nreverse a))"
  :vars ((a (new-seq-string)))
  :form (progn
	  (setq a (nreverse a))
	  (setq a (nreverse a)))
  :n-iterations 100)

(def-meter-test seq-string-nsubstitute "(nsubstitute new old a)"
   :vars ((a (new-seq-string)))
   :form (progn
           (setq a (nsubstitute 50 51 a))
           (setq a (nsubstitute 51 50 a)))
   :n-iterations 100)

(def-meter-test seq-string-replace "(replace old new)"
  :vars ((a (new-seq-string)))
  :form (progn
	  (setq a (replace a "XXX"))
	  (setq a (replace a "abc")))
  :n-iterations 100)

(def-meter-test seq-string-remove "(remove 51 a)"
   :vars ((a (new-seq-string)))
   :form (setq a (remove #\z a))
   :n-iterations 100)

(def-meter-test seq-string-remove-duplicates "(remove-duplicates a)"
  :vars ((a (new-seq-string)))
  :form (progn 
	  (setq a (remove-duplicates a))
	  (setq a (remove-duplicates a)))
  :n-iterations 20)

(def-meter-test seq-string-reverse "(reverse seq)"
  :vars ((a (new-seq-string)))
  :form (progn
	  (setq a (reverse a))
	  (setq a (reverse a)))
  :n-iterations 100)

(def-meter-test seq-string-search "(search a b)"
  :vars ((a (new-seq-string))
	 (b (new-seq-string)))
  :form (search a b)
  :n-iterations 10)

(def-meter-test seq-string-some "(some #'oddp a)"
  :vars ((a (new-seq-string)))
  :form (progn
	  (some #'alpha-char-p a)
	  (some #'alpha-char-p a))
  :n-iterations 100)

(def-meter-test seq-string-sort "(sort a)"
   :vars ((a (new-seq-string)))
   :form (progn
           (setq a (sort a #'char>))
           (setq a (sort a #'char<)))
   :n-iterations 20)

(def-meter-test seq-string-subseq "(subseq seq 48 50)"
  :vars ((a (new-seq-string)))
  :form (progn
	  (subseq a 48 50)
	  (subseq a 42 45))
  :n-iterations 100)

(def-meter-test seq-string-substitute "(substitute new old a)"
   :vars ((a (new-seq-string)))
   :form (progn
           (setq a (substitute 50 51 a))
           (setq a (substitute 51 50 a)))
   :n-iterations 100)