ARTIFICIAL INTELLIGENCE

UPTU/GBTU/MMTU practical files

PRACTICAL-1

Evaluate the following Lisp Expression:

1.(Reverse '(a(bc)(de))).  

((de)(bc)a)

2.  (great rp 18,151,76)

151

3. (+(/10 5) 50)

52

PRACTICAL- 2

Write a program in LISP to convert centigrate temperature  to fahrenhiet

(defun C-to-F()

(terpri)

(princ "please enter the centigrate temperature")

(setq((read))

(princ" The Fahrenheit temperature is ")

(princ(+(*/95)C)32)

(terpri))

PRACTICAL- 3

Write a function in LISP that reads a natural number n & returns n!.

:(DEFINE (FACTORIAL (LAMBDA (N)

:   (COND

:   ((EQUAL N 0) 1)

:   (T (MULT N (FACTORIAL (SUB N 1))))

:   ))))

PRACTICAL- 4

BEST FIRST SEARCH

;;; Best-First Search (Forward-Looking version).

;;; It uses an evaluation function based on the ordering of cities

;;; with respect to longitude. The method does not take into

;;; consideration the length of each partial path found so far.

;;; Thus it considers only the "remaining distance" to the goal

;;; in deciding how to order nodes on OPEN.  Hence it is

;;; "forward-looking".

;;; Here is the adjacency data (identical to that used

;;; in DEPTHFS.CL and BREADTH.CL):

;;; Create the hash table ADJACENCY-INFO to store the French

;;; roads data, and define the functions for entering and

;;; retrieving this info.

;;; The second hash table, PATH-PREDECESSOR-INFO, is used

;;; during the search to allow the eventual tracing of

;;; the path back from the goal to the starting node.

(let ((adjacency-info (make-hash-table :size 20))

      (path-predecessor-info (make-hash-table :size 20)) )

  (defun set-adj (x y)

    (setf (gethash x adjacency-info) y) )

  (defun get-adj (x)

    (gethash x adjacency-info) )

  (defun set-predecessor (x y)

    (setf (gethash x path-predecessor-info) y) )

  (defun get-predecessor (x)

    (gethash x path-predecessor-info) )

 )

;;; Establish BREST's list of neighbors as (RENNES), etc.

(set-adj 'brest '(rennes))

(set-adj 'rennes '(caen paris brest nantes))

(set-adj 'caen '(calais paris rennes))

(set-adj 'calais '(nancy paris caen))

(set-adj 'nancy '(strasbourg dijon paris calais))

(set-adj 'strasbourg '(dijon nancy))

(set-adj 'dijon '(strasbourg lyon paris nancy))

(set-adj 'lyon '(grenoble avignon limoges dijon))

(set-adj 'grenoble '(avignon lyon))

(set-adj 'avignon '(grenoble marseille montpellier lyon))

(set-adj 'marseille '(nice avignon))

(set-adj 'nice '(marseille))

(set-adj 'montpellier '(avignon toulouse))

(set-adj 'toulouse '(montpellier bordeaux limoges))

(set-adj 'bordeaux '(limoges toulouse nantes))

(set-adj 'limoges '(lyon toulouse bordeaux nantes paris))

(set-adj 'nantes '(limoges bordeaux rennes))

(set-adj 'paris '(calais nancy dijon limoges rennes caen))

;;; Now we create a new hash table LONGITUDE-INFO to

;;; support the heuristic ordering mechanism.

(let ((longitude-info (make-hash-table :size 20)))

  (defun set-longitude (x y)

    (setf (gethash x longitude-info) y) )

  (defun get-longitude (x)

    (gethash x longitude-info) )

 )

;;; The longitude of each city is stored in tenths of a degree.

;;; We use a local function with a LAMBDA form, since

;;; SET-LONGITUDE takes two arguments but we want a

;;; function that takes one argument for this use with MAPCAR.

(mapcar #'(lambda (pair) (apply #'set-longitude pair))

          '((avignon 48)(bordeaux -6)(brest -45)(caen -4)

            (calais 18)(dijon 51)(grenoble 57)(limoges 12)

            (lyon 48)(marseille 53)(montpellier 36)

            (nantes -16)(nancy 62)(nice 73)(paris 23)

            (rennes -17)(strasbourg 77)(toulouse 14) ) )

;;; We need one more hash table F-VALUE to

;;; remember the heuristic value at each node visited.

(let ((f-values (make-hash-table :size 20)))

  (defun set-f-value (x y)

    (setf (gethash x f-values) y) )

  (defun get-f-value (x)

    (gethash x f-values) )

 )

;;; BEST-FIRST-SEARCH is the main searching procedure.

(defun best-first-search (start-node goal-node)

  "Performs a best-first search from START-NODE for GOAL-NODE."

  (set-goal goal-node)

  (let ((open (list start-node))                ;step1

        (closed nil)

        n l val)

    (set-predecessor start-node nil)

    (set-f-value start-node (f start-node))

    (loop

      (if (null open)(return 'failure))         ;step2

      (setf n (select-best open))               ;step3

      (setf open (remove n open))               ;step4

      (push n closed)

      (if (eql n (get-goal))                    ;step5

          (return (extract-path n)) )

      (setf l (successors n))                   ;step6

      (setf l (list-difference l closed))

      (dolist (j (intersection l open))         ;step7

              (if (< (setf val (f j))

                     (get-f-value j) )

                  (progn

                    (set-f-value j val)

                    (setf open

 (insert j

 (remove j open)

  open

  val) ) ) ) )

      (dolist (j (list-difference l (append open closed)))

              ;; open the node J:

              (increment-count)

              (set-f-value j (setf val (f j)))

              (setf open (insert j open val))

              (set-predecessor j n) )

      ; end of loop -------- this is implicitly  step8

       ) ) )

;; The supporting functions:

;;; Use local variable to keep track of the goal.

(let (goal)

  (defun set-goal (the-goal) (setf goal the-goal))

  (defun get-goal () goal) )

;;; EXTRACT-PATH returns the sequence of cities found.

(defun extract-path (n)

  "Returns the path to N."

  (cond ((null n) nil)

        (t (append (extract-path (get-predecessor n))

                   (list n) )) ) )

;;; SUCCESSORS retrieves the list of cities adjacent

;;; to N from N's property list.

(defun successors (n)

  "Returns the list of nodes adjacent to N."

  (get-adj n) )

;;; LIST-DIFFERENCE is like the built-in Lisp function

;;; named SET-DIFFERENCE but it preserves the ordering in LST1"

(defun list-difference (lst1 lst2)

  "Returns a list of those elements of LST1 that do not

   occur on LST2."

  (dolist (elt lst2 lst1)

    (setf lst1 (remove elt lst1)) ) )

;;; LONGITUDE-DIFF returns the absolute value of the

;;; difference in longitudes between nodes N1 and N2

;;; in tenths of a degree.

(defun longitude-diff (n1 n2)

  "Computes difference in longitudes."

  (abs (- (get-longitude n1) (get-longitude n2))) )

;;; F evaluates the difference in longitude between

;;; the current node N and the goal node.

(defun f (n)

  "Return diff. in longitude from goal node."

  (longitude-diff n (get-goal)) )

;;; SELECT-BEST chooses a node in step 3...

(defun select-best (lst)

  "Determines the best node to open next."

  (cond ((eql (first lst) (get-goal))(first lst))

        (t (better (first lst)(rest lst))) ) )

;;; The helping function BETTER for select-best checks

;;; to see if there is a goal node on LST with FVALUE

;;; as low as that of ELT.

(defun better (elt lst)

  "Helping function for SELECT-BEST."

  (cond ((null lst) elt)

        ((< (get-f-value elt)(get-f-value (first lst)))

         elt)

        ((eql (first lst) (get-goal))

         (first lst) )

        (t (better elt (rest lst))) ) )

;;; INSERT puts NODE onto LST, which is ordered

;;; by FVALUE property, where VAL is the FVALUE

;;; of NODE.

(defun insert (node lst val)

  "Puts NODE into its proper place on LST."

  (cond ((null lst)(list node))

        ((< val (get-f-value (first lst)))

         (cons node lst))

        (t (cons (first lst)(insert node (rest lst) val))) ) )

;;; Use a local variable EXPANSION-COUNT for counting the

;;; number of nodes expanded by the algorithm.

(let (expansion-count)

  (defun initialize-count () (setf expansion-count 1))

  (defun increment-count () (incf expansion-count))

  (defun get-count () expansion-count) )

;;; TEST sets EXPANSION-COUNT to 0 and

;;; begins a search from RENNES to AVIGNON.

(defun test ()

  "Tests the function BEST-FIRST-SEARCH."

  (initialize-count)

  (format t "Best-first-search solution: ~s.~%"

    (best-first-search 'rennes 'avignon) )

  (format t "~s nodes expanded.~%"

    (get-count) )

  )

(test)

PRACTICAL- 5

BREADTH-FIRST SEARCH

;;; The graph to be searched represents roads in France.

;;; Create a hash table ADJACENCY-INFO to store the French

;;; roads data, and define the functions for entering and

;;; retrieving this info.

;;; A second hash table, PATH-PREDECESSOR-INFO, is used

;;; during the search to allow the eventual tracing of

;;; the path back from the goal to the starting node.

(let ((adjacency-info (make-hash-table :size 20))

      (path-predecessor-info (make-hash-table :size 20)) )

  (defun set-adj (x y)

    (setf (gethash x adjacency-info) y) )

  (defun get-adj (x)

    (gethash x adjacency-info) )

  (defun set-predecessor (x y)

    (setf (gethash x path-predecessor-info) y) )

  (defun get-predecessor (x)

    (gethash x path-predecessor-info) )

 )

;;; Establish BREST's list of neighbors as (RENNES), etc.

(set-adj 'brest '(rennes))

(set-adj 'rennes '(caen paris brest nantes))

(set-adj 'caen '(calais paris rennes))

(set-adj 'calais '(nancy paris caen))

(set-adj 'nancy '(strasbourg dijon paris calais))

(set-adj 'strasbourg '(dijon nancy))

(set-adj 'dijon '(strasbourg lyon paris nancy))

(set-adj 'lyon '(grenoble avignon limoges dijon))

(set-adj 'grenoble '(avignon lyon))

(set-adj 'avignon '(grenoble marseille montpellier lyon))

(set-adj 'marseille '(nice avignon))

(set-adj 'nice '(marseille))

(set-adj 'montpellier '(avignon toulouse))

(set-adj 'toulouse '(montpellier bordeaux limoges))

(set-adj 'bordeaux '(limoges toulouse nantes))

(set-adj 'limoges '(lyon toulouse bordeaux nantes paris))

(set-adj 'nantes '(limoges bordeaux rennes))

(set-adj 'paris '(calais nancy dijon limoges rennes caen))

;;; BREADTH-FIRST-SEARCH is the main searching procedure.

(defun breadth-first-search (start-node goal-node)

  "Performs a breadth-first search from START-NODE for GOAL-NODE."

  (let ((open (list start-node))                ;step1

        (closed nil)

        n l)

    (set-predecessor start-node nil)

    (loop

      (if (null open)(return 'failure))         ;step2

      (setf n (pop open))                       ;step3

      (push n closed)

      (increment-count)

      (if (eql n goal-node)

          (return (extract-path n)) )

      (setf l (successors n))                   ;step4

      (setf l (list-difference l (append open closed)))

      (setf open (append open l) )              ;step5

      (dolist (x l)

              (set-predecessor x n) )

      ; end of loop -------- this is implicitly  step6

       ) ) )

;; The supporting functions:

;;; EXTRACT-PATH returns the sequence of cities found.

(defun extract-path (n)

  "Returns the path to N."

  (cond ((null n) nil)

        (t (append (extract-path (get-predecessor n))

                   (list n) )) ) )

;;; SUCCESSORS retrieves the list of cities adjacent

;;; to N from N's property list.

(defun successors (n)

  "Returns a list of the nodes adjacent to N."

  (get-adj n) )

;;; LIST-DIFFERENCE is like the built-in Lisp function

;;; named SET-DIFFERENCE but it preserves the ordering in LST1"

(defun list-difference (lst1 lst2)

  "Returns a list of those elements of LST1 that do not

   occur on LST2."

  (dolist (elt lst2 lst1)

    (setf lst1 (remove elt lst1)) ) )

;;; Use a local variable EXPANSION-COUNT for counting the

;;; number of nodes expanded by the algorithm.

(let (expansion-count)

  (defun initialize-count () (setf expansion-count 0))

  (defun increment-count () (incf expansion-count))

  (defun get-count () expansion-count) )

;;; TEST sets EXPANSION-COUNT to 0 and

;;; begins a search from RENNES to AVIGNON.

(defun test ()

  "Tests the function BREADTH-FIRST-SEARCH."

  (initialize-count)

  (format t "Breadth-first-search solution: ~s.~%"

    (breadth-first-search 'rennes 'avignon) )

  (format t "~s nodes expanded.~%"

    (get-count) )

  )

(test)

PRACTICAL- 6

DEPTH-FIRST SEARCH

;;; the graph to be searched represents roads in France.

;;; Create a hash table ADJACENCY-INFO to store the French

;;; roads data, and define the functions for entering and

;;; retrieving this info.

;;; A second hash table, PATH-PREDECESSOR-INFO, is used

;;; during the search to allow the eventual tracing of

;;; the path back from the goal to the starting node.

(let ((adjacency-info (make-hash-table :size 20))

      (path-predecessor-info (make-hash-table :size 20)) )

  (defun set-adj (x y)

    (setf (gethash x adjacency-info) y) )

  (defun get-adj (x)

    (gethash x adjacency-info) )

  (defun set-predecessor (x y)

    (setf (gethash x path-predecessor-info) y) )

  (defun get-predecessor (x)

    (gethash x path-predecessor-info) )

 )

;;; Establish BREST's list of neighbors as (RENNES), etc.

(set-adj 'brest '(rennes))

(set-adj 'rennes '(caen paris brest nantes))

(set-adj 'caen '(calais paris rennes))

(set-adj 'calais '(nancy paris caen))

(set-adj 'nancy '(strasbourg dijon paris calais))

(set-adj 'strasbourg '(dijon nancy))

(set-adj 'dijon '(strasbourg lyon paris nancy))

(set-adj 'lyon '(grenoble avignon limoges dijon))

(set-adj 'grenoble '(avignon lyon))

(set-adj 'avignon '(grenoble marseille montpellier lyon))

(set-adj 'marseille '(nice avignon))

(set-adj 'nice '(marseille))

(set-adj 'montpellier '(avignon toulouse))

(set-adj 'toulouse '(montpellier bordeaux limoges))

(set-adj 'bordeaux '(limoges toulouse nantes))

(set-adj 'limoges '(lyon toulouse bordeaux nantes paris))

(set-adj 'nantes '(limoges bordeaux rennes))

(set-adj 'paris '(calais nancy dijon limoges rennes caen))

;;; DEPTH-FIRST-SEARCH is the main searching procedure.

;;; Note that we use Common Lisp macros PUSH and POP to simplify

;;; adding and removing elements at the front of lists.

(defun depth-first-graph-search (start-node goal-node)

  "Performs a depth-first search from START-NODE for GOAL-NODE."

  (let ((open (list start-node))                ;step1

        (closed nil)

        n l)

    (loop

      (if (null open)(return 'failure))         ;step2

      (setf n (pop open))                       ;step3

      (push n closed)

      (increment-count)

      (if (eql n goal-node)

          (return (extract-path n)) )

      (setf l (successors n))                   ;step4

      (setf l (list-difference l closed))

      (setf open

            (append l (list-difference open l)));step5

      (dolist (x l)

              (set-predecessor x n) )

      ; end of loop -------- this is implicitly  step6

       ) ) )

;; The supporting functions:

;;; EXTRACT-PATH returns the sequence of cities found.

(defun extract-path (n)

  "Returns the path leading to N."

  (cond ((null n) nil)

        (t (append (extract-path (get-predecessor n))

                   (list n) )) ) )

;;; SUCCESSORS retrieves the list of cities adjacent

;;; to N from N's property list.

(defun successors (n)

  "Returns a list of nodes adjacent to N."

  (get-adj n) )

;;; LIST-DIFFERENCE is like the built-in Lisp function

;;; named SET-DIFFERENCE but it preserves the ordering in LST1"

(defun list-difference (lst1 lst2)

  "Returns a list of those elements of LST1 that do not

   occur on LST2."

  (dolist (elt lst2 lst1)

    (setf lst1 (remove elt lst1)) ) )

;;; Use a local variable EXPANSION-COUNT for counting

;;; the number of nodes expanded by the algorithm.

(let (expansion-count)

  (defun initialize-count () (setf expansion-count 0))

  (defun increment-count () (incf expansion-count))

  (defun get-count () expansion-count) )

;;; TEST sets the count of nodes expanded to 0 and

;;; begins a search from RENNES to AVIGNON.

(defun test ()

  "Tests the function DEPTH-FIRST-SEARCH."

  (initialize-count)

  (format t "Depth-first-search solution: ~s.~%"

    (depth-first-graph-search 'rennes 'avignon) )

  (format t "~s nodes expanded.~%"

    (get-count))

  )

(test)

PRACTICAL- 7

Write PROLOG expression which represents the semantic net for the following:-

          Company XYZ is Software Development Company. Three departments within the company are Sales, Administration & Programming. Neeraj is the manager of Programming. Ramesh & Dolly are the programmers. She is married to Sonu. Sonu is the editor of TMH. They have three children & they live on deokali. She wears glasses & is 5 feet tall.   

Company (XYZ,software_development)

Department(XYZ,[sales,administration Programming])

Manager(Neeraj,Programming)

Programmer(Ramesh,Dolly)

Married(Dolly,Sonu)

Editor(sonu,Tata Mcgraw Hill)

Parent([Dolly,Sonu],three children)

Lived([Dolly,Sonu],Deokali)

Wears(Dolly,glasses)

Tall(Dolly, five-feet)

PRACTICAL- 8

Write PROLOG program to solve Monkey Banana Problem.

% Constants:

% {floor,chair,bananas,monkey}

%Variables:

%{X,Y,Z}

%Predicates:

%{can-reach(X,Y)  ;X can reach Y

%dexterous(X); X is a dexterous animal

% close(X,Y) ; Xis close to Y

% get-on(X,Y) ; X can get on Y

% under(X,Y) ; X is under Y

% tall(X) ;X is tall

%in-room(X); X is in the room

%can-move(X,Y,Z) ; X can move Y near Z

% cam climb (X,Y)} ; X can climb onto Y

% Axioms :

in -room(bananas).

in-room(chair).

in-room(monkey).

dexterous(monkey).

tall(chair).

can-move(monkey, chair, bananas).

can-climb(money, char).

Can-reach(X,Y):-

dexterious(X),close(X,Y).

close(X,Y):-

get-on(X,Y).

under(Y,Z).

tall(Y).

get-on(X,Y):-

can-climb(X,Y).

Under(Y,Z):-

in-room(X),

in-room(Y),

in-room(Z),

can-move(X,Y,Z).