#!/usr/bin/gcl -f

; Sorting algorithms implemented in Common Lisp by Christian Svedin

; Liten Common Lisp ordlista
; (cond (cond1 expr1) (cond2 expr2))
;    konstruerar en if (cond1){expr1} else if (cond2) {expr2}
; (endp l)
;    kollar om 'l' är en tom lista
; (cons e list)
;    skapar en lista med 'e' som första element och 
;     'list' som resten av elementen
; (progn (func1 a) (func2 b))
;    funkar som { func1(a); func2(b); }
; (mapcar func list)
;   utför 'func' på alla element i 'list'


; Kollar om en lista är sorterad
(defun sorted(list)
  (cond
   ((null (rest list)) t)
   ((<= (first list) (second list))
    (sorted (rest list)))
   (t 'nil))
)

; Sorterar en lista rekursivt med insertion sort algorithmen
(defun insertionSort(list)
  (if (endp list)
      'nil
    (insert (first list) (insertionSort (rest list)))))

; Hjälpfunktion till insertion sort
(defun insert(e list)
  (cond
   ((endp list)
    (list e))
   ((< e (first list))
    (cons e list))
   (t (cons (first list) (insert e (rest list))))))

; Sorterar en array iterativt med insertionsort algorithmen
(defun insertionSortIter(array)
  (do ((i 1 (1+ i)))
       ((= i (array-total-size array))
	   (return array))
       (let ((tmp (aref array i)) (j i))
	  (loop
	   (if (and (> j 0) (< tmp (aref array (1- j))))
	       (progn 
		 (setf (aref array j) (aref array (1- j)))
		 (setf j (1- j)))
	     (return array)))
	  (setf (aref array j) tmp))))

; Sorterar en array iterativt med shellshort algorithmen
(defun shellSort(array) 
  (do ((gap (floor (/ (array-total-size array) 2))))
      ((<= gap 0)
       (return array))
    (do ((i gap (1+ i)))
	((>= i (array-total-size array))
	 (return array))
      (let ((tmp (aref array i)) (j i))
	(loop
	 (if (and (>= j gap) (< tmp (aref array (- j gap))))
	     (progn
	       (setf (aref array j) (aref array (- j gap)))
	       (setf j (- j gap)))
	   (return array)))
	(setf (aref array j) tmp)))
    (if (= gap 2)
	(setf gap 1)
      (setf gap (floor (/ gap 2.2))))))

; Sorterar en lista rekursivt med mergesort
(defun mergeSort(list)
  (if (endp list) '()
    (first (mergePairs (mapcar #'list list)))))

; Hjälpfunktion till mergeSort   
(defun mergePairs(list)
  (if (endp (rest list)) list
    (mergePairs (cons (mergeLists (first list) (second list)) 
	  (mergePairs (rest (rest list)))))))

; Hjälpfunktion till mergeSort
(defun mergeLists(list1 list2)
  (cond
   ((endp list1)
    list2)
   ((endp list2)
    list1)
   ((< (first list1) (first list2))
    (cons (first list1) (mergeLists (rest list1) list2)))
   (t
    (cons (first list2) (mergeLists list1 (rest list2))))))

; Sorterar en lista rekursivt med quicksort
;  eftersom man sorterar en länkad lista blev det enklaste att välja
;  att pivoten är det första elementet i listan
(defun quickSort(list)
  (cond
   ((endp list)
    list)
   (t
    (let ((pivot (first list)) (left '()) (right '()))
      (mapcar (lambda (x) (if (<= x pivot)
			    (setf left (append left (list x)))
			    (setf right (append right (list x)))))
	      (rest list))
      (append (quickSort left) (list pivot) (quickSort right))))))

; Sorterar en lista iterativt med quicksort (in place algorithm)
(defun quicksort_i(array)
  (qsort_i array 0 (1- (array-total-size array))))

; Den egentliga iterativa quicksort-funktionen
(defun qsort_i(array left right)
  (if (> right left)
      (let ((pivotIndex left))
	(let ((pivotNewIndex (partition array left  right
					     pivotIndex)))
	  (qsort_i array left (1- pivotNewIndex))
	  (qsort_i array (1+ pivotNewIndex) right)))
    'nil))

; Hjälpfunktion till quicksort_i
(defun partition(array left right pivotIndex)
  (let ((pivotValue (aref array pivotIndex))
	(storeIndex left))
    (setf (aref array pivotIndex) (aref array right))
    (setf (aref array right) pivotValue)
    (do ((i left (1+ i)))
	((>= i right) array)
      (if (<= (aref array i) pivotValue)
	  (progn
	    (swap array i storeIndex)
	    (setf storeIndex (1+ storeIndex)))
	'nil))
    (swap array storeIndex right)
    storeIndex))

; Hjälpfunktion till quicksort_i
;  byter plats på 2 värden i en array
(defun swap(array index1 index2)
  (let ((temp (aref array index1)))
    (setf (aref array index1) (aref array index2))
    (setf (aref array index2) temp)))
    
 
; Funktion som genererar en slumpad array med längden n
(defun random-array(n)
  (let ((array (make-array n :element-type 'integer)))
    (loop for i from 0 to (1- n) do 
	  (setf (aref array i) (random 10000)))
    array))
					  
; Antalet element i datan som ska sorteras 
(setq ssize 10000)
  
; Genererar listor som ska sorteras med ssize element
(defun generateData(n) 
  (setq randomlist (loop for x from 1 to n collect (random 10000)))
  (setq sortedlist (loop for x from 1 to n collect x))
  (setq inverselist (loop for x from 1 to n collect (- n x)))
;  (setq lowhighlist (loop for x from 1 to ssize collect (
)
  

(format t "Test av sorted-funktionen~%")
(setq list1 '(1 2 3 4 5 6 7 8 9 10 12 73))
(progn (prin1 list1) (format t " Sorted: ") (prin1 (sorted list1)))
(princ '#\Newline)

(setq list2 '(4 5 8 7 21 5 2 6 76 1))
(progn (prin1 list2) (format t " Sorted: ") (prin1 (sorted list2)))
(princ '#\Newline)

(setq list3 '(5 5))
(progn (prin1 list3) (format t " Sorted: ") (prin1 (sorted list3)))
(princ '#\Newline)

(princ '#\Newline)

(format t "Rekursiv insertion sort av en lista")
(print list1)
(print (insertionSort list1))
(princ '#\Newline)
(print list2)
(print (insertionSort list2))
(princ '#\Newline)
(print list3)
(print (insertionSort list3))

(princ '#\Newline)

(format t "Iterativ insertion sort av en array")
(setq arr (make-array 10 :initial-contents '(56 3 6 4 6 8 90 2 7 8)))
(print arr)
(insertionSortIter arr)
(print arr)
(princ '#\Newline)

(format t "Iterativ shellshort av en array")  
(setq arr2 (make-array 10 :initial-contents '(56 3 6 4 6 8 90 2 7 8)))
(print arr2)
(shellSort arr2)
(print arr2)

(princ '#\Newline)

(format t "rekursiv mergesort av lista")
(print list2)
(print (mergeSort list2))
(princ '#\Newline)

(format t "Rekursiv quicksort av lista")
(print list2)					      
(print (quickSort list2))
(princ '#\Newline)

(format t "Iterativ quicksort av array")
(setq arr3 (make-array 10 :initial-contents '(56 3 6 4 6 8 90 2 7 8)))
(print arr3)
(quicksort_i arr3)
(print arr3)
(princ '#\Newline)

(generateData 10000)
; internal-time-units-per-second == 100
(print (get-internal-real-time))
;(time (quicksort_i (random-array 1000)))
(time (mergesort randomlist))
(print (get-internal-real-time))
(princ '#\Newline)