Alok Mehta - Programming in Lisp - Lecture 6 1 66-2210-01 Programming in Lisp Lecture 6 - Structure;...

Alok Mehta - Programming in Lisp - Lecture 6 1

66-2210-01 Programming in Lisp

Lecture 6 - Structure;

Case Study: Blocks World


Structure

Lisp's use of pointers Let you put any value anywhere Details are taken care of by the Lisp interpreter

What goes on "under the hood"? It's useful to know this sometimes Some functions let you get down to low level details of pointers


Shared Structure

Lists can share conses in common> (setf part (list 'b 'c))

(B C)> (setf whole (cons 'a part))

(A B C)> (tailp part whole)

T

A B C

PART

WHOLE


Tailp

Definition of tailp (tailp object list)

– returns T if object is a tail of list

Example implementation> (defun our-tailp (x y) (or (eql x y) (and (consp y) (our-tailp x (cdr y)))))

An object is a tail of itself (base case) NIL is a tail of every proper list

– Recursively take cdr's of the list, until you test for (eql NIL NIL)


Shared Structure

Lists can share structure without either being a tail of the other

> (setf part (list 'b 'c) whole1 (cons 1 part) whole2 (cons 2 part))

1

B C

PARTWHOLE1

2

WHOLE2


Top-Level List Structure

Sometimes want to treat data structure as a list Include only the conses that make up the list Don't recurse into conses that make up elements This is the top-level list structure

Other times, want to treat data structure as a tree All conses are important and treated uniformly

A D

B C


Copy-list vs. Copy-tree

A D

B C

Original

Copy-list

A D

B C

Copy-tree


Copy-list vs. Copy-tree (code)

Example implementation of copy-list> (defun our-copy-list (lst) (if (null lst) nil (cons (car lst) (our-copy-list (cdr lst)))))

Example implementation of copy-tree> (defun our-copy-tree (lst) (if (atom tr) tr (cons (our-copy-tree (car tr)) (our-copy-tree (cdr tr)))))

Lisp handles pointers automatically Then… why do we care? Because some Lisp functions can modify structures


Setf revisited

> (setf whole (list 'a 'b 'c) tail (cdr whole))

(B C)> (setf (second tail) 'e)

E> tail

(B E)> whole

(A B E)

A B C

TAIL

WHOLE


Operators

Avoid modifying lists Operators like setf, pop, rplaca, …

If you need to (or want to) modify a list Make sure it's not shared Or, make sure the shared update works as expected Or, make changes to a copy of the list

> (setf whole (list 'a 'b 'c) tail (cdr whole))

(B C)> (setf tail (cons (first tail) (cons 'e (rest (rest tail)))))

(B C)> tail

(B C)> whole

(A B E)


Parameter passing

Parameters are passed by value The value is copied into the function

If the value is a list… The entire list is not copied The reference to the list is copied A function can permanently alter a list passed in as a

parameter! Similar to parameter passing in Java

Can cause unintentional errors But, can also be useful


Queues

Queue data structure First in, First out Compare to stacks (last in, first out) Stacks are easy in Lisp

– Insert (push) / Retrieve (pop) happen at the same end of the list

Queues are harder– Insert (enqueue) / Retrieve (dequeue) happen at opposite ends

A B C

Q1


Sample implementation

Implementation of Queue (Inefficient)> (defmacro dequeue (q) `(pop ,q))> (defmacro enqueue (o q) `(setf ,q (append ,q (cons ,o nil))))

Implementation of Queue using CLOS (Inefficient)> (defclass queue () ((front :accessor front :initform nil)))> (defmethod dequeue ((q queue)) (pop (front q)))> (defmethod enqueue (o (q queue) &aux (node (cons o

nil))) (setf (front q) (append (front q) node)))

– Example usage> (setf a (make-instance 'queue))> (enqueue 'a a)> (enqueue 'b a)> (dequeue a)


Efficient Queue Implementation

Efficient Implementation of Queue using CLOS> (defclass queue () ((front :accessor front :initform nil) (back :accessor back :initform nil)))> (defmethod enqueue (o (q queue) &aux (node (cons

o nil))) (if (eql (front q) nil) ; first one? (setf (front q) node (back q) node) (progn ; not first time (setf (cdr (back q)) node) (setf (back q) (cdr (back q)))) ))> (defmethod dequeue ((q queue)) (if (eql (cdr (front q)) nil) (setf back nil))

;last one (pop (front q)))


Destructive Functions

Several functions update the lists passed to them Examples

Delete (destructive version of remove)> (setf a '(a b a d a))

(A B A D A)> (remove 'a a) ; Doesn't change A

(B D)> (delete 'a A) ; Changes A

(B D)

Nconc (destructive version of append)> (defun our-nconc (x y) (if (consp x) (progn (setf (cdr (last x)) y) x) y))


Case Study: The Blocks World

Rules There are three kinds of movable objects: bricks, wedges, balls. Robot has one hand. It can grasp any movable block that has

nothing on top of it. Every block is either held by the hand or supported by exactly

one brick or the table. No block can overhang from its support. Although a movable block can be moved to the top of a wedge or

a ball, neither wedges nor balls can support anything. Supporting bricks can support more than one block, as long as

there is room. The table is wide enough for all of the blocks to fit on it at once.


Case Study: The Blocks World

Table

B1

B4

B2

B3W7

W5B6 L8

Several moves are required to put block B1 on block B2 Sample path

Move W7; Move B4; Move B1 onto B2

<=== Robotic Hand


Class Hierarchy

Basic-block

Load-bearing-block Movable-block

Table Brick Wedge Ball

Hand


Class Definitions

Basic-Block> (defclass basic-block() ((name :accessor block-name :initarg :name) (width :accessor block-width :initarg :width) (height :accessor block-height :initarg :height) (position :accessor block-position :initarg :position) (supported-by :accessor block-supported-by :initform nil)))

Supported-by => What the block is supported by (what's underneath it)

Movable-block> (defclass movable-block (basic-block) ())

Load-bearing-block Has new field

> (defclass load-bearing-block (basic-block) ((support-for :accessor block-support-for :initform nil)))

Support-for => What the block is a support for (what's on top of it)


Class Definitions (cont.)

Brick, wedge, ball, table> (defclass brick (movable-block load-bearing-

block) ())> (defclass wedge (movable-block) ())> (defclass ball (movable-block) ())

Table> (defclass table (load-bearing-block) ())

Robotic Hand> (defclass hand () ((name :accessor hand-name :initarg :name) (position :accessor hand-

position :initarg :position) (grasping :accessor hand-grasping :initform

nil)))


Creating Blocks in Blocks World(defvar *blocks* (list (make-instance 'table :name 'table :width 20 :height 0 :position '(0 0)) (make-instance 'brick :name 'b1 :width 2 :height 2 :position '(0 0)) (make-instance 'brick :name 'b2 :width 2 :height 2 :position '(2 0)) (make-instance 'brick :name 'b3 :width 4 :height 4 :position '(4 0)) (make-instance 'brick :name 'b4 :width 2 :height 2 :position '(8 0)) (make-instance 'wedge :name 'w5 :width 2 :height 4 :position '(10 0)) (make-instance 'brick :name 'b6 :width 4 :height 2 :position '(12 0)) (make-instance 'wedge :name 'w7 :width 2 :height 2 :position '(16 0)) (make-instance 'ball :name 'L8 :width 2 :height 2 :position '(18 0))))(defvar *hand* (make-instance 'hand :name '*hand* :position '(0 6)))

Table

B1 B4B2

B3

W7W5 B6 L8


Initializing Blocks World

Create other global variables for convenience> (dolist (l *blocks*) (set (block-name l) l))

This sets the global variables TABLE, B1, B2, … W7, L8 to their respective block

All blocks rest on the table initially> (dolist (l (rest *blocks*)) ; For each, except

table (setf (block-supported-by l) table) (push l (block-support-for table)))

Load-bearing-block has a method block-support-for This was automatically generated Create a dummy stub for this method in basic-block

> (defmethod block-support-for ((object basic-block)) nil)

By default, basic-blocks do not have anything on top of them. Only Load-bearing-blocks may have something on top of them.


Block-Support-For

Basic-block Block-Support-For

Load-bearing-block Block-Support-For

Movable-block

Table Brick Wedge Ball

Hand

Returns Nil

Returns value of Slot

Support-For


Put-On

Want a method, PUT-ON, that places one object on another Get space for the object (may have to move things around) Grasp object (may have to remove things on top of the object) Move object Ungrasp object

Basic Prototype> (defmethod put-on ((object movable-block) (support basic-block)) … )


Put-On

Implementation> (defmethod put-on ((object movable-block) (support basic-block)) (if (get-space object support) (and (grasp object) (move object support) (ungrasp object)) (format t "~&Couldn't get space to put ~a on

~a." (block-name object) (block-name support))))

get-space, grasp, move, ungrasp have yet to be defined

Get-space either finds space or makes space > (defmethod get-space ((object movable-block) (support basic-block)) (or (find-space object support) (make-space object support)))

find-space, make-space have yet to be defined (do this later)


Grasp

GraspPuts desired object in robot's hand> (defmethod grasp ((object movable-block)) (unless (eq (hand-grasping *hand*) object) ; already holding? ; Make sure nothing else is on top of object (when (block-support-for object) (clear-top object)) ; Make sure robot isn't holding anything else (when (hand-grasping *hand*) (get-rid-of (hand-grasping *hand*))) (format t "~&Move hand to pick up ~a at location ~a." (block-name object) (top-location object)) (setf (hand-position *hand*) (top-location object)) (format t "~&Grasp ~a." (block-name object)) (setf (hand-grasping *hand*) object)) t)

Need to define: Clear-top, top-locationFunction returns T if successful


Ungrasp

Ungrasp Releases object, if object is being supported by something else

> (defmethod ungrasp ((object movable-block)) (when (block-supported-by object) (format t "~&Ungrasping ~a" (block-name

object)) (setf (hand-grasping *hand*) nil) T))

Get-rid-of puts object on the table (out of the way)

> (defmethod get-rid-of ((object movable-block)) (put-on object table))


Make-space

Clear-top Gets rid of everything on top of an object

> (defmethod clear-top ((support load-bearing-block)) (dolist (obstacle (block-support-for support) t) (get-rid-of obstacle)))

Make-space Clears away just enough room to put block

– Algorithm keeps getting rid of things on top of block– Until the find-space function returns that there is enough space available

> (defmethod make-space ((object movable-block) (support basic-block)) (dolist (obstruction (block-support-for support)) (get-rid-of obstruction) (let ((space (find-space object support))) (when space (return space)))))


Move

Moves an object on top of a support> (defmethod move ((object movable-block) (support basic-block)) (remove-support object) (let ((newplace (get-space object support))) (format t "~&Move ~a to top of ~a at location ~a." (block-name object) (block-name support) newplace) (setf (block-position object) newplace) (setf (hand-position *hand*) (top-location object))) (add-support object support) t)

Calls remove-support, add-support– These are methods for bookkeeping– They maintain the bi-directional links (support-for, supported-by)– Remove-support removes the bi-directional links of an object– Add-support adds bi-directional links for an object that is to be placed on top of

a support


Remove-support

Remove-support This is a bookkeeping method that removes bi-directional links

> (defmethod remove-support ((object movable-block)) (let ((support (block-supported-by object))) (when support (setf (block-support-for support) (remove object (block-support-for

support))) (setf (block-supported-by object) nil) t)))


Add-support

Adding support, for general case This is just a stub (does no operation) Can't really put an object on top of any basic-block

> (defmethod add-support ((object movable-block) (support basic-block)) t)

Adding support, for specific cases For load-bearing blocks, we can put an object on top Bookkeeping needed for this is to update bi-directional pointers

> (defmethod add-support ((object movable-block) (support load-bearing-

block)) (push object (block-support-for support)) (setf (block-supported-by object support)))


Top-location

Returns the location of the top (center) of a block Example Usage

> (block-position b3)(4 0) <-- Lower left position of block

> (block-width b3)4

> (block-height b3)4

> (top-location b3)(6 4) <-- X = Pos.X + (width/2.0); Y = Pos.Y

Implementation> (defmethod top-location ((object basic-block)) (list (+ (first (block-position object)) (/ (block-width object) 2)) (+ (second (block-position object)) (block-height object))))


Find-space

Find-space Basic algorithm

– For each possible location on top of support that the object can be placed,– Is the position occupied? If not, we've found the space; else continue

> (defmethod find-space ((object basic-block) (support basic-block)) (dotimes (offset (+ 1 (- (block-width support) (block-width object)))) (unless (intersections-p object offset (first (block-position support)) (block-support-for support)) (return (list (+ offset (first (block-position

support))) (+ (second (block-position support)) (block-height support)))))))

Intersections-p is to be defined next

B6

B4

B6

B4


Intersections-p

Intersections-p Checks for intersections (only checks the X dimension)

> (defun intersections-p (object offset base obstacles) (dolist (obstacle obstacles) (let* ((ls_proposed (+ offset base)) (rs_proposed (+ ls_proposed (block-width

object))) (ls_obstacle (first (block-position

obstacle))) (rs_obstacle (+ ls_obstacle (block-width

obstacle)))) (unless (or (>= ls_proposed rs_obstacle) (<= rs_Proposed ls_obstacle)) (return t)))))Obstacle

ProposedObject

Location


Blocks World Usage

Sample usage of blocks world> (put-on b4 b1)> (put-on w7 b2)> (put-on b1 b2)


Final Exam

Next time Open book, open notes No calculators, computers, etc.

No lisp interpreter!

Mostly programming type questions Write a program to …

Exam may contain material from Chapters 1-12, plus case studies: Expert Systems, Blocks World Anything from lecture notes

Alok Mehta - Programming in Lisp - Lecture 6 1 66-2210-01 Programming in Lisp Lecture 6 - Structure;...

Documents

Transcript of Alok Mehta - Programming in Lisp - Lecture 6 1 66-2210-01 Programming in Lisp Lecture 6 - Structure;...