hw4snet

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; JACOB GALLUCCI                                                        ;;;
;;; CMPSC 441                                                             ;;;
;;; Dr. Chang                                                             ;;;
;;; [email protected]                                                       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                    CMPSC441 : Artificial Intelligence                 ;;;
;;;                                                                       ;;;
;;;                                                                       ;;;
;;; SEMANTIC NET                                                          ;;;
;;;                                                                       ;;;
;;;   - Startup Code for homework 4                                       ;;;
;;;                                                                       ;;;
;;;   - Note that you don't have use this code                            ;;;
;;;     if you really want to dig in and write your own.                  ;;;
;;;                                                                       ;;;
;;;                                                                       ;;;
;;; Report bugs to [email protected]                                        ;;;
;;;                                                                       ;;;
;;; THANK YOU!                                                            ;;;
;;;                                                                       ;;;
;;;                                                                       ;;;
;;; Sukmoon Chang                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                     PREDICATE CALCULUS FORMULAS  (PART 2)             ;;;
;;; 1. inst(x,y) && inst(y,z) -> inst(x,y)                                ;;;
;;; 2. inst(x,y) && isa(y,z) -> inst(x,z)                                 ;;;
;;; 3. inst(x,y) && haspart(y,z) -> haspart(x,z)                          ;;;
;;; 4. haspart(x,y) && inst(y,z) -> haspart(x,z)                          ;;;
;;; 5. haspart(x,y) && isa(y,z) -> haspart(x,z)                           ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DO NOT MODIFY NEXT LINE
#lang mzscheme





;;;
;;; Database maintaining the semantic net
;;; - procedures set-up-net and process-relation will populate *database*
;;;   in such a way that:
;;;      if we have relations
;;;           (isa helicopter air-vehicle)
;;;           (has-part helicopter propeller)
;;;           (has-part helicopter door)
;;;           (has-part propeller blade)
;;;      then *database* should look like
;;;           ((hellipcopter (isa (air-vehicle))          <-- from relation 1
;;;                          (has-part (propeller door))) <-- from relation 2, 3
;;;            (propeller (has-part (blade))))            <-- from relation 4
;;;


;;
;; Global database
;; - initially empty
;;
(define *database* '())


;;
;; Build a semantic net
;; - The relations are given in a file named file-name
;; - This procedure reads a line at a time as a list from file-name
;;   and builds the database using the procedure process-relation
;; - You need to complete the procedure process-relation below
;;   for this to work
;; - You don't need to modify this procedure
(define set-up-net
  (lambda (file-name)
    (with-input-from-file file-name
      (lambda ()
    (let loop ((in (read)))
      (if (not (eof-object? in))
          (begin
        (process-relation in)
        (loop (read)))))))))

;;
;; Updates *database*
;; - Currently, this procedure simply prints out its argument.
;; - You need to modify it so that it updates *database* using set!
;; - This is the only place you need to use set!
;;   So, do not abuse set! anywhere else.
(define process-relation
  (lambda (rel)
    (cond
      ((null? rel) '())
      ((equal? 'isa (car rel))
       (set! *database* (add-isa rel *database*)))
      ((equal? 'inst (car rel))
       (set! *database* (add-inst rel *database*)))
      ((equal? 'has-part (car rel))
       (set! *database* (add-part rel *database*))))))


;;
;; Checks if element is in Database
(define in-db?
  (lambda (ele db)
    (cond
      ((null? db) #f)
      ((equal? ele (car db)) #t)
      (else (in-db? ele (cdr db))))))
;;
;; Trims DB to just the caar of each element for easier search
;; I'll be honest though, I added this for debugging and
;; I was too lazy to de-integrate out of the program
(define trim-db
  (lambda (db)
    (cond
      ((null? db) '())
      (else (cons (caar db) (trim-db (cdr db)))))))

;;
;; Adds the isa relationship to the database
(define add-isa
  (lambda (rel db)
    (cond
      ((null? db)
       (list (list (cadr rel) (list 'isa (list (caddr rel))))))
      ((not (in-db? (cadr rel) (trim-db db)))
       (append db (list (list (cadr rel) (list 'isa (list (caddr rel)))))))
      ((equal? (caar db) (cadr rel))
       (cond
         ((null? (cadar db))
          (cons (cons (caar db) (list 'isa (list (caddr rel)))) (cdr db)))
         ((equal? (caadar db) 'has-part)
          (cons (cons (caar db) (cons (list 'isa (list (caddr rel))) (cadar db))) (cdr db)))
         (else (cons (cons (caar db) (list (list 'isa (append (cadadar db) (cons (caddr rel) '()))))) (cdr db)))))
      (else (cons (car db) (add-isa rel (cdr db)))))))

;;
;; Adds the has-part relationship to an element of the database
(define add-part
  (lambda (rel db)
    (cond
      ((null? db)
       (list (list (cadr rel) (list 'has-part (list (caddr rel))))))
      ((not (in-db? (cadr rel) (trim-db db)))
       (append db (list (list (cadr rel) (list 'has-part (list (caddr rel)))))))
      ((equal? (caar db) (cadr rel))
       (cond
         ((null? (cadar db))
          (cons (cons (caar db) (list 'has-part (list (caddr rel)))) (cdr db)))
         ((and (or (equal? (caadar db) 'isa) (equal? (caadar db) 'inst)) (null? (cddar db)))
          (cons (append (car db) (list (list 'has-part (list (caddr rel))))) (cdr db)))
         ((equal? (caadar db) 'has-part)
          (cons (cons (caar db) (list (list 'has-part (append (cadadar db) (cons (caddr rel) '()))))) (cdr db)))
         (else (cons (cons (caar db) (cons (cadar db) (list (list 'has-part (append (cadaddar db) (cons (caddr rel) '())))))) (cdr db)))))
      (else (cons (car db) (add-part rel (cdr db)))))))

;;
;; Adds the inst relationship to an element of the database
(define add-inst
  (lambda (rel db)
    (cond
      ((null? db)
       (list (list (cadr rel) list (list 'inst (list (caddr rel))))))
      (else (append db (list (list (cadr rel) (list 'inst (list (caddr rel))))))))))


;;;
;;; Procedures that implement semantic net
;;;


;;
;; Write isa?
;; - Currently, this procedure simply prints out its argument.
(define isa?
  (lambda (x y)
    (cond
      ((equal? x y) #t)
      (else (check-isas (flatten (get-all-isa (get-isa x *database*) *database*)) y)))))

;;
;; get-all-isa - creates a list of all isas recursively (gets the isas of the isas of x)
(define get-all-isa
  (lambda (main-isas db)
    (cond
      ((or (null? main-isas) (null? db)) '())
      (else (cons (car main-isas) (get-all-isa (cdr (append main-isas (get-isa (car main-isas) *database*))) *database*))))))
;;
;; get-isa - gets the list of isas of an x element
(define get-isa
  (lambda (x db)
    (cond
      ((null? db) '())
      ((equal? x (caar db)) (cadadar db))
      (else (get-isa x (cdr db))))))

;;
;; check-isas - returns t / f if element y is in the flattened list returned by get-all-isas
(define check-isas
  (lambda (all-isas y)
    (cond
      ((null? all-isas) #f)
      ((equal? y (car all-isas)) #t)
      (else (check-isas (cdr all-isas) y)))))

;;
;; Write has-part?
;; - Currently, this procedure simply prints out its argument.
;; - For part 2, this procedure should also be able to handle instances
;; has-part? checks if an element x has a part y
(define has-part?
  (lambda (x y)
    (check-parts (flatten (get-all-parts (flatten (get-parts-isas x *database*)) *database*)) y)))


;;
;; get-all-parts
(define get-all-parts
  (lambda (parts-isa db)
    (cond
      ((null? parts-isa) '())
      (else (cons (car parts-isa) (get-all-parts (append (cdr parts-isa) (get-parts (car parts-isa) db)) *database*))))))

;;
;; get-parts - gets the immediate parts of an element
(define get-parts
  (lambda (x db)
    (cond
      ((null? db) '())
      ((equal? x (caar db))
       (cond
         ((equal? (caadar db) 'has-part) (cadadar db))
         ((and (equal? (caadar db) 'isa) (not (null? (cddar db))))
          (cadaddar db))
         (else (cadadar db))))
      (else (get-parts x (cdr db))))))

;;
;; get-parts-isas - gets the main parts of an x and all isas of the element
(define get-parts-isas
  (lambda (x db)
    (cons (get-parts x db) (get-all-isa (get-isa x db) db))))

;;
;; check-parts - checks if a part y is in the list of parts of an element
(define check-parts
  (lambda (parts-lst y)
    (cond
      ((null? parts-lst) #f)
      ((equal? y (car parts-lst)) #t)
      (else (check-parts (cdr parts-lst) y)))))

;;
;; Write parts-of
;; - Currently, this procedure simply prints out its argument.
;; - For part 2, this procedure should be able to handle instances
;; parts-of - returns all the parts of a given x as a list
(define parts-of
  (lambda (x)
    (filter-repeats (filter-all-isas (flatten (get-all-parts (flatten (get-parts-isas x *database*)) *database*))
                     (flatten (get-all-isa (get-isa x *database*) *database*))))))

;;
;; filter-isa - filters an individual isa out of the list - used in filter-all-isas
(define filter-isa
  (lambda (isa parts)
    (cond
      ((null? parts) '())
      ((equal? isa (car parts)) (filter-isa isa (cdr parts)))
      (else (cons (car parts) (filter-isa isa (cdr parts)))))))
;;
;; filter-all-isas - filters all isas in the parts list
(define filter-all-isas
  (lambda (parts isas)
    (cond
      ((null? isas) parts)
      (else (filter-all-isas (filter-isa (car isas) parts) (cdr isas))))))
;;
;; filter-repeats - with how my get-all-parts / get-all-isa functions work, repeats show up in the output, this filters them out
(define filter-repeats
  (lambda (list-of-parts)
    (cond
      ((null? list-of-parts) '())
      (else (cons (car list-of-parts)
                  (filter-repeats (filter-isa (car list-of-parts) (cdr list-of-parts))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions below this point were added purely to make my life easier
;;;


;;
;; cadadar - easily access nested isa's to append
(define cadadar
    (lambda (x)
      (car (cdr (car (cdr (car x)))))))
;;
;; cadaddar - easily access nested has-parts to append
(define cadaddar
  (lambda (x)
    (car (cdr (car (cdr (cdr (car x))))))))

;;
;; flatten - flattens list returned by get-all-isa and get-all-parts
(define flatten
  (lambda (slst)
    (cond
      ((null? slst) '())
      ((list? (car slst)) (append (flatten (car slst))
                                  (flatten (cdr slst))))
      (else (cons (car slst) (flatten (cdr slst)))))))






;;;
;;; PLEASE DO NOT TOUCH BELOW THIS LINE
;;; IT IS FOR GRADING PURPOSE ONLY.
;;;
(set-up-net "snet.data")