;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;                               SORTING
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *comparisons* 0)
(define *swaps* 0)
;;;
;;; *global-variables* ... this is a convention
;;;

(define (lt x y)
  (set! *comparisons* (+ 1 *comparisons*))
  (< x y))
;;;
;;; Just so that I can easily count number of comparisons
;;;

(define (init)
  (set! *comparisons* 0)
  (set! *swaps* 0))
;;;
;;; Initialise global counters
;;;

(define (stats)
  (list *comparisons* *swaps*))
;;;
;;; Show the global variables as a pair
;;;
  
(define (file->list fname)
  (let ((fin (open-input-file fname))
	(l '()))
    (do ((e (read fin) (read fin)))
	((eof-object? e) l)
      (set! l (cons e l)))))
;;;
;;; Read in a list of numbers into a list.
;;; Stop reading when end of file object encountered
;;;
;;; For example
;;; (define l100 (file->list "/home/s7/pat/scheme/numbers/100"))
;;; (define l500 (file->list "/home/s7/pat/scheme/numbers/500"))
;;; (define l1000 (file->list "/home/s7/pat/scheme/numbers/1000"))
;;;

(define (insert e l p)
  (cond ((null? l) (list e))
	((p e (car l)) (cons e l))
	(t (cons (car l) (insert e (cdr l) p)))))
;;;
;;; Insert e into list l with respect to predicate p
;;;

(define (insertion-sort l p)
  (let ((sorted '()))
    (do ((l' l (cdr l')))
	((null? l') sorted)
      (set! sorted (insert (car l') sorted p)))))
;;;
;;; insertion sort
;;;

(define (swap v i j)
  (set! *swaps* (+ 1 *swaps*))
  (let ((temp (vector-ref v i)))
    (vector-set! v i (vector-ref v j))
    (vector-set! v j temp)))
;;;
;;; Given vector v, swap the ith element with the jth element
;;; NOTE: and keep a count of number of swaps performed
;;;

(define (bubble-sort l p)
  (let ((v (list->vector l))
	(n (length l)))
    (do ((i (- n 1) (- i 1)))
	((= i 0) (vector->list v))
      (do ((j 0 (+ j 1)))
	  ((= j i))
	(cond ((p (vector-ref v (+ j 1)) (vector-ref v j))
	       (swap v j (+ j 1))))))))
;;;
;;; Bubble sort
;;;

(define (bubble-sort-2 l p)
  (let ((v (list->vector l))
	(n (length l))
	(swaps t))
    (do ((i (- n 1) (- i 1)))
	((or (not swaps) (= i 0)) (vector->list v))
      (set! swaps nil)
      (do ((j 0 (+ j 1)))
	  ((= j i))
	(cond ((p (vector-ref v (+ j 1)) (vector-ref v j))
	       (set! swaps t)
	       (swap v j (+ j 1))))))))
;;;
;;; Bubble sort improved. 
;;; If, in the inner loop, there are no swaps, then the remaining
;;; set of values must be in order with respect to the predicate p.
;;; Consequently we should be able to terminate the outer loop
;;; (ie. the i loop) if  we have exhausted i, or there were no swaps
;;; in the last iteration (and we start of with the assumption that
;;; there were swaps in the iteration before bubble-sort-2 was called)
;;;
	 

(define (merge l1 l2 p)
  (cond ((null? l1) l2)
	((null? l2) l1)
	((p (car l1) (car l2)) (cons (car l1) (merge (cdr l1) l2 p)))
	(t (cons (car l2) (merge l1 (cdr l2) p)))))
;;;
;;; Merge two lists, with respect to predicate p
;;; Lists l1 and l2 are assumed to be already sorted with respect to p
;;;

(define (firstn n l)
  (cond ((= 0 n) '())
	(t (cons (car l) (firstn (- n 1) (cdr l))))))
;;;
;;; Get first n elements of a list
;;;

(define (skip n l)
  (cond ((= 0 n) l)
	(t (skip (- n 1) (cdr l)))))
;;;
;;; Skip over the first n elements of the list, returning remaining list
;;; less the first n elements
;;;

(define (merge-sort l p)
  (cond ((null? l) '())
	((= 1 (length l)) l)
	(t (let* ((n (quotient (length l) 2))
		  (l1 (firstn n l))
		  (l2 (skip n l)))
	     (merge (merge-sort l1 p) (merge-sort l2 p) p)))))
;;;
;;; merge sort
;;;

(define (apply-p p l)
  (cond ((null? l) '())
	(t (let ((e (car l)))
	     (do ((l' (cdr l) (cdr l')))
		 ((null? l') e)
	       (cond ((p e (car l')) (set! e (car l')))))))))
;;;
;;; Delivers a value e such that for each element x of (remove e l)
;;; (p e x) holds. Consequently (apply-p < l) delivers largest x in l
;;; (and is therefore equivalent to (apply max l)) and (apply-p > l) 
;;; delivers smallest x in l (equivalent to (apply min l))
;;;

(define (selection-sort l p)
  (cond ((null? l) l)
	(t (let ((e (apply-p p l)))
	     (append (selection-sort (remove e l) p) (list e))))))

;;;
;;; Selection sort, 
;;;
;;; 0. if l is null deliver the empty list '() otherwise
;;; 1. find the largest/smallest element e in the list l
;;; 2. push e onto the sorted list (initially empty)
;;; 3. do an insertion sort on (remove e l)
;;;

(define (make-random-list n)
  (let ((l '()))
    (do ((i n (- i 1))) ((= i 0) (randomise l))
      (set! l (cons i l)))))