#lang scheme

; part 1

(define list2 (lambda (e1 e2) (cons e1 (cons e2 '()))))
(define list3 (lambda (e1 e2 e3) (cons e1 (cons e2 (cons e3 '() )))))

; part 2 - map and reduce

(define fmap (lambda (fn L)
    (if (null? L)
        '()
        (cons (fn (first L)) (fmap fn (rest L)))
    ))
)

; compare the run-time stacks of these two solutions

; non-tail recursive - there is still work to do after the recursive call
(define freduce-non-tail (lambda (identity fn L)
    (if (null? L)
        identity
        (fn (first L) (freduce identity fn (rest L)))
    )))

; tail recursive solution
(define freduce (lambda (left-accumulate fn L)
    (if (null? L)
        identity
        (freduce (fn left-accumulate (first L)) fn (rest L))
    )))


; part 3 - deep list equality

(define both-are-lists? (lambda (x y)
    (and (list? x) (list? y))
))

(define both-are-null? (lambda (x y)
    (and (null? x) (null? y))
))

(define both-are-not-null? (lambda (x y)
    (and (not (null? x)) (not (null? y)) )
))

(define both-are-numbers? (lambda (x y)
    (and (number? x) (number? y))
))

(define lequal? (lambda (x y)
    (if (both-are-lists? x y)
        (if (both-are-not-null? x y)
            (and
                (lequal? (first x) (first y))
                (lequal? (rest x) (rest y))
            )
            (both-are-null? x y)
        )
        (if (both-are-numbers? x y) 
            (= x y)
            #f
        )
    )
))


; part 4 - list construction

(define genindex (lambda (n) (genindex_r 0 n)))
(define genindex_r (lambda (i n)
    (if (>= i n)
        '()
        (cons i (genindex_r (+ 1 i) n))
    )))


(define genseq (lambda (low high inc)
    (fmap (lambda (i) (+ low (* i inc))) 
          (genindex (+ 1 (quotient (- high low) inc) ) )
    )
))


; part 5 binary tree simplification

; if L and R are different return (L R) else return L
(define simplify_pair (lambda (L R) 
    (if (lequal? L R)
        L
        (list2 L R)
    )
))


(define simplify
  (lambda (L)
    (if (not (list? L))
        ; non-lists are already simple
        L
        (if (null? L)
            ; empty lists are simple
            L
            (if (null? (rest L))
                ; 1 element lists are replaced by simplified first element
                (simplify (first L))
                (if (null? (rest (rest L)))
                    ; 2 element lists need the pair simplified
                    (simplify_pair (simplify (first L)) 
                                   (simplify (second L)))
                    ; > 2 element lists have their terms simplified, but 
                    ; can't be simplified at the node since they are not
                    ; binary trees
                    (fmap simplify L)
                    )
                )
            )
        )))

(simplify '((1 1) (1 (1 1))))