rendered paste body#!/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)