;; Solutions and test data for Lisp Assignment

;; test data:
(setq blockA '((color red) (height 2) (width 3) (depth 3))) 
(setq blockB '((color blue) (height 1) (width 2) (depth 3))) 
(setq blockC '((color green) (radius 3))) 
(setq blockX '((color red) (height 2) (width 3) (depth 3)(on X Table)))
(setq blockY '((color blue) (height 1) (width 2) (depth 3) (on Y X)))
(setq world1 (list (list 'A blockA) (list 'B blockB) (list 'C blockC))) 
(setq world2 (list (list 'X blockX) (list 'Y blockY)))

;; helper function
(defun get-block (name world)
 (car (cdr (assoc name world))))


; problem 1 
(defun get-volume (name world) 
       ;; Returns the volume of the block named <name> in <world>, 
       ;;    where volume of non-spherical block is (height*depth*width), and 
       ;;    volume of spherical block is (radius*radius*radius) 
       ;;    (Note: the volume is really 4/3 pi r cubed!)
       ;;    Ex. (get-volume 'A world1) returns 18 
    (let* ((block (get-block name world)) 
           (radius (car (cdr (assoc 'radius block)))) 
           (height (car (cdr (assoc 'height block)))) 
           (width  (car (cdr (assoc 'width block)))) 
           (depth  (car (cdr (assoc 'depth block))))) 
        (cond ((null radius) (* height depth width)) 
              (t (* radius radius radius)))))

;; tests for problem 1
(get-volume 'A world1)  ; return 18 (or 18*4/3*pi)
(get-volume 'C world1)  ; returns 27 (or 27*4/3*pi)

; problem 2 
(defun is-spherical (name world) 
       ;; Returns nil iff the block named <name> in <world> is not spherical. 
       ;; Ex. (is-spherical 'A world1) returns nil 
       ;; Ex. (is-spherical 'C world1) returns nonnil 
    (let ((block (get-block name world))) 
        (assoc 'radius block))) 

;; tests for problem 2
(is-spherical 'A world1) ; returns nil 
(is-spherical 'C world1) ; returns nonnil (t or anything else but nil)


; problem 3 

; first define an auxiliary function, get-area (used in problem 4 too): 
(defun get-area (block) 
    (let* ((depth  (car (cdr (assoc 'depth block)))) 
           (width  (car (cdr (assoc 'width block))))) 
        (if (or (null width)(null depth)) 
            0 
            (* width depth)))) 
  
(defun biggest-cuboid (world) 
       ;; Returns non-spherical block with largest horizontal surface (width * depth) in 
       ;; <world>. 
       ;; Ex. (biggest-cuboid world1) returns 
       ;;       ((color red) (name A) (height 2) (width 3) (depth 3)) 
       ;; Implementation: you must use recursion to implement this! 
    (if (null world) 
        nil 
        (let* ((head (car (cdr (car world)))) 
               (size (get-area head)) 
               (temp (biggest-cuboid (cdr world))) 
               (temp-size (get-area temp))) 
               (if   (> size temp-size) 
                      head 
                      temp)))) 

;; tests for problem 3:
(biggest-cuboid world1) 
       ;; returnns ((color red) (height 2) (width 3) (depth 3)) 

;; problem 4
(defun can-put-on (name1 name2 world) 
      ;; Returns t iff it is safe to put <name1> on <name2> in <world>.  It is safe iff 
      ;; <name1> and <name2> are not spherical and the top of <name2> has an area 
      ;; equal to or greater than the bottom of <name1> and nothing is already on <name2>; 
      ;; or, if <name2> is the Table, then any non-sphere can be put on it. 
      ;; Ex. (can-put-on 'A 'Table world1) returns t 
      ;;       (can-put-on 'A 'C world1) returns nil 
      ;;       (can-put-on 'B 'A world1) returns t 
      ;;       (can-put-on 'A 'B world1) returns nil 
      (cond ((is-spherical name1 world) nil) 
            ((is-spherical name2 world) nil) 
            ((and (equal 'Table name2) 
                  (not (is-spherical name1 world))) t) 
            (t (let* ((b1 (get-block name1 world)) 
                          (b2 (get-block name2 world)) 
                          (bottom (get-area b1)) 
                          (top (get-area b2)) 
                          (is-clear (not (assoc 'on b1)))) 
                  (and (> top bottom) 
                       is-clear)))))

; test for problem 4:
(can-put-on 'A 'Table world1) ; returns nonnil
(can-put-on 'A 'C world1)     ; returns nil 
(can-put-on 'B 'A world1)     ; returns t 
(can-put-on 'A 'B world1)     ; returns nil 
 

; problem 7: number-blocks-in-tower (world) 

; first define auxiliary functions: 
(defun get-block-on (obj world) ; return name of block that <obj> is on 
    (let* ((block  (get-block obj world)) 
           (onlist (assoc 'on block))) 
        (if (null onlist) 
            nil 
            (car (cdr (cdr onlist)))))) ; return 3rd element of (on x y)
; test data:
(get-block-on 'X world2) ;; returns Table
(get-block-on 'Y world2) ;; returns X


(defun get-block-on-me (me world) ; get name of block on me: 2nd element of (on x y)
   (if (null world) 
       nil
       (let* ((block (car (cdr (car world))))
              (on-x-y (assoc 'on block)))
          (cond ((null on-x-y) (get-block-on-me me (cdr world)))
                ((equal me (car (cdr (cdr on-x-y)))) (car (cdr on-x-y)))
	        (t (get-block-on-me me (cdr world)))))))

(defun number-above (obj world) ; Returns number of blocks in tower above obj 
    (let ((above (get-block-on-me obj world))) 
        (if (null above) 
             0 
             (+ 1 (number-above above world))))) 

(defun number-blocks-in-tower (world) 
     ;;  Returns how many blocks in tower in <world>.  You can assume there is no more 
     ;;      than one tower.    If there are no towers, then this returns 0. 
     ;;  Ex.  (number-blocks-in-tower (build-tower world1)) returns 2 
     ;; Implementation: you  must use recursion to implement this! 
     (let ((base (get-block-on-me 'Table world))) 
        (cond ((null base) 0) 
              (t (+ 1 (number-above base world))))))

;; tests for problem 7:
(get-block-on-me 'Table world2) ; returns X
(get-block-on-me 'X world2)     ; returns Y
(number-above 'X world2)        ; returns 1
(number-above 'Y world2)        ; returns 0
(number-blocks-in-tower world2) ; returns 2


; problem 8: height-tower (world) 

; first define the auxiliary functions 
(defun get-height (name world) 
       ;; Returns the height of the block named <name> in <world>, 
       ;;    Ex. (get-height 'A world1) returns 2 
    (let* ((block (get-block name world)) 
           (height (car (cdr (assoc 'height block))))) 
        height)) 

(get-height 'X world2)
(get-height 'A world1)

(defun height-above (obj world) 
    (let* ((above (get-block-on-me obj world))
           (height (get-height above world)))
        (if (null above) 
             0 
             (+ height (height-above above world))))) 

(defun height-tower (world) 
     (let* ((base (get-block-on-me 'Table world))
            (baseht (get-height base world)))
        (cond ((null base) 0) 
              (t (+ baseht (height-above base world))))))

; test for problem 8

(setq blockA '((color red) (height 2) (width 2) (depth 2) (on A B))) 
(setq blockB '((color blue) (height 3) (width 3) (depth 3) (on B C))) 
(setq blockC '((color green) (height 10) (width 10) (depth 10) (on C Table)))
(setq world3 (list (list 'A blockA) (list 'B blockB) (list 'C blockC))) 
(height-tower world3)  ; returns 15