OPEN 28/6 [22323123131322] save BACKUP The Dover Plan


PUBLIC DOMAIN CONTENT


0by 0x tinyZED imageTEXT

- conservation of creation -

zett

mergesort

;; ============================================================
;; Basic wrappers for primitive operations
;; ============================================================

;; Append two lists
(define (append* list1 list2)
  ;; Equivalent to built-in append
  (append list1 list2))

;; Cons an item onto a list
(define (cons* item list)
  ;; Equivalent to built-in cons
  (cons item list))

;; Map a function over a list
(define (map* function list)
  ;; Equivalent to built-in map
  (map function list))

;; Null? predicate
(define (null?* value)
  (null? value))

;; Reverse a list
(define (reverse* list)
  (reverse list))


;; ============================================================
;; Merge procedure
;; ============================================================

;; Public entry point: merge two sorted lists with a comparator
(define (merge comparator list1 list2)
  ;; Start with an empty collector
  (merge01 comparator list1 list2 '()))

;; Internal merge with accumulator (collect)
(define (merge01 comparator list1 list2 collect)
  (cond
    ;; Case 1: list2 exhausted → append reversed collect with list1
    ((null?* list2)
     (append* (reverse* collect) list1))

    ;; Case 2: list1 exhausted → append reversed collect with list2
    ((null?* list1)
     (append* (reverse* collect) list2))

    ;; Case 3: comparator prefers element from list2
    ((comparator (car list2) (car list1))
     (merge01 comparator
              list1
              (cdr list2)
              (cons* (car list2) collect)))

    ;; Case 4: otherwise take from list1 (stability priority)
    (else
     (merge01 comparator
              (cdr list1)
              list2
              (cons* (car list1) collect)))))


;; ============================================================
;; Sort procedure (merge sort)
;; ============================================================

;; Public entry point: prepare jumble and perform merge passes
(define (sort* comparator jumble)
  (sort03 comparator
          (sort02 comparator
                  (sort01 jumble))))

;; Step 1: prepare jumble by wrapping each element in a list
(define (sort01 jumble)
  (map* list jumble))

;; Step 2: perform a single merge pass
(define (sort02 comparator jumble)
  (cond
    ;; Empty jumble → return nil
    ((null?* jumble) '())

    ;; One list in jumble → return it
    ((null?* (cdr jumble)) jumble)

    ;; Otherwise merge first two lists, recurse on rest
    (else
     (cons* (merge comparator (car jumble) (cadr jumble))
            (sort02 comparator (cddr jumble))))))

;; Step 3: repeat merge passes until fully sorted
(define (sort03 comparator jumble)
  (cond
    ;; Empty jumble
    ((null?* jumble) '())

    ;; One list left → return it
    ((null?* (cdr jumble)) (car jumble))

    ;; Otherwise perform another merge pass
    (else
     (sort03 comparator (sort02 comparator jumble)))))


;; ============================================================
;; Main entry point
;; ============================================================

(define (main)
  ;; Example: sort numbers with ">" comparator
  (display (sort* > (list 4 3 5 6 8 7 1 2 9)))
  (newline))

;; Run main
(main)