; sort.neb
; an exploration of sorting algorithms in neb

;(use "libs/sugar.neb")

(func bubble (lst)
    (def orig lst)
    (def working (list))
    (def swp #false)
    (for-count (length lst)
        (branch
            ((eq? 0 (length (rest orig)))
                (redef working (append working (first orig))))
            ((> (first orig) (first (rest orig)))
                (block
                    (redef swp #true)
                    (redef working (append working (first (rest orig))))
                    (redef orig (prepend (rest (rest orig)) (first orig)))))
            (#true
                (block
                    (redef working (append working (first orig)))
                    (redef orig (rest orig))))))

    (print (->string working))
    (if swp
        (bubble working)
        working))

(func insertion-reduce (lst)
    (reduce insert lst (list)))

(func extend-reduce (lst1 lst2)
    (reduce append lst2 lst1))

(func extend (lst1 lst2)
    (def ret lst1)
    (for-each lst2
        (redef ret (append ret _item_)))
    ret)

(func .insert-num (lst item)
    (extend-reduce
        (append (take-while lst (<= _item_ item)) item)
        (drop-while lst (<= _item_ item))))

(func .insert-string (lst item)
    (extend-reduce
        (append (take-while lst (strcmp _item_ item)) item)
        (drop-while lst (strcmp _item_ item))))

; TODO closures don't work yet
(func .insert-maker (cmp)
    (lambda (lst item)
        (extend-reduce
            (append (take-while lst (cmp _item_ item)) item)
            (drop-while lst (cmp _item_ item)))))

;(func insertion-reduce (lst)
;    (reduce insert lst (list)))

(func .insertion-strings (lst)
    (reduce .insert-string lst (list)))

(func .insertion-nums (lst)
    (reduce .insert-num lst (list)))

(func insertion (lst :{:string})
    (.insertion-strings lst))

(func insertion (lst :{:number})
    (.insertion-nums lst))

(func insertion (lst :nil) lst)

(func nil? :bool (candidate :any)
    (and
        (list? candidate)
        (empty? candidate)))

(type :nil :[:any] nil?)

(func insertion-iter (lst)
    (def ret (list))
    (for-each lst
        (redef ret (.insert-num ret _item_))
        (print (->string ret)))
    ret)

(func merge :[:string] (lst :[:string])
    (.merge-cmp lst strcmp))

(func merge :[:number] (lst :[:number])
    (.merge-cmp lst <))

(func .merge-cmp (lst cmp)
    (print (concat "sorting: " (->string lst)))
    (if (eq? 1 (length lst))
        lst
        (block
            (def half (floor (/ (length lst) 2)))
            (def left (.merge-cmp (slice lst 1 half) cmp))
            (def right (.merge-cmp (slice lst (+ 1 half)) cmp))
            (.merge left right cmp))))

(func .merge (lst1 lst2 cmp)
    (print (concat "lst1: " (->string lst1)))
    (print (concat "lst2: " (->string lst2)))
    (def res (list))
    (def w1 lst1)
    (def w2 lst2)
    (while (and (not (empty? w1)) (not (empty? w2)))
        ;(if (< (first w1) (first w2))
        (if (cmp (first w1) (first w2))
            (block
                (redef res (append res (first w1)))
                (redef w1 (rest w1)))
            (block
                (redef res (append res (first w2)))
                (redef w2 (rest w2)))))
    (while (not (empty? w1))
        (redef res (append res (first w1)))
        (redef w1 (rest w1)))

    (while (not (empty? w2))
        (redef res (append res (first w2)))
        (redef w2 (rest w2)))
    res)

(func quick (lst)
    (branch
        ((<= (length lst) 1) lst)
        ((eq? 2 (length lst))
            (if (<= (first lst) (first (rest lst)))
                lst
                (reverse lst)))
        (#true
            (block
                ; 1. pick the last element as a pivot
                ; 2. consider all but the pivot
                ; 3. starting from the first
                ;   > if the element is less than or equal to the pivot, remove it from consideration and add it to "before"
                ;   > otherwise, add the element as the first element of "after", and swap the last element of consideration with the (new) first element of consideration
                ;   > once there's nothing left to consider, run quicksort on the beginning and the end, and put the pivot in the middle
                (def before (list))
                (def after (list))
                (def consider (reverse (rest (reverse lst))))
                (def pivot (last lst))
                (while (not (empty? consider))
                    (if (<= (first consider) pivot)
                        (block
                            (redef before (append before (first consider)))
                            (redef consider (rest consider)))
                        (block
                            (redef after (prepend after (first consider)))
                            (if (eq? 1 (length consider))
                                (redef consider (list))
                            (redef consider
                                (prepend (reverse (rest (reverse (rest consider)))) (last consider))))))
                    (print (concat "before: " (->string before)))
                    (print (concat "after: " (->string after)))
                    (print (concat "consider: " (->string consider))))
                (extend (append (quick before) pivot) (quick after))))))

(func strcmp :bool (left :string right :string)
    (branch
        ((or
            (eq? 0 (length left))
            (eq? 0 (length right)))
                (<= (length left) (length right)))
        ((eq? (first left) (first right))
            (strcmp (rest left) (rest right)))
        (#true
            (<= (ord (first left)) (ord (first right))))))

(func strings? (candidate :any)
    (and
        (list? candidate)
        (not (eq? 0 (length candidate)))
        (apply and
            (map string? candidate))))

(type :strings :[:string] strings?)

(func sorted? :bool (lst :strings)
    (.sorted? lst strcmp))

(func sorted? :bool (lst :[:number])
    (.sorted? lst <=))

;(func sorted? :bool (lst :nil) #true)

(func .sorted? :bool (lst :[:any] cmp)
    (def a (reverse (rest (reverse lst))))
    (def b (rest lst))
    (def acc (list))
    (for-count (length a)
        (append acc _idx_))
    (empty? (drop-while acc 
        (cmp 
            (slice a _item_ 1)
            (slice b _item_ 1)))))