66221001 Programming in Lisp

1
66-2210-01 Programming in Lisp

• Lecture 6 - Structure
• Case Study Blocks World

2
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

3
Shared Structure

• Lists can share conses in common
• gt (setf part (list 'b 'c))
• (B C)
• gt (setf whole (cons 'a part))
• (A B C)
• gt (tailp part whole)
• T

PART
WHOLE
A
B
C
4
Tailp

• Definition of tailp
• (tailp object list)
• returns T if object is a tail of list
• Example implementation
• gt (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)

5
Shared Structure

• Lists can share structure without either being a
  tail of the other
• gt (setf part (list 'b 'c)
• whole1 (cons 1 part)
• whole2 (cons 2 part))

PART
WHOLE1
1
B
C
WHOLE2
2
6
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
7
Copy-list vs. Copy-tree
Original
A
D
B
C
Copy-list
Copy-tree
A
D
B
C
8
Copy-list vs. Copy-tree (code)

• Example implementation of copy-list
• gt (defun our-copy-list (lst)
• (if (null lst)
• nil
• (cons (car lst) (our-copy-list (cdr
  lst)))))
• Example implementation of copy-tree
• gt (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

9
Setf revisited

• gt (setf whole (list 'a 'b 'c)
• tail (cdr whole))
• (B C)
• gt (setf (second tail) 'e)
• E
• gt tail
• (B E)
• gt whole
• (A B E)

TAIL
WHOLE
A
B
C
10
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
• gt (setf whole (list 'a 'b 'c)
• tail (cdr whole))
• (B C)
• gt (setf tail (cons (first tail)
• (cons 'e (rest (rest tail)))))
• (B C)
• gt tail
• (B C)
• gt whole
• (A B E)

11
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

12
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

Q1
A
B
C
13
Sample implementation

• Implementation of Queue (Inefficient)
• gt (defmacro dequeue (q) (pop ,q))
• gt (defmacro enqueue (o q)
• (setf ,q (append ,q (cons ,o nil))))
• Implementation of Queue using CLOS (Inefficient)
• gt (defclass queue ()
• ((front accessor front initform nil)))
• gt (defmethod dequeue ((q queue))
• (pop (front q)))
• gt (defmethod enqueue (o (q queue) aux (node
  (cons o nil)))
• (setf (front q) (append (front q) node)))
• Example usage
• gt (setf a (make-instance 'queue))
• gt (enqueue 'a a)
• gt (enqueue 'b a)
• gt (dequeue a)

14
Efficient Queue Implementation

• Efficient Implementation of Queue using CLOS
• gt (defclass queue ()
• ((front accessor front initform nil)
• (back accessor back initform nil)))
• gt (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))))
• ))
• gt (defmethod dequeue ((q queue))
• (if (eql (cdr (front q)) nil) (setf back
  nil)) last one
• (pop (front q)))

15
Destructive Functions

• Several functions update the lists passed to them
• Examples
• Delete (destructive version of remove)
• gt (setf a '(a b a d a))
• (A B A D A)
• gt (remove 'a a) Doesn't change A
• (B D)
• gt (delete 'a A) Changes A
• (B D)
• Nconc (destructive version of append)
• gt (defun our-nconc (x y)
• (if (consp x)
• (progn
• (setf (cdr (last x)) y)
• x)
• y))

16
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.

17
Case Study The Blocks World

• Several moves are required to put block B1 on
  block B2
• Sample path
• Move W7 Move B4 Move B1 onto B2

P lt Robotic Hand
W5
W7
B4
B3
B1
B2
B6
L8
Table
18
Class Hierarchy
Basic-block
Hand
Load-bearing-block
Movable-block
Table
Brick
Wedge
Ball
19
Class Definitions

• Basic-Block
• gt (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 gt What the block is supported by
  (what's underneath it)
• Movable-block
• gt (defclass movable-block (basic-block) ())
• Load-bearing-block
• Has new field
• gt (defclass load-bearing-block (basic-block)
• ((support-for accessor block-support-for
• initform nil)))
• Support-for gt What the block is a support for
  (what's on top of it)

20
Class Definitions (cont.)

• Brick, wedge, ball, table
• gt (defclass brick (movable-block
  load-bearing-block) ())
• gt (defclass wedge (movable-block) ())
• gt (defclass ball (movable-block) ())
• Table
• gt (defclass table (load-bearing-block) ())
• Robotic Hand
• gt (defclass hand ()
• ((name accessor hand-name initarg name)
• (position accessor hand-position initarg
  position)
• (grasping accessor hand-grasping initform
  nil)))

21
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)))

P
B3
W5
W7
B1
B4
B2
B6
L8
Table
22
Initializing Blocks World

• Create other global variables for convenience
• gt (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
• gt (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
• gt (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.

23
Block-Support-For
Returns Nil
Basic-block Block-Support-For
Hand
Returns value of Slot Support-For
Load-bearing-block Block-Support-For
Movable-block
Table
Brick
Wedge
Ball
24
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
• gt (defmethod put-on ((object movable-block)
• (support basic-block))
• )

25
Put-On

• Implementation
• gt (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
• gt (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)

26
Grasp

• Grasp
• Puts desired object in robot's hand
• gt (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-location
• Function returns T if successful

27
Ungrasp

• Ungrasp
• Releases object, if object is being supported by
  something else
• gt (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)
• gt (defmethod get-rid-of ((object movable-block))
• (put-on object table))

28
Make-space

• Clear-top
• Gets rid of everything on top of an object
• gt (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
• gt (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)))))

29
Move

• Moves an object on top of a support
• gt (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

30
Remove-support

• Remove-support
• This is a bookkeeping method that removes
  bi-directional links
• gt (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)))

31
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
• gt (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
• gt (defmethod add-support ((object movable-block)
• (support
  load-bearing-block))
• (push object (block-support-for support))
• (setf (block-supported-by object support)))

32
Top-location

• Returns the location of the top (center) of a
  block
• Example Usage
• gt (block-position b3)
• (4 0) lt-- Lower left position of
  block
• gt (block-width b3)
• 4
• gt (block-height b3)
• 4
• gt (top-location b3)
• (6 4) lt-- X Pos.X (width/2.0)
  Y Pos.Y
• Implementation
• gt (defmethod top-location ((object basic-block))
• (list ( (first (block-position object))
• (/ (block-width object) 2))
• ( (second (block-position object))
• (block-height object))))

33
Find-space
B4
B4

• 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
• gt (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
B6
34
Intersections-p

• Intersections-p
• Checks for intersections (only checks the X
  dimension)
• gt (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 (gt ls_proposed rs_obstacle)
• (lt rs_Proposed ls_obstacle))
• (return t)))))

Proposed ObjectLocation
Obstacle
35
Blocks World Usage

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

36
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