;; Copyright 2002 Stephen Wong
;; All rights reserved

;; -------------- Data structure and visitor framework definitions --------

;; A ListVisitor is a structure made up of two functions
;; One for the base case and 
;; one for the inductive case
(define-struct ListVisitor (fBase fInduct))

;; lExecute: list-of-any1 Visitor any2 --> any3
;; Executes ("accepts") the visitor on the list
;; returning the result.
;; param is passed to the visitor unmodified.
;; The base case of the Visitor is called on the empty list:
;; Visitor-fBase: list-of-any1 any2 --> any3
;; The inductive case is called on the non-empty list.
;; Visitor-fInduct: list-of-any1 any2 --> any3
(define (lExecute  a-list visitor param)
  (cond
    [(empty? a-list) ((ListVisitor-fBase visitor) a-list param)]
    [(cons? a-list) ((ListVisitor-fInduct visitor) a-list param)]))

;; A RAC is an immutable restricted access container.
;; A RAC is either
;; -- EmptyRAC
;; -- NERAC

;; An EmptyRAC is an empty immutable restricted access container.
;; add is a function that returns a NERAC with a new element added.
;; add: any --> NERAC
(define-struct EmptyRAC (add))

;; A NERAC is a non-empty immutable restricted access container
;; first is the first element in the RAC
;; first: any
;; rest is a function that returns the RAC w/o first
;; rest: --> RAC
;; add is a function that returns a NERAC with a new element added.
;; add: any --> NERAC
(define-struct NERAC (first rest add))


;; Visitor to a RAC
;; MT is the base case function:
;; MT: EmptyRAC any1 --> any2
;; NE is the inductive case function
;; NE: NERAC any1 --> any2
(define-struct RACVisitor (MT NE))


;; RACexecute: RAC RACVisitor any1 --> any2
;; "accept" method for visitors to a RAC
(define (RACexecute rac racVisitor param)
  (cond
    [(EmptyRAC? rac) ((RACVisitor-MT racVisitor) rac param)]
    [(NERAC? rac) ((RACVisitor-NE racVisitor) rac param)]))

;; ----- RAC utilities ------------------------------------------

;; Visitor to add an element to a RAC
(define RACadd 
  (make-RACVisitor 
   (lambda (mtRAC x)
     ((EmptyRAC-add mtRAC) x))
   (lambda (neRAC x)
     ((NERAC-add neRAC) x))))

;; Visitor view the first element out of a RAC
(define RACpeek
  (make-RACVisitor 
   (lambda (mtRAC x)
     "Error: Empty RAC!")
   (lambda (neRAC x)
     (NERAC-first neRAC))))

;; Visitor to return a new RAC with the first element removed.
(define RACremove
  (make-RACVisitor 
   (lambda (mtRAC x)
     "Error:  Empty RAC!")
   (lambda (neRAC x)
     ((NERAC-rest neRAC)))))

;; Visitor to read out the elements of a RAC
(define RACread 
  (make-RACVisitor
   (lambda (mtRAC param)
     empty)
   (lambda (neRAC param)
     (cons (NERAC-first neRAC) (RACexecute ((NERAC-rest neRAC)) RACread param)))))

;; ----- Examples of RACs ----------------------------------------------------


;; Creates an empty first-in-last-out RAC
(define stackRAC 
  (local
      [(define (stackFac dataStore)
         (local [(define (restFn) 
                   (stackFac (rest dataStore)))
                 (define (addFn x)
                   (stackFac (cons x dataStore)))]
           (lExecute dataStore
                     (make-ListVisitor
                      (lambda (a-list param)
                        (make-EmptyRAC addFn))
                      (lambda (a-list param)
                        (make-NERAC (first dataStore) restFn addFn ))) 
                     null)))]
    (stackFac empty)))

;; Creates an empty first-in-first-out RAC
(define queueRAC 
  (local
      [(define (queueFac dataStore)
         (local [(define (restFn) 
                   (queueFac (rest dataStore)))
                 (define (addFn x)
                   (queueFac (append dataStore (list x))))]
           (lExecute dataStore
                     (make-ListVisitor
                      (lambda (a-list param)
                        (make-EmptyRAC addFn))
                      (lambda (a-list param)
                        (make-NERAC (first dataStore) restFn addFn ))) 
                     null)))]
    (queueFac empty)))

;; Creates an largest-out-first (priority) RAC
(define priorityRAC 
  (local
      [(define ordInsVis 
         (make-ListVisitor
          (lambda (emptyHost data)
            (cons data empty))
          (lambda (NEhost data)
            (cond
              [(> data (first NEhost)) (cons data NEhost)]
              [else (cons (first NEhost) (lExecute (rest NEhost) ordInsVis data))])))) 
       
       (define (priorityFac dataStore)
         (local [(define (restFn) 
                   (priorityFac (rest dataStore)))
                 (define (addFn x)
                   (priorityFac (lExecute dataStore ordInsVis x)))]
           (lExecute dataStore
                     (make-ListVisitor
                      (lambda (a-list param)
                        (make-EmptyRAC addFn))
                      (lambda (a-list param)
                        (make-NERAC (first dataStore) restFn addFn ))) 
                     null)))]
    (priorityFac empty)))





"RAC test cases:"
"stacks:"
(define stack1 (RACexecute stackRAC RACadd 1))
(define stack2 (RACexecute stack1 RACadd 2))
(define stack3 (RACexecute stack2 RACadd 3))
(define stack4 (RACexecute stack3 RACadd 4))
(RACexecute stack4 RACread null)

(equal? "Error: Empty RAC!" (RACexecute stackRAC RACpeek null))
(= 4 (RACexecute stack4 RACpeek null))
(= 3 (RACexecute (RACexecute stack4 RACremove null) RACpeek null))

"queues:"
(define queue1 (RACexecute queueRAC RACadd 1))
(define queue2 (RACexecute queue1 RACadd 2))
(define queue3 (RACexecute queue2 RACadd 3))
(define queue4 (RACexecute queue3 RACadd 4))
(RACexecute queue4 RACread null)

(equal? "Error: Empty RAC!" (RACexecute queueRAC RACpeek null))
(= 1 (RACexecute queue4 RACpeek null))
(= 2 (RACexecute (RACexecute queue4 RACremove null) RACpeek null))

"priority:"
(define priority1 (RACexecute priorityRAC RACadd 4))
(define priority2 (RACexecute priority1 RACadd 2))
(define priority3 (RACexecute priority2 RACadd 1))
(define priority4 (RACexecute priority3 RACadd 3))
(RACexecute priority4 RACread null)

(equal? "Error: Empty RAC!" (RACexecute priorityRAC RACpeek null))
(= 4 (RACexecute priority4 RACpeek null))
(= 3 (RACexecute (RACexecute priority4 RACremove null) RACpeek null))


;; ======================   Tree Traversal Using a RAC   ===============================

;;A BinTree is eithe 
;; -- an empty tree, MTBinTree
;; -- a non-empty tree, NEBinTree

;; A NEBinTree has data (first), 
;; and a left and right sub-BinTrees.
;; (make-NEBinTree any BinTree BinTree)
(define-struct NEBinTree (first left right))

;; An empty BinTree is an empty structure.
(define-struct MTBinTree ())

;; Singleton empty BinTree
(define MTBT (make-MTBinTree))

;; Visitor to a BinTree:
;; fBase: MTBinTree any1 --> any2
;; fBase: NEBinTree any1 --> any2
(define-struct BTVisitor (fBase fInduct))

;; btExecute: BinTree BTVisitor any1 --> any2 
;; Execute function for a BinTree and its visitors
(define (btExecute binTree btVisitor param)
  (cond
    [(MTBinTree? binTree) ((BTVisitor-fBase btVisitor) binTree param)]
    [(NEBinTree? binTree) ((BTVisitor-fInduct btVisitor) binTree param)]))


;; Visitor to a RAC that will load the RAC for the recursive call.
;; The parameter indBTVis is a visitor to a tree 
;; will take the recursive result of the traversal 
;; and return the net result:
;; indBTVis: BinTree any --> any
;; The base case recursive result is an empty list.
(define racProcess1
  (make-RACVisitor
   (lambda (rac indBTVis) ;; RAC is empty
     empty)
   (lambda (rac indBTVis) ;; RAC is non-empty
     (local [(define t (RACexecute rac RACpeek null)) ;; retain a ref to the first tree in the RAC
             (define nextRAC ;; this is the reloaded RAC
               (btExecute  ;; process the first tree
                t 
                (make-BTVisitor
                (lambda (bt param)  ;; Empty tree--remove it from the RAC
                  (RACexecute rac RACremove null))
                (lambda (bt param)  ;; non-empty tree--remove it and add its children
                  (RACexecute 
                   (RACexecute 
                    (RACexecute 
                     rac 
                     RACremove ;; remove the (parent) tree
                     null)
                    RACadd 
                    (NEBinTree-right t)) ;; add  right child tree
                   RACadd 
                   (NEBinTree-left t)))) ;; add left child tree
                null))
             (define (makeRR) (RACexecute nextRAC racProcess1 indBTVis))] ;; Recursively process the whole RAC
       (btExecute t indBTVis makeRR)))))   ;; combine the recursive result with the current tree for total result, ala the lambda used by foldr


;; visitor to a BinTree that cons's the first of the host BinTree onto the 
;; given recursive result.
(define consFirst 
  (make-BTVisitor
   (lambda (t makeRR)
     (makeRR))
   (lambda (t makeRR)
     (cons (NEBinTree-first t) (makeRR)))))

;; make-btTraverse:  RACVisitor BTVisitor --> BTVisitor
;; Factory to make a visitor to traverse a binary tree. 
;; A visitor to a RAC used to load the RAC for the recursive call 
;; and a visitor to a BinTree that is the process being performed 
;; during the traversal.
(define (make-btTraverse racProcess travProcess)
  (local
      [(define (btTraverse host rac)
         (RACexecute (RACexecute rac RACadd host) racProcess travProcess))]
    (make-BTVisitor btTraverse btTraverse)))


;; --------- Test code ---------------------------------------------------
(define t (make-NEBinTree 'a
                          (make-NEBinTree 'b
                                          ;;(make-NEBinTree 'z MTBT MTBT) 
                                          
                                          MTBT
                                          ;;MTBT
                                          (make-NEBinTree 'c MTBT MTBT)
                                          )
                          (make-NEBinTree 'd
                                          (make-NEBinTree 'e
                                                          MTBT
                                                          MTBT)
                                          (make-NEBinTree 'f
                                                          MTBT
                                                          MTBT))))

;;         a
;;     b       d
;;      c     e  f 

;; depth first = (a b c d e f) or (a d f e b c)
;; breadth first = (a b d c e f) or (a d b f e c) 

"Binary Tree traversal using a stack: depth-first (a b c d e f)"
(btExecute t (make-btTraverse racProcess1 consFirst) stackRAC)

"Binary Tree traversal using a queue: breadth-first (a d b f e c)"
(btExecute t (make-btTraverse racProcess1 consFirst) queueRAC)