tree-tree-tree-tree-tree-tree-tree-tree-tree-tree

;;Lecture 2

;;5
(defun hypotenuse (x y) (sqrt (+ (* x x) (* y y))))

;2
(defun circle-area (r) (* pi r r))

(defun cone-volume (r h) (* 1/3 h (circle-area r)))

;;7
(defun signumb (x)
  (if (> x 0) 1
    (if (= x 0 ) 0 -1)))

;;8
(defun mini (x y)
  (if (< x y) x y))

;;9
(defun maxi (x y)
  (if (> x y) x y))

;;10
(defun coord-dst (A-x A-y B-x B-y)
  (let ((x (- A-x B-x)) (y (- A-y B-y)))
    (hypotenuse x y)))

;;11
(defun trianglep (a b c)
  (and (tri-side-p a b c) (tri-side-p b c a) (tri-side-p c a b))
  )

(defun tri-side-p (a b c)
  (> (+ a b) c))

;;12
(defun heron (a b c)
  (let ((s (/ (+ a b c) 2)))
    (sqrt (* s (- s a) (- s b) (- s c)))))
;;13
(defun heron-cart(A-x A-y B-x B-y C-x C-y)
  (heron (point-dst A-x A-y B-x B-y) (point-dst B-x B-y C-x C-y) (point-dst C-x C-y A-x A-y)))


;;Lecture 3

;;8
(defun get-gcd (a b)
  (if (= b 0) a (get-gcd b (mod a b))))

;;13
(defun digit-count (x) (digit-count-internal x 0))

(defun digit-count-internal (x count)
       (if (< x 1) count (digit-count-internal (/ x 10) (+ count 1))))

;;Returns the digit at Nth position from the right without using mod/rem, starts from 1
(defun digit (x n)
        (floor (* (- (/ x (power 10 n))
            (floor (/ x (power 10 n))) ) 10)) )

;;12
(defun power (x n) (power-internal x n 1))

(defun power-internal (x n res) (if (> n  0) (power-internal x (- n 1) (* res x)) res))

(defun digit-sum (x) (digit-sum-internal x (digit-count x) 1 0))

(defun digit-sum-internal (x length pos sum)
  (if (> pos length) sum (digit-sum-internal x length (+ pos 1) (+ sum (digit x pos)))))

;;Uses digit-sum --> see 5 lines above
(defun multiply-of-9-internal-p (x) (if (>= x 10) (multiply-of-9-internal-p (digit-sum x)) (= x 9) ))

(defun multiply-of-9-p (x) (multiply-of-9-internal-p (digit-sum x)))

;;5
(defun ellipse-area (a b) (if (eql b t) (ellipse-area a a) (* pi a b)))

;;9
(defun heron-sqrt (a x dif)
  (if (<= (abs-delta (power x 2) a) dif) (* x 1.0)
      (heron-sqrt a (/ (+ x (/ a x)) 2) dif)
))

(defun abs-delta (a b)
  (abs (- a b)))

;;14
(defun leibniz (deviation)
  (leibniz-internal (/ deviation 10) 1 -1 3))

(defun leibniz-internal (deviation prev m n)
  (let ((fraction (/ m n)))
    (if (<= (abs fraction) deviation) (* 4.0 prev)
      (leibniz-internal deviation (+ prev fraction) (- m) (+ 2 n)))))
;;10
(defun range-sum-dumb (a b)
  (if(> a b) 0
    (if (= a b) a
      (+ b (range-sum-dumb a (- b 1))))))
;;11
(defun range-sum (a b)
  (if (> a b) 0 (range-sum-internal a b a)))

(defun range-sum-internal (a b prev)
  (if (= a b) prev (range-sum-internal a (- b 1) (+ prev b))))

;;Lecture 4

(defun fib (n)
  (fib-tr n 1 0))

(defun fib-tr (n next result)
  (cond ((= n 0) result)
        (t (fib-tr (- n 1) (+ next result) next))))

(defun power2 (n)
  (* n n))

(defun fast-power (a n)
  (fast-power-iter a n 1))

(defun fast-power-iter (a n ir)
  (cond ((= n 0) ir)
        ((evenp n)
         (power2 (fast-power-iter a (/ n 2) ir)))
        (t (fast-power-iter a (- n 1) (* a ir)))))

;;Smaller first, larger second
(defun dividesp (x y)
  (= (mod y x) 0))

(defun remc (x y)
  (- x (* y (truncate (/ x y)))))

(defun primep (x)
  (prime-iter-p x (floor (/ x 2))))

(defun prime-iter-p (x check)
  (or (<= check 1) (and (not (dividesp check x)) (prime-iter-p x (- check 1)))))

(defun perfectp (x)
  (perfect-iter-p x (floor (/ x 2)) 0))

(defun perfect-iter-p (x check ir)
  (or
   (and (<= check 0) (= ir x))
   (and (> check 0)
        (if (dividesp check x)
            (and (<= (+ check ir) x) (perfect-iter-p x (- check 1) (+ ir check)))
          (perfect-iter-p x (- check 1) ir)))))

(defun pascal (row e)
  (if (or (< e 0) (> e row) (and (= row 0) (not (= e 0))))
      0
    (if (= row 0) 1
      (+ (pascal (- row 1) (- e 1)) (pascal (- row 1) e)))))

(defun fibbi (n)
  (fibbi-iter n 0 1))

(defun fibbi-iter (n current next)
  (if (<= n 0) current (fibbi-iter (- n 1) next (+ current next))))

;;Lecture 5

(defun my-make-list (length elem)
  (if (= length 0)
      ()
    (cons elem (my-make-list (- length 1) elem))))

(defun my-length (list)
  (if list
      (+ (my-length (cdr list)) 1) 0))

(defun point (x y)
  (cons x y))

(defun point-x (pt)
  (car pt))
(defun point-y (pt)
  (cdr pt))

(defun point-dst (A B)
  (sqrt (+ (expt (- (point-x A) (point-x B)) 2)
           (expt (- (point-y A) (point-y B)) 2))))

;;1
(defun right-triangle-p (A B C)
  (let ((a-length (point-dst B C))
        (b-length (point-dst A C))
        (c-length (point-dst A B))) ;;Stores the lengths of the sides
    (let ((hypo (max a-length b-length c-length)) ;;Max
          (leg-a (max (min a-length b-length) (min (max a-length b-length) c-length))) ;;Mid
          (leg-b (min a-length b-length c-length))) ;;Min
      (= (+ (expt leg-a 2) (expt leg-b 2)) (expt hypo 2)))))

;;2

(defun op-vertex (A B)
  (point (+ (point-x B) (- (point-x B) (point-x A)))
         (+ (point-y B) (- (point-y B) (point-y A)))))

;;3/4

(defun fraction (n d)
  (let ((div (gcd n d)) (neg (if (and (< n 0) (< d 0)) -1 1)))
    (cons (* (/ n div) neg) (* (/ d div) neg))))

(defun numer (frac)
  (car frac))
(defun denom (frac)
  (cdr frac))

(defun frac-+ (x y)
  (fraction (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(defun frac-* (x y)
  (fraction (* (numer x) (numer y))
            (* (denom x) (denom y))))

(defun frac-neg (x)
  (fraction (* (numer x) -1)
            (denom x)))

(defun frac-opp (x)
  (fraction (denom x)
            (numer x)))

(defun frac-- (x y) (frac-+ x (frac-neg y)))

(defun frac-/ (x y) (frac-* x (frac-opp y)))


;;5
(defun interval (l u)
  (cons l u))

(defun lower-bound (interval)
  (car interval))

(defun upper-bound (interval)
  (cdr interval))

(defun number-in-interval-p (n interval)
  (and (>= n (lower-bound interval))
       (<= n (upper-bound interval))))

(defun interval-intersection (a b)
  (let ((l (max (lower-bound a) (lower-bound b)))
        (u (min (upper-bound a) (upper-bound b))))
    (if (< u l) nil (interval l u))))

;;6
;;(let ((end (cons 3 4))) (cons 1 (cons end (cons end 2))))

;;7

(defun proper-list-p (list)
  (cond ((not list) t)
        ((consp list) (proper-list-p (cdr list)))
        (t nil)))

;;8
(defun my-make-list-iter (length elem)
  (my-make-list-internal length elem ()))


(defun my-make-list-internal (length elem prev)
  (if (= length 0)
      prev
    (my-make-list-internal (- length 1) elem (cons elem prev))))
;;9
(defun make-ar-seq-list (start d length)
  (if (= length 0) () (cons start (make-ar-seq-list (+ start d) d (- length 1)))))

;;10
(defun make-ar-seq-list-iter (start d length)
  (make-ar-seq-list-internal (+ start (* d (- length 1))) d length ()))

(defun make-ar-seq-list-internal (end d length prev)
  (if (= length 0) prev
    (make-ar-seq-list-internal (- end d) d (- length 1) (cons end prev))))

;;11

(defun make-geom-seq-list (start q length)
  (if (= length 0) () (cons start (make-geom-seq-list (* start q) q (- length 1)))))

;;12

(defun make-geom-seq-list-iter (start q length)
  (make-geom-seq-list-internal (* start (expt q (- length 1))) q length ()))

(defun make-geom-seq-list-internal (end q length prev)
  (if (= length 0) prev
    (make-geom-seq-list-internal (/ end q) q (- length 1) (cons end prev))))

;;Lecture 6

;;1
(defun last-pair (l)
  (if (consp l)
      (if (cdr l)
          (last-pair (cdr l))
        l)
    nil))

;;2
(defun my-copy-list (orig)
  (cond ((or (eql orig nil) (not (consp orig))) nil)
        (t (cons (car orig) (my-copy-list (cdr orig))))))

;;3
(defun equal-lists-p (a b)
  (or (and (null a) (null b))
      (and (consp a)
           (consp b)
           (eql (car a) (car b))
           (or
            (and
             (not (cdr a))
             (not (cdr b)))
            (equal-lists-p (cdr a) (cdr b))))))

;;4
(defun my-remove (e list)
  (cond ((or (eql list nil) (not (consp list))) nil)
        ((eql e (car list)) (my-remove e (cdr list)))
        (t (cons (car list) (my-remove e (cdr list))))))

;;5

(defun remove-nthcdr (n list)
  (cond ((or (eql list nil) (not (consp list)) (<= n 0)) nil)
        (t (cons (car list) (remove-nthcdr (- n 1) (cdr list))))))


;;6
(defun each-other (list n)
  (cond ((null list) nil)
        ((= n 0) (cons (car list) (each-other (cdr list) 1)))
        (t (each-other (cdr list) 0))))


;;7
;;For non-negative whole numbers only
(defun factorials (n)
  (factorials-internal n 0 0))

(defun factorials-internal (n prev i)
  (cond ((= n i) ())
        ((<= i 0) (cons 1 (factorials-internal n 1 1)))
        (t (cons (* prev i) (factorials-internal n (* prev i) (+ i 1))))))

;;8
(defun fib-list (n)
  (fib-list-internal n 0 0 0))

(defun fib-list-internal (n prev prevprev i)
  (cond ((= n i) ())
        ((= i 0) (cons 1 (fib-list-internal n 1 0 (+ i 1))))
        (t (cons (+ prev prevprev) (fib-list-internal n (+ prev prevprev) prev (+ i 1))))))

;;9
(defun list-tails (list)
  (cond ((or (eql list nil) (not (consp list))) (list nil))
        (t (cons list (list-tails (cdr list))))))

;10

(defun list-sum (list)
   (cond ((or (eql list nil) (not (consp list))) 0)
        (t (+ (car list) (list-sum (cdr list))))))

;;11

(defun my-sum-help (list n len)
  (if (>= n len)
      0
    (+ (my-nth n list) (my-sum-help (+ n 1) len))))
(defun my-sum (list)
  (my-sum-help list 0 (my-length list)))


(defun my-nth (n list)
  (if (= n 0)
      (car list)
    (my-nth (- n 1) (prog1 (cdr list) (write-string "X ")))))

(defun my-length (list)
  (if (eql list nil)
      0
    (+ (my-length (prog1 (cdr list) (write-string "X "))) 1)))

;;The answer is 10 times, after that thrown:  The call (#<Function MY-SUM-HELP 4200008F1C> 1 10) does not match definition (#<Function MY-SUM-HELP 4200008F1C> LIST N LEN).

;12
(defun subtract-lists-2 (a b)
  (cond ((and (null a) (null b)) nil)
        ((or (null a) (null b)) (error "Trying to subtract lists with different lengths!"))
        (t (cons (- (car a) (car b)) (subtract-lists-2 (cdr a) (cdr b))))))
;13
(defun dot-product (a b)
  (dot-product-iter a b 0))

(defun dot-product-iter (a b res)
  (if (null a)
      res
    (dot-product-iter (cdr a) (cdr b) (+ res (* (car a) (car b))))))

;;14

(defun vector-length (a)
  (vector-length-iter a 0))

(defun vector-length-iter (a res)
  (if (null a)
      (sqrt res)
    (vector-length-iter (cdr a) (+ res (expt (car a) 2)))))


;;15

(defun my-remove-duplicates (a)
  (my-remove-duplicates-iter a a))

(defun my-remove-duplicates-iter (a res)
  (if (null a)
      res
    (my-remove-duplicates-iter (cdr a) (my-remove-duplicate (car a) res 0))))

(defun my-remove-duplicate (e list count)
  (cond ((or (eql list nil) (not (consp list))) nil)
        ((eql e (car list)) ( if (> count 0)
                                (my-remove-duplicate e
                                                     (cdr list)
                                                     (+ count 1))
                              (cons (car list) (my-remove-duplicate e
                                                                    (cdr list)
                                                                    (+ count 1)))))
        (t (cons (car list) (my-remove-duplicate e (cdr list) count)))))



;;16
(defun my-union (a b)
  (my-remove-duplicates (append-2 a b)))


(defun append-2 (list1 list2)
  (if (null list1)
      list2
    (cons (car list1)
          (append-2 (cdr list1) list2))))

(defun contains (a e)
  (and (consp a) (not (null a)) (or (eql (car a) e) (contains (cdr a) e))))

;;17
;;(defun equal-sets-p (list1 list2)
  ;;(or (eql list1 list2) (not (or list1 list2)) (and (contains list1 (car list2)) (contains list2 (car list1)) (equal-sets-p (cdr list1) (cdr list2)))))

(defun elementp (x list)
  (and (not (null list))
       (or (eql x (car list))
           (elementp x (cdr list)))))


(defun my-subsetp (list1 list2)
  (if (null list1)
      t
    (and (elementp (car list1) list2)
         (my-subsetp (cdr list1) list2))))

(defun equal-sets-old-p (list1 list2)
  (and (my-subsetp list1 list2) (my-subsetp list2 list1)))

(defun merge-sort (list)
  (let* ((len (length list))
         (len/2 (floor (/ len 2)))
         (list2 (nthcdr len/2 list))
         (list1 (ldiff list list2)))
    (if (<= len 1)
        list
      (merge-lists (merge-sort list1) (merge-sort list2)))))
(defun merge-lists (l1 l2)
  (cond ((null l1) l2)
        ((null l2) l1)
        ((<= (car l1) (car l2))
         (cons (car l1) (merge-lists (cdr l1) l2)))
        (t (cons (car l2) (merge-lists l1 (cdr l2))))))

(defun equal-sets-p (list1 list2)
  (equal-sets-iter-p (merge-sort list1) (merge-sort list2)))

(defun equal-sets-iter-p (list1 list2)
  (or (and (not (or list1 list2))
           (eql list1 list2))
      (and (eql (car list1) (car list2))
           (equal-sets-iter-p (cdr list1) (cdr list2)))))


;;18

(defun contains-sorted-set (lst n)
  (and (not (null lst))
       (not (> (car lst) n))
       (or
        (= (car lst) n)
        (contains-sorted-set (cdr lst) n))
       ))

(defun add-to-set (set n)
  (merge-sort (cons n set)))

;;19

(defun flatten (a)
  (cond ((not a) nil)
        ((consp (car a)) (append-2 (flatten (car a)) (flatten (cdr a))))
        (t (cons (car a) (flatten (cdr a))))
    ))

;;20

(defun deep-reverse (a)
  (deep-reverse-internal a ()))

(defun deep-reverse-internal (a copy)
  (cond ((null a) copy)
        ((proper-list-p (car a)) (deep-reverse-internal (cdr a) (cons (deep-reverse-internal (car a) ()) copy)))
        (t (deep-reverse-internal (cdr a) (cons (car a) copy)))))

;;Lecture 7

(defun binary-tree-node (val left-child right-child)
  (list 'binary-tree val left-child right-child))

(defun left-child (node)
  (caddr node))
(defun right-child (node)
  (cadddr node))

(defun tree-type (node)
  (car node))
(defun treep (node)
  (eql (tree-type node) 'tree))
(defun binary-tree-p (node)
  (eql (tree-type node) 'binary-tree))

(defun bt-node-value (node)
  (cadr node))

(defun my-adjoin (elem tree)
  (if (null tree)
      (binary-tree-node elem nil nil)
    (let ((val (bt-node-value tree))
          (left (left-child tree))
          (right (right-child tree)))
      (cond ((= elem val) tree)
            ((< elem val) (binary-tree-node val
                                            (my-adjoin elem left)
                                            right))
            (t (binary-tree-node val
                                 left
                                 (my-adjoin elem right)))))))

;;1
;;(binary-tree-node 5 (binary-tree-node 2 (binary-tree-node 1 nil nil) (binary-tree-node 3 nil (binary-tree-node 4 nil nil))) (binary-tree-node 7 (binary-tree-node 6 nil nil) (binary-tree-node 8 nil nil)))

;;2
;;(my-adjoin 8 (my-adjoin 6 (my-adjoin 7 (my-adjoin 4 (my-adjoin 3 (my-adjoin 1 (my-adjoin 2 (my-adjoin 5 ()))))))))
;;(my-adjoin 8 (my-adjoin 6 (my-adjoin 7 (my-adjoin 3 (my-adjoin 4 (my-adjoin 1 (my-adjoin 2 (my-adjoin 5 ()))))))))

;;3
(defun list-as-binary-tree (list)
  (cond ((or (null list) (not (consp list))) nil)
        (t (my-adjoin (car list) (list-as-binary-tree (cdr list))))))

;;4
(defun balancedp (tree)
  (cond ((not (consp tree)) nil)
        ((null tree) 0)
        (t (<= (abs (- (tree-height (left-child tree)) (tree-height (right-child tree)))) 1))))

;;5
(defun bt-swap (tree)
  (cond ((or (null tree) (not (consp tree))) nil)
        (t (binary-tree-node (node-value tree) (bt-swap (right-child tree)) (bt-swap (left-child tree))))))

;;6
(defun get-node-by-value (n tree)
  (cond ((or (null tree) (not (consp tree))) nil)
        ((eql (node-value tree) n) tree)
        (t (let ((left (get-node-by-value n (left-child tree))))
          (if (not left) (get-node-by-value n (right-child tree)) left)))))

;;7
(defun tree-sum (tree)
  (cond ((or (null tree) (not (consp tree))) 0)
        ((numberp (car tree)) (+ (car tree) (tree-sum (cdr tree))))
        ((consp (car tree)) (+ (tree-sum (car tree)) (tree-sum (cdr tree))))
        (t (tree-sum (cdr tree)))))

;;8 Ano

;;9

(defun node-children (node)
  (cdr node))

(defun tree-node (val children)
  (cons val children))
(defun node-value (node)
  (car node))

(defun tree-maximal-paths (tree)
  (cond ((or (null tree) (not (consp tree))) tree)
        (t (add-to-all (car tree) (cdr tree) ()))))

(defun add-to-all (e list results)
  (cond ((or (null list) (not (consp list))) results)
        (t (add-to-all e (cdr list) (cons e (car (tree-maximal-paths list)))))))


;;10
(defun tree-height (tree)
  (cond ((or (null tree) (not (consp tree))) 0)
        (t (+ 1 (max (tree-height (left-child tree)) (tree-height (right-child tree)))))))


;;11
;;'(4 // 1 5 9 // / 2 3 1 / 2 11 // / / 3 6)


(defun deserialize-tree (list)
  (cond ((or (null list) (not (consp list))) nil)
        (t ())
        ))

(defun deserialize-branch (list pos)
  (cond ((or (null list) (not (consp list))) nil)
        (t (tree-node (car list) (deserialize-children (get-nth-branch (get-next-layer list) pos) ()))
        )))

(defun deserialize-children (list kinder)
  (cond ((not (has-next-child list)) kinder)
        (t (deserialize-children (cdr list) (cons (deserialize-branch (car list) ) kinder)))))

(defun has-next-child (list)
 (cond ((or (null list) (not (consp list))) nil)
        ((eql (car list) '//) (cdr list))
        ((eql (car list) '/) (cdr list))
        (t t))

(defun get-nth-branch (list n)
  (cond ((or (null list) (not (consp list))) nil)
        ((= n 0) (car list))
        (t (get-nth-branch (cdr list) (- n 1)))))



(defun get-next-layer (list)
  (cond ((or (null list) (not (consp list))) nil)
        ((eql (car list) '//) (cdr list))
        (t (get-next-layer (cdr list)))))

(defun get-next-branch (list)
  (cond ((or (null list) (not (consp list))) nil)
        ((eql (car list) '//) nil) ;;We reeached the end of the current layer
        ((eql (car list) '/) (cdr list))
        (t (get-next-branch (cdr list)))))

(defun get-next-child (list)
  (cond ((or (null list) (not (consp list))) nil)
        ((eql (car list) '//) nil) ;;We reeached the end of the current layer
        ((eql (car list) '/) nil)
        (t (car list)))