;; cons-cells were a really nifty new data type that we 
;; have been able to use to create much more complex
;; structures (e.g. lists, trees, tagged data structures).
;; Here we'll create a new data type, the triplet.  A 
;; cons cell has two parts: the car and the cdr parts.
;; Our triplet will have three parts: l (left), m (middle),
;; and r (right).  
;;
;; We need some representation for this data structure.  
;; What are some possibilities?
;;
;; Here we'll use a message-passing procedure.

(define (make-triplet l m r)
  (lambda (msg . args)
    (case msg
      ((L) l)
      ((M) m)
      ((R) r)
      ((SET-L!) (set! l (first args)))
      ((SET-M!) (set! m (first args)))
      ((SET-R!) (set! r (first args)))
      (else (error "can't " msg " with a triplet")))))

(define x (make-triplet '() 1 '()))
x ; -> procedure
(x 'M) ; -> 1

;; How would we write a predicate triplet? that can take
;; any value and tell us if its a triplet?
;;
;; Answer: if we just use the message-passing procedure,
;; we have no fool-proof way.  We can test if an object
;; is a procedure, but we can't test if it came from
;; the lambda in make-triplet.  One solution is to wrap
;; our triplets in a tagged data structure.  Let's do that:

(define *triplet-tag* 'triplet)

(define (create-triplet l m r)  
  (list *triplet-tag* (make-triplet l m r)))

(define (triplet? x)
  (and (pair? x) (eq? (car x) *triplet-tag*)))

(define (check-triplet t)
  (if (not (triplet? t)) 
      (error "not a triplet:" t)))

(define (l t) (check-triplet t) ((cadr t) 'L))
(define (m t) (check-triplet t) ((cadr t) 'M))
(define (r t) (check-triplet t) ((cadr t) 'R))

(define (set-l! t x) (check-triplet t) ((cadr t) 'SET-L! x))
(define (set-m! t x) (check-triplet t) ((cadr t) 'SET-M! x))
(define (set-r! t x) (check-triplet t) ((cadr t) 'SET-R! x))

;; To help with debugging, we really want a good way to
;; display a triplet's full data structure.  For cons cells,
;; we gave a long list of display rules using parentheses,
;; values, dots, etc.  Here's an analagous way of displaying
;; a triplet tree:

(define (display-triplet t)
  (cond ((null?      t) (display "-"))
        ((symbol?    t) (display t))
        ((number?    t) (display t))
        ((triplet? t) 
         (display "[")
         (display-triplet (l t))
         (display-triplet (m t))
         (display-triplet (r t))
         (display "]"))
        ((pair?      t) 
         (display "(")
         (for-each display-triplet t)
         (display ")"))
        (else (error "don't know how to handle " t))))

;; One of the useful things a person might do with a triplet
;; is to build double linked list.  A regular (linked) list
;; consists of nodes (implemented with cons cells) where 
;; each node has a data element (the car part) and a pointer
;; to the next node (the cdr part).  A double linked list
;; contains a pointer to the previous node (in the L part),
;; the data element (in the M part), and a pointer to the
;; next node (in the R part).  Write a procedure that takes
;; a regular list (consisting of cons cells) and converts
;; it to a double linked list (consisting of triplets).

(define (build-double-list l)
  (define (element-to-triplet x)
    (create-triplet '() x '()))
  (let ((result (map element-to-triplet l)))
    (foldr (lambda (x accum)
             (set-r! x accum)
             x)
           '()
           result)
    (foldr (lambda (x accum)
             (set-l! x accum)
             x)
           '()
           (reverse result))
    (car result)))

(define x (build-double-list '(1 2 3 4)))
(m x) ; -> 1
(l x) ; -> ()
(m (r x)) ; -> 2
(m (r (r (r x)))) ; -> 4
(m (l (r (r (r x))))) ; -> 3

;; Another thing we might do with a triplet is use it to 
;; create a binary search tree.  The M part of each triplet 
;; will be the triplet's value, the L part will be its left
;; child, and the R part will be its right child.  Write a
;; procedure that takes a list and builds a BST by 
;; iteratively inserting each data item from a list.  You
;; may assume that the list is non-empty and contains only
;; numbers.

(define (build-binary-search-tree lst)
  (let ((root (create-triplet '() (car lst) '())))
    (define (insert! node new-val)
      (cond ((null? node) 
             (create-triplet '() new-val '()))
            ((< new-val (m node))
             (set-l! node (insert! (l node) new-val))
             node)
            (else
             (set-r! node (insert! (r node) new-val))
             node)))
    (for-each (lambda (x) (insert! root x))
              (cdr lst))
    root))

(display-triplet (build-binary-search-tree '(4 2 1 3 5 6)))
(newline)

;; Lets make a procedure that converts a triplet structure
;; into a list structure, where each triplet becomes a
;; 3-element list.

(define (triplet-to-list t)
  (cond ((triplet? t) 
         (list (triplet-to-list (l t))
               (triplet-to-list (m t))
               (triplet-to-list (r t))))
        (else t)))

(triplet-to-list (build-binary-search-tree '(4 2 1 3 5 6)))

;; Other times we'd like to extract all of the elements out
;; of a triplet binary search tree.  Let's flatten a BST
;; into a list using a depth-first search.

(define y (build-binary-search-tree '(4 2 1 3 5 6)))

(define (flatten-dfs t)
  (cond ((null?      t) t)
        ((symbol?    t) (list t))
        ((number?    t) (list t))
        ((triplet? t) 
         (append (flatten-dfs (l t))
                 (flatten-dfs (m t))
                 (flatten-dfs (r t))))
        (else (error "don't know how to handle " t))))

(flatten-dfs y) ; -> (1 2 3 4 5 6)

;; breadth-first...

(define (flatten-bfs t)
  (define (value-accum t acc) 
    (if (triplet? t) (cons (m t) acc) acc))
  (define (left-accum  t acc) 
    (if (triplet? t) (cons (l t) acc) acc))
  (define (right-accum t acc) 
    (if (triplet? t) (cons (r t) acc) acc))
  (cond ((triplet? t)
         (flatten-bfs (list t)))
        ((pair?      t)
         (append (foldr value-accum '() t)
                 (flatten-bfs 
                  (append (foldr left-accum  '() t)
                          (foldr right-accum '() t)))))
        (else t)))

(flatten-bfs y) ; -> (4 2 5 1 3 6)

;; depth-first using the same structure as breadth-first...

(define (flatten-dfs2 t)
  (define (value-accum t acc) 
    (if (triplet? t) (cons (m t) acc) acc))
  (define (left-accum  t acc) 
    (if (triplet? t) (cons (l t) acc) acc))
  (define (right-accum t acc) 
    (if (triplet? t) (cons (r t) acc) acc))
  (cond ((triplet? t)
         (flatten-dfs2 (list t)))
        ((pair?      t)
         (append (flatten-dfs2 (foldr left-accum  '() t))
                 (foldr value-accum '() t)
                 (flatten-dfs2 (foldr right-accum '() t))))
        (else t)))

(flatten-dfs2 y) ; -> (1 2 3 4 5 6)