queue.scm

#lang racket/base
(require rackunit)

(define simple-q '((1 2 3) (6 5 4)))

(define empty-queue '(()()))

(check-equal? empty-queue '(() ())
              "An empty queue is a list containing two empty lists.")

(define right-side (lambda (queue) (car (cdr queue))))

(check-equal? (right-side simple-q) '(6 5 4)
              "The right side of a queue is the second list.")

(define left-side (lambda  (queue) (car queue)))

(check-equal? (left-side simple-q) '(1 2 3)
              "The left side of a queue is the first list.")

(define count-elements
  (lambda (list)
    (define recursive-count
      (lambda (list counter)
        (if (null? list)
            counter
            (recursive-count (cdr list) (+ 1 counter)))))
    (recursive-count list 0)))

(check-equal? (count-elements '()) 0
              "An empty list has zero elements")

(check-equal? (count-elements '(1 2 3)) 3
              "A list with three elements has three elements.")

(define lhs-length (lambda (queue) (count-elements (left-side queue))))

(check-equal? (lhs-length simple-q) 3
              "The length of the left side is the number of elements it contains.")

(define rhs-length (lambda (queue) (count-elements (right-side queue))))

(check-equal? (rhs-length simple-q) 3
              "The length of the right side is the number of elements it contains.")

(define q-length (lambda (queue) (+ (lhs-length queue) (rhs-length queue))))

(check-equal? (q-length simple-q) 6
              "The length of a full queue is the number of elements in both sides.")

(define insert (lambda (item queue)
                  (list (left-side queue) (cons item (right-side queue)))))

(check-equal? (insert 7 simple-q) '((1 2 3) (7 6 5 4))
              "Inserting an element adds it to the beginning of the right side list.")

;;(define remove
 ;;(lambda (queue)
  ;;(list (car (left-side queue))
    ;;    (list (cdr (left-side queue)) (right-side queue)))))

;;(check-equal? (remove simple-q) '(1 ((2 3) (6 5 4)))
   ;;           "Removing an element returns a pair: the removed element and the new queue.")

(define swap (lambda (queue) (list (right-side queue) (left-side queue))))

(check-equal? (swap simple-q) '((6 5 4) (1 2 3))
              "The right side and left side can be swapped.")

(define reverse
  (lambda (items)
    (if (null? (cdr items))
        items
        (append (reverse (cdr items)) (list (car items))))))

(check-equal? (reverse (right-side simple-q)) (list 4 5 6)
              "A list's elements can be reversed.")

(define reverse-car (lambda (items) (cons (reverse (car items)) (cdr items))))

(check-equal? (reverse-car '((1 2) (3 4))) '((2 1) (3 4))
              "The first item in a list can be reversed.")

(define swap-and-reverse-car
  (lambda (queue) (reverse-car (swap queue))))

(check-equal? (swap-and-reverse-car '(() (6 5 4))) '((4 5 6) ())
              "Swap and reverse-car can be composed to swap sides, then reverse the left.")

(define remove
   (lambda (queue)
     (if (null? (left-side queue))
         (remove (swap-and-reverse-car queue))
         (list (car (left-side queue))
               (list (cdr (left-side queue)) (right-side queue))))))

(check-equal? (remove '(() (6 5 4))) '(4 ((5 6) ()))
              "To remove an element when the left side is empty, swap and reverse, then try again.") 
 
(check-equal? (remove simple-q) '(1 ((2 3) (6 5 4)))
              "Removing an element returns a pair: the removed element and the new queue.")

(define memoize
  (lambda (func)
    (let ((already-run? #f) (result #f))
      (lambda ()
        (if (not already-run?)
            (begin (set! result (func))
                   (set! already-run? #t)
                   result)
            result)))))

(define-syntax delay
  (syntax-rules ()
    ((delay form) (memoize (lambda () form)))))

(define force
  (lambda (delayed)
    (delayed)))

(let ((add-ones (delay (+ 1 1))))
  (check-pred procedure? add-ones)
  (check-equal? (force add-ones) 2))

(define-syntax lcons
  (syntax-rules ()
    ((lcons item items) (cons item (delay items)))))

(define llist
  (lambda (items)
    (if (null? items)
        '()
        (lcons (car items) (llist (cdr items))))))

(define lazy (llist '(1 2 3 4 5)))

(check-pred pair? lazy
            "A lazy list is a pair: the head of the list and a delayed function.")

(check-equal? (car lazy) 1
               "A lazy list stores its head as the first item of a pair.")

(check-pred procedure? (cdr lazy)
            "A lazy list stores a delayed function as the second item of a pair.")

(check-equal? (car ((cdr lazy))) 2
               "Evaluating the delayed function returns the next item in the list.")

(define lcar
  (lambda (llist)
    (car llist)))

(check-equal? (lcar lazy) 1
              "Lazy-car is just like regular car!")

(define lcdr
  (lambda (llist)
    (force (cdr llist))))

(check-equal? (car (lcdr lazy)) 2
              "Lazy-cdr forces evaluation of the next list element.")

(define empty-q (list (cons '() 0) (cons '() 0)))

(define five-items (list (cons (llist '(1 2)) 2) (cons (llist '(3 4 5)) 3)))

(define lhs-len
  (lambda (queue)
    (cdr (left-side queue))))

(check-equal? (lhs-len five-items) 2
              "Our lazy queue stores the length of the lists on each side.")

(define rhs-len
  (lambda (queue)
    (cdr (right-side queue))))

(check-equal? (rhs-len five-items) 3
              "Our lazy queue stores the length of the lists on each side.")

(define lhs-list
  (lambda (queue)
    (car (left-side queue))))

(check-equal? (lcar (lhs-list five-items)) (lcar (llist '(1 2))))

(define rhs-list
  (lambda (queue)
    (car (right-side queue))))

(check-equal? (lcar (rhs-list five-items)) (lcar (llist '(3 4 5))))

(define take-n
  (lambda (n lazy-list)
    (if (= 0 n) '()
        (cons (lcar lazy-list) (take-n (- n 1) (lcdr lazy-list))))))

(check-equal? (take-n 4 (llist '(1 2 3 4 5 6 7))) '(1 2 3 4)
              "Take-n returns the first n elements of a lazy list.")

(define rotate
  (lambda (left right)
    (define rotate-recur
      (lambda (left right accumulator)
        (if (null? left)
            (lcons (lcar right) accumulator)
            (lcons (lcar left) (rotate-recur (lcdr left)
                                             (lcdr right)
                                             (lcons (lcar right) accumulator))))))
    (rotate-recur left right '())))

(let ((rotated (rotate (lhs-list five-items) (rhs-list five-items))))
  (check-equal? (take-n 5 rotated) '(1 2 5 4 3)
                "Rotate reverses the right side list and concatenates it to the left."))

(define make-queue
  (lambda (left right)
    (if (<= (cdr right) (cdr left))
        (list left right)
        (list (cons (rotate (car left)
                            (car right))
                    (+ (cdr left) (cdr right)))
              (cons '() 0)))))

(let ((rebalanced (make-queue (left-side five-items) (right-side five-items))))
  (check-equal? (take-n 5 (lhs-list rebalanced)) '(1 2 5 4 3))
  (check-equal? (rhs-list rebalanced) '()
                "Make-queue rebalances the queue when the right side is longer than the left."))

(define ins
  (lambda (item queue)
    (make-queue (left-side queue)
                (cons (lcons item (rhs-list queue))
                      (+ 1 (rhs-len queue))))))

(let ((three-items (ins 3 (ins 2 (ins 1 empty-q))))
      (six-items (ins 6 (ins 5 (ins 4 (ins 3 (ins 2 (ins 1 empty-q))))))))
  (check-equal? (take-n 3 (lhs-list three-items)) '(1 2 3))
  (check-equal? (take-n 3 (lhs-list six-items)) '(1 2 3))
  (check-equal? (take-n 3 (rhs-list six-items)) '(6 5 4)
                "Ins adds elements to the right side and rebalances if it's longer than the left."))

(define rem
  (lambda (queue)
    (if (and (null? (lhs-list queue)) (null? (rhs-list queue)))
        '()
        (list (lcar (lhs-list queue))
              (make-queue (cons (lcdr (car (left-side queue)))
                                (- (lhs-len queue) 1))
                          (right-side queue))))))

(let ((removed (rem (ins 4 (ins 3 (ins 2 (ins 1 empty-q)))))))
  (check-equal? (car removed) 1) 
  (check-equal? (take-n 2 (lhs-list (cadr removed))) '(2 3))
  (check-equal? (take-n 1 (rhs-list (cadr removed))) '(4)
                "Rem returns a pair: the element removed from the queue and the new queue."))

(define ins-items
  (lambda (items queue)
    (if (null? items)
        queue
        (ins-items (cdr items) (ins (car items) queue)))))

(let ((seven-items (ins-items '(1 2 3 4 5 6 7) empty-q)))
  (check-equal? (take-n 7 (lhs-list seven-items)) '(1 2 3 4 5 6 7)
                "Ins-items adds multiple items to the queue."))

(define rem-n
  (lambda (n queue)
    (define rem-n-iter
      (lambda (n queue items)
        (if (= 0 n)
            (cons (reverse items) queue)
            (rem-n-iter (- n 1)
                        (car  (cdr (rem queue)))
                        (cons (car (rem queue)) items)))))
    (rem-n-iter n queue '())))

(let ((remove-four (rem-n 4 (ins-items '(1 2 3 4 5 6 7) empty-q))))
  (check-equal? (car remove-four) '(1 2 3 4))
  (check-equal? (+ (lhs-len (cdr remove-four))
                   (rhs-len (cdr remove-four))) 3
                   "Rem-n returns a list of removed items and the new queue."))

(define example-tree '("A" ("B" "leaf"
                                ("C" "leaf"
                                     "leaf"))
                           ("D" "leaf"
                            "leaf")))

(define five-nodes '("A" ("B" ("D" "leaf"
                                   "leaf")
                              ("E" "leaf"
                                   "leaf"))
                         ("C" "leaf"
                              "leaf")))
  
(define twelve-nodes '("A" ("B" "leaf")
                           ("C" "leaf"
                                ("D" ("F" "leaf"
                                          "leaf")
                                     ("G" ("I" "leaf"
                                               "leaf") "leaf")
                                     ("H" ("J" "leaf"
                                               "leaf"
                                               "leaf")
                                          ("K" "leaf")
                                          ("L" "leaf")))
                                     ("E" "leaf"))))


(define visit-order
  (lambda (tree)
  (define bfs-iter
    (lambda (queue visited n)
      (if (null? (rem queue)) visited
          (let ((node (car (rem queue)))
                (new-q (car (cdr (rem queue)))))
            (if (equal? "leaf" node)
                (bfs-iter new-q visited n)
                (bfs-iter (ins-items (cdr node) new-q) (cons (cons (car node) n) visited) (+ 1 n)))))))
  (bfs-iter (ins tree empty-q) '() 1)))

(check-equal? (visit-order example-tree) '(("C" . 4) ("D" . 3) ("B". 2) ("A" . 1))
              "Visit-order searches a tree breadth-first and returns a list of nodes and their number.")

(check-equal? (visit-order five-nodes) '(("E" . 5) ("D" . 4) ("C" . 3) ("B" . 2) ("A" . 1)))

(check-equal? (visit-order twelve-nodes) '(("L" . 12) ("K" . 11) ("J" . 10) ("I" . 9) ("H" . 8) ("G" . 7) ("F" . 6)
                                           ("E" . 5) ("D" . 4) ("C" . 3) ("B" . 2) ("A" . 1))
              "Visit-order works on non-binary trees.")

(define walk-map
  (lambda (func items)
     (define apply-or-map
       (lambda (item)
         (cond ((null? item) '())
               ((pair? item) (map apply-or-map item))
               (else (func item)))))
     (map apply-or-map items)))

(check-equal? (walk-map (lambda (i) (cond ((= i 1) "one") ((= i 2) "two") ((= i 3) "three") ))
                        '(1 2 (1 1 2 (3 (1 (2) 2) 1 3))))
              '("one" "two" ("one" "one" "two" ("three" ("one" ("two") "two") "one" "three"))))

(define make-label-map
  (lambda (labels)
    (let ((label-map (make-hash)))
      (define add-labels
        (lambda (labels)
          (if (null? labels)
              label-map
              (let ((node   (car  (car labels)))
                    (number (cdr (car labels))))
                (hash-set! label-map node number)
                (add-labels (cdr labels))))))
      (add-labels labels))))

(let ((label-map (make-label-map (visit-order example-tree))))
  (check-equal? (hash-ref label-map "A") 1)
  (check-equal? (hash-ref label-map "B") 2)
  (check-equal? (hash-ref label-map "C") 4)
  (check-equal? (hash-ref label-map "D") 3))

(define number-tree
  (lambda (tree)
    (let ((label-map (make-label-map (visit-order tree))))
      (walk-map (lambda (node) (if (equal? "leaf" node) "leaf" (hash-ref label-map node))) tree))))

(check-equal? (number-tree example-tree) '(1 (2 "leaf" (4 "leaf" "leaf")) (3 "leaf" "leaf")))
(check-equal? (number-tree five-nodes) '(1 (2 (4 "leaf" "leaf") (5 "leaf" "leaf")) (3 "leaf" "leaf")))
(check-equal? (number-tree twelve-nodes) '(1
                                           (2 "leaf")
                                           (3
                                            "leaf"
                                            (4
                                             (6 "leaf" "leaf")
                                             (7 (9 "leaf" "leaf") "leaf")
                                             (8 (10 "leaf" "leaf" "leaf") (11 "leaf") (12 "leaf")))
                                               (5 "leaf"))))