This Text file is old! In a 🏛️Museum, an unsorted archive of (user-)pages. (Saved from Geocities in Oct-2009. The archival story: oocities.org)
--------------------------------------- (To 🚫report any bad content: archivehelp @ gmail.com)

; unfold1.scm - unfold examples from oxford unfold paper,
; foldt (fold tree) and foldf (fold forest), 
; preorder, level-order, and breadth first tree and forest traversal

(require-library "functio.scm")

(define foldt
 (lambda (f g)
  (lambda (tree)
   ;(display (format "~%foldt:~a" tree))  
   (cond 
     ((null? tree) 0) 
     (else 
       (let ((a (car tree))
             (ts (cdr tree)))
                (f a (foldf f g ts)) ))) )))
            
(define (foldf f g ts)
   ;(display (format "~%foldf:~a" ts))  
   (g (map (foldt f g) ts)) )

; Haskell:
;sum :: [Int] -> Int
;sum []     = 0
;sum (x:xs) = x + sum xs

(define (sum l)
   (foldr + 0 l))

;   (+ (car l) (sum (cdr l))) )

(sum '(1 2 3 4 5))

(define (sumt t)
   ((foldt + sum) t))

(define (sumf t)
   (foldf + sum t))

(define tree1 '(1 (2 (3)) (4) (5 (6) (7) (8)))) 
(define forest2 '( (1 (2 (3)) (4) (5 (6) (7) (8))) (1 (2 (3)) (4) (5 (6) (7) (8))) ))

(sumt tree1)
(sumf forest2)

;--------------------------------------------------------------
(display "preorder")(newline)

; Haskell:
; concat :: [[a]] -> [a]
; concat []     = []
; concat (x:xs) = x ++ concat xs

(define (concat l)
  (foldr append '() l))

(concat '((1 2 3 4 5) (6 7 8 9 10)))

(define (preordert tree)
   ((foldt cons concat) tree))

(define tree2 '(1 (2 (5) (6)) (3) (4 (7))) )

(preordert tree2)

;-------------------------------------------------------------

;lzw :: (a->a->a) -> [a] -> [a] -> [a]
;lzw op xs ys
;   | null xs = ys
;   | null ys = xs
;   | otherwise = (head xs `op` head ys) :
;                    lzw op (tail xs) (tail ys)

(define (lzw op xs ys)
   ;(display (format "~%xs:~A, ys:~A" xs ys))
   (cond 
     ((null? xs) ys)
     ((null? ys) xs)
     (else 
       (cons (op (car xs) (car ys)) (lzw op (cdr xs) (cdr ys)) ) ))) 

;lzc :: [[a]] -> [[a]] -> [[a]]
;lzc = lzw (++)

(define (lzc xs ys)
   (lzw append xs ys))

;glue :: [[[a]]] -> [[a]]
;glue = foldr lzc []

(define (glue l)
   (foldr lzc '() l))

;push :: a -> [[a]] -> [[a]]
;push a xss = [a] : xss

(define (push a xss)
   (cons (list a) xss))

;levelt :: Tree a -> [[a]]
;levelt = foldt push glue

(define (levelt l)
   ((foldt push glue) l))

;levelf :: Forest a -> [[a]]
;levelf = foldf push glue

(define (levelf l)
   (foldf push glue l))

; level order traversal:
(levelt tree2)
;[ [1], [2,3,4], [5,6,7] ]

; level traversal of a forest:
(define forest2 '( (1 (2 (5) (6)) (3) (4 (7))) (3 (4) (5)) (5) ))
(levelf forest2)
;[ [1,3,5], [2,3,4,4,5], [5,6,7] ]

;-----------------------------------------------------------------

; breadth first traversals:

;bftt :: Tree a -> [a]
;bftt = concat . levelt

(define (bftt tree)
   (concat (levelt tree)))

(bftt tree2)

;bftf :: Forest a -> [a]
;bftf = concat . levelf

(define (bftf tree)
   (concat (levelf tree)))

(bftf forest2)
;[1,3,5,2,3,4,4,5,5,6,7]