benchmark-sql.lisp

(in-package :webapp)

(clsql-sys:enable-sql-reader-syntax)
(setf clsql-sys:*db-auto-sync* t)

(clsql:def-view-class sql-data ()
  ((guid :db-kind :key
	 :db-constraints :not-null
	 :type integer
	 :initform (get-next-guid) ;;only for portability
	 :accessor get-guid)
   (score :db-constraints :not-null
	  :type integer
	  :initform 0
	  :initarg :score
	  :accessor get-score)
   (category :db-constraints :not-null
	     :type (string 10)
	     :initform "default"
	     :initarg :category)
   (time :db-constraints :not-null
	 :type clsql:universal-time
	 :initarg :time
	 :initform (get-universal-time))))

;;a counter table is unnecesary for mysql,
;;but I'm doing it anyways for the sake of
;;portability (to the best of my knowledge,
;;clsql doesn't support the serial type
;;in postgres).
(clsql:def-view-class counter ()
  ((name :db-kind :key
	 :db-constraints :not-null
	 :type (string 10)
	 :initarg :name
	 :accessor get-name)
   (count :accessor get-count
	  :db-constraints :not-null
	  :type integer
	  :initform 0)))

(defun init-sql-bench ()
  (clsql:connect '("localhost" "bench" "lispbench" "pass") :if-exists :warn-old :database-type :mysql)
  (clsql:locally-enable-sql-reader-syntax)

  (ignore-errors
    (clsql:drop-table 'counter)
    (clsql:drop-table 'sql-data))
  
  (clsql:create-view-from-class 'counter)
  (make-instance 'counter :name "guid")

  (clsql:create-view-from-class 'sql-data)
  (clsql:create-index [scoreindex] :on [sql-data] :attributes '([score]))
  (clsql:create-index [categoryindex] :on [sql-data] :attributes '([category]))
  (clsql:create-index [timeindex] :on [sql-data] :attributes '([time])))

(defun get-next-guid ()
  (incf (get-count (caar (clsql:select 'counter
				       :where [= [slot-value 'counter 'name] "guid"])))))

(defun test-1-sql ()
  (dotimes (i 100000)
    (make-instance 'sql-data :category (nth (random 3) (list "A" "B" "C")) 
		   :time (+ (get-universal-time) (random 10000000)))))

(defun test-2-sql ()
  ;;note - not enough memory to load all 100K
  ;;So, I just query their GUIDs and then iterate
  (loop for guid in (mapcon #'car (clsql:select [guid] :from [sql-data]))
     do (let ((inst (caar (clsql:select 'sql-data :where [= [guid] guid]))))
	  (clsql:with-transaction ()
	    (dotimes (i 20)
	      (if (plusp (random 2))
		  (incf (get-score inst))
		  (decf (get-score inst))))))))

(defun test-3-sql ()
  (mapcar #'(lambda (count)
	      (mapcon #'car (clsql:select [guid] :from [sql-data] 
					         :order-by '(([score] :desc)) 
						 :limit count)))
	  (list 10 100 1000)))

(defun test-4-sql ()
  (mapcar #'(lambda (count)
	      (mapcon #'car  (clsql:select [guid] :from [sql-data] 
					          :where [= [category] "A"] 
					          :order-by '(([score] :desc)) 
					          :limit count)))
	  (list 10 100 1000)))

(defun test-5-sql ()
  (loop for guid in (mapcon #'car (clsql:select [guid] :from [sql-data]))
     do (clsql:delete-instance-records 
	 (caar (clsql:select 'sql-data :where [= [guid] guid])))))