Transcript Functional Programming

Functional Programming
03 Specialized Data Structures
Review
• Breadth First Search (BFS)
▫ Implementation: FIFO Queue
▫ Shortest path searching
• Depth First Search (DFS)
▫ Implementation: LIFO Stack
Specialized Data Structures -Arrays
• make-array
▫ > (setf arr (make-array ‘(2 3) :initial-element nil))
#<Array T (2 3)>
▫ Maximum:
 7 dimensions
 Each dimension can have 1023 elements
▫ Initial-element
 Optional
 Whole array will be initialized to this value
▫ > (aref arr 0 0)
NIL
Specialized Data Structures -Arrays
• > (setf (aref arr 0 0) ‘b)
B
• > (aref arr 0 0)
; access the array
B
• #na
▫ Denote an n-dimensional array
▫ E.g., 2a ((b nil nil) (nil nil nil))
▫ If *print-array* is t, arrays will be displayed in this form:
 > (setf *print-array* t)
T
 > arr
#2A ((B NIL NIL) (NIL NIL NIL))
Specialized Data Structures -Arrays
• One-dimensional array
▫ > (setf vec (make-array 4 :initial-element nil))
#(NIL NIL NIL NIL)
▫ > (vector “a” ‘b 5 “c”)
#(“a” B 5 “c”)
▫ > (setf vec (vector “a” ‘b 5 “c”))
> (svref vec 1)
;access the vector (sv: simple vector)
B
Specialized Data Structures –Arrays:
Binary Search
• (defun bin-search (obj vec)
(let ((len (length vec)))
(and (not (zerop len))
(finder obj vec 0 (- len 1)))))
• (defun finder (obj vec start end)
(let ((range (- end start)))
(if (zerop range)
(if (eql obj (aref vec start))
obj
nil)
(let ((mid (+ start (round (/ range 2)))))
(let ((obj2 (aref vec mid)))
(if (< obj obj2)
(finder obj vec start (- mid 1))
(if (> obj obj2)
(finder obj vec (+ mid 1) end)
obj)))))))
Specialized Data Structures –Arrays:
Binary Search
• Insert the follow line at the beginning of finder
(format t “~A~%” (subseq vec start (+ end 1)))
• > (bin-search 3 #(0 1 2 3 4 5 6 7 8 9))
#(0 1 2 3 4 5 6 7 8 9)
#(0 1 2 3)
#(3)
3
Specialized Data Structures –Arrays:
Binary Search
• ;;;; Utilities for operations on sorted vectors.
;;; Finds an element in a sorted vector.
(defun bin-search (obj vec)
(let ((len (length vec)))
;; if a real vector, send it to finder
(and (not (zerop len)) ; returns nil if empty
(finder obj vec 0 (- len 1)))))
Specialized Data Structures –
Strings and Characters
• String: a vector of characters
• > (sort “elbow” #’char<)
“below”
• Retrieve an element of a string
▫ > (aref “abc” 1)
#\b
▫ > (char “abc” 1)
#\b
Specialized Data Structures –
Strings and Characters
• Replace elements of a stirng
▫ > (let ((str (copy-seq “Merlin”)))
(setf (char str 3) #\k)
str)
“Merkin”
• Compare two strings
▫ > (equal “fred” “fred”)
T
▫ > (equal “fred” “Fred”)
NIL
▫ > (string-equal “fred” “Fred”)
T
Specialized Data Structures –
Strings and Characters
• Building strings
▫ > (format nil “~A or ~A” “truth” “dare”)
“truth or dare”
▫ > (concatenate ‘string “not “ “to worry”)
“not to worry”
Specialized Data Structures –
Sequences
• Find the position of an element in a sequence
▫ > (position #\a “fantasia”)
1
▫ > (position #\a “fantasia” :start 3 :end 5)
4
Paramet
er
Purpose
Default
:key
:test
:from-end
:start
:end
A function to apply to each element
The test function for comparison
If true, work backwards
Position at which to start
Position, if any, at which to stop
identity
eql
nil
0
nil
Specialized Data Structures –
Sequences
▫ > (position #\a “fantasia” :from-end t)
7
▫ > (position ‘a ‘((c d) (a b)) :key #’car)
1
; :key argument is a function that is applied to each
;element of a sequence before it is considered,
; that is, whose car is symbol a
▫ > (position ‘(a b) ‘((a b) (c d)))
NIL
▫ > (position ‘(a b) ‘((a b) (c d)) :test #’equal)
0
▫ > (position 3 ‘(1 0 7 5) :test #’<)
 ?
 2
Specialized Data Structures –
Sequences
• Write a function using subseq and position, which
returns the second word in a string
▫ (defun second-word (str)
(let ((p1 (+ (position #\ str) 1)))
(subseq str p1 (position #\ str :start p1))))
▫ > (second-word “From follows function.”)
“follows”
Specialized Data Structures –
Sequences
• > (position-if #’oddp ‘(2 3 4 5))
1
;it takes all the keyword argument except :test
• > (find #\a “cat”)
#\a
• > (find-if #’characterp “ham”)
#\h
• Often a call to find-if will be clearer if it is translated into
a find with a :key argument
▫ (find-if #’(lambda (x)
(eql (car x) ‘complete))
lst)
▫ (find ‘complete lst :key #’car)
Specialized Data Structures –
Sequences
• > (remove-duplicates “abracadabra”)
“cdbra”
; preserve only the last of each occurrence of any element of a sequence
• (reduce #’fn ‘(a b c d))
is equivalent to
(fn (fn (fn ‘a ‘b) ‘c) ‘d)
▫ > (reduce #’intersection ‘((b r a d ‘s) (b a d) (c a t)))
(A)
Specialized Data Structures –
Sequences: Parsing Dates
• Write a program:
▫ Takes a string like “16 Aug 1980”
▫ Returns a list of integers representing the day, month,
and year, like (16 8 1980)
▫ > (parse-date “16 Aug 1980”)
(16 8 1980)
Specialized Data Structures –
Sequences: Parsing Dates
• (defun tokens (str test start)
(let ((p1 (position-if test str :start start)))
(if p1
(let ((p2 (position-if #’(lambda (c)
(not (funcall test c)))
str :start p1)))
(cons (subseq str p1 p2)
(if p2
(tokens str test p2)
nil)))
nil)))
• (defun constituent (c)
(and (graphic-char-p c)
(not (char= c #\ ))))
Specialized Data Structures –
Sequences: Parsing Dates
• > (tokens “ab12 3cde.f” #’alpha-char-p 0)
(“ab” “cde” “f”)
• > (tokens “ab12 3cde.f
gh” #’constituent 0)
(“ab12” “3cde.f” “gh”)
• In Common Lisp, graphic characters are all the
characters we can see, plus the space character
Specialized Data Structures –
Sequences: Parsing Dates
• (defun parse-date (str)
(let ((toks (tokens str #’constituent 0)))
(list (parse-integer (first toks))
(parse-month (second toks))
(parse-integer (third toks)))))
• (defconstant month-names
#(“jan” “feb” “mar” “apr” “may” “jun”
“jul” “aug” “sep” “oct” “nov” “dec”))
• (defun parse-month (str)
(let ((p (position str month-names
:test #’string-equal)))
(if p
(+ p 1)
nil)))
Specialized Data Structures –
Sequences: Parsing Dates
• parse-integer
▫ Takes a string and returns the corresponding integer
• (defun read-integer (str)
(if (every #’digit-char-p str)
(let ((accum 0))
(dotimes (pos (length str))
(setf accum (+ (* accum 10)
(digit-char-p (char str pos)))))
accum)
nil))
Specialized Data Structures –
Structures
• (defstruct point
x
y)
• (setf p (make-point :x 0 :y 0))
#S(POINT X 0 Y 0)
• > (point-x p)
0
• > (setf (point-y p) 2)
2
• >p
#S(POINT X 0 Y 2)
• > (point-p p)
T
• > (typep p ‘point)
T
Specialized Data Structures –
Structures
• (defstruct polemic
(type (progn
(format t “What kind of polemic was it?”)
(read)))
(effect nil))
• > (make-polemic)
What kind of polemic was it? scathing
#S(POLEMIC TYPE SCATHING EFFECT NIL)
Specialized Data Structures –
Structures
• (defstruct (point (:conc-name p)
(:print-function print-point))
(x 0)
(y 0))
(defun print-point (p stream depth)
(format stream “#<~A,~A>” (px p) (py p)))
• > (make-point)
#<0,0>
Specialized Data Structures –
Structures: Binary Search Trees
Specialized Data Structures –
Structures: Binary Search Trees
(defstruct (node (:print-function
(lambda (n s d)
(format s "#<~A>" (node-elt n)))))
elt (l nil) (r nil))
(defun bst-insert (obj bst <)
(if (null bst)
(make-node :elt obj)
(let ((elt (node-elt bst)))
(if (eql obj elt)
bst
(if (funcall < obj elt)
(make-node
:elt elt
:l (bst-insert obj (node-l bst) <)
:r (node-r bst))
(make-node
:elt elt
:r (bst-insert obj (node-r bst) <)
:l (node-l bst)))))))
Specialized Data Structures –
Structures: Binary Search Trees
(defun bst-find (obj bst <)
(if (null bst)
nil
(let ((elt (node-elt bst)))
(if (eql obj elt)
bst
(if (funcall < obj elt)
(bst-find obj (node-l bst) <)
(bst-find obj (node-r bst) <))))))
(defun bst-min (bst)
(and bst
(or (bst-min (node-l bst)) bst)))
(defun bst-max (bst)
(and bst
(or (bst-max (node-r bst)) bst)))
Specialized Data Structures –
Structures: Binary Search Trees
• Build a BST
▫ > (setf nums nil)
NIL
▫ > (dolist (x ‘(5 8 4 2 1 9 6 7 3))
(setf nums (bst-insert x nums #’<)))
NIL
• Search an element in a BST
▫ > (bst-find 12 nums #’<)
NIL
▫ > (bst-find 4 nums #’<)
#<4>
▫ > (bst-min nums)
#<1>
▫ >(bst-max nums)
#<9>
Specialized Data Structures –
Structures: Binary Search Trees
(defun bst-remove (obj bst <)
(if (null bst)
nil
(let ((elt (node-elt bst)))
(if (eql obj elt)
(percolate bst)
(if (funcall < obj elt)
(make-node
:elt elt
:l (bst-remove obj (node-l bst) <)
:r (node-r bst))
(make-node
:elt elt
:r (bst-remove obj (node-r bst) <)
:l (node-l bst)))))))
Specialized Data Structures –
Structures: Binary Search Trees
(defun percolate (bst)
(cond ((null (node-1 bst))
(if (null (node-r bst))
nil
(rperc bst)))
((null (node-r bst)) (lperc bst))
(t (if (zerop (random 2))
(lperc bst)
(rperc bst)))))
(defun rperc (bst)
(make-node :elt (node-elt (node-r bst))
:l (node-l bst)
:r (percolate (node-r bst))))
(defun lperc (bst)
(make-node :elt (node-elt (node-l bst))
:l (percolate (node-l bst))
:r (node-r bst)))
Specialized Data Structures –
Structures: Binary Search Trees
• Remove an element from a BST
▫ > (setf nums (bst-remove 2 nums #’<))
#<5>
▫ > (bst-find 2 nums #’<)
NIL
Specialized Data Structures –
Structures: Binary Search Trees
• (defun bst-traverse (fn bst)
(when bst
(bst-traverse fn (node-l bst))
(funcall fn (node-elt bst))
(bst-traverse fn (node-r bst))))
• > (bst-traverse #’princ nums)
13456789
NIL
Specialized Data Structures –
Hash Tables
• Create a hash table
▫ > (setf ht (make-hash-table))
#<Hash-Table #x1A54D24D>
• Retrieve the value associated with a given key
▫ > (gethash ‘color ht)
NIL → the value associated with the key
NIL → whether the hash table has any value stored under that key
Specialized Data Structures –
Hash Tables
• Associate a value with a key
▫ > (setf (gethash ‘color ht) ‘red)
RED
> (gethash ‘color ht)
RED
T
▫ > (setf bugs (make-hash-table))
#<Hash-Table #x1A54D585>
> (push “Doesn’t take keyword arguments.”
(gethash #’our-member bugs))
(“Doesn’t take keyword arguments.”)
→ push new strings into the entry for a function
Specialized Data Structures –
Hash Tables
• Use hash table to represent sets
▫ When the sets become large, lookups and deletions should
be much faster with hash tables
▫ > (setf fruit (make-hash-table))
#<Hash-Table #x1A54DA778>
> (setf (gethash ‘apricot fruit) t)
T
> (gethash ‘apricot fruit)
T
T
> (remhash ‘apricot fruit) ;remove an entry from a hash table
T
Specialized Data Structures –
Hash Tables
• maphash
▫ Takes a function of two arguments and a hash table, and this
function will be called on every key/value pair in the tale
▫ > (setf (gethash ‘shape ht) ‘spherical
(gethash ‘size ht) ‘giant)
GIANT
> (maphash #’(lambda (k v)
(format t “~A = ~A~%” k v))
ht)
SHAPE = SPHERICAL
SIZE = GIANT
COLOR = RED
NIL
Specialized Data Structures –
Hash Tables
• :size
▫ specifies the number of elements
▫ (make-hash-table :size 1000)
• :test
▫ > (setf writers (make-hash-table :test #’equal))
#<Hash-Table #xA354553>
> (setf (gethash ‘(ralph waldo emerson) writers) t)
T
Specialized Data Structures
• Homework (Due March 31)
▫ Define a function that takes a BST and returns a list of its
elements ordered from greatest to least
▫ List the syntax mappings between Lisp and C (or any other
languages that you are familiar with) as many as possible
▫ Illustrate what happened while removing the root node (5)
of the tree in page 25 by the algorithm introduced in our
class. If the resulting tree is wrong (not a BST), explain why
▫ Debug the function “bin-search” or “finder” in page 6 to
enable a correct searching, even if the obj is smaller than all
elements in vec
BST-Remove
(defun bst-remove (obj bst)
(if (null bst)
nil
(let ((elt (node-elt bst)))
(if (eql obj elt)
(percolate bst)
(if (< obj elt)
(make-node
:elt elt
:l (bst-remove obj (node-l bst))
:r (node-r bst))
(make-node
:elt elt
:r (bst-remove obj (node-r bst))
:l (node-l bst)))))))
(defun percolate (bst)
(cond ((null (node-l bst))
(if (null (node-r bst))
nil
(rperc bst)))
((null (node-r bst)) (lperc bst))
(t (if (zerop (random 2))
(lperc bst)
(rperc bst)))))
(defun rperc (bst)
(setf min-node-of-r (bst-min (node-r bst)))
(make-node :elt (node-elt min-node-of-r)
:l (node-l bst)
:r (bst-remove (node-elt min-node-of-r) (node-r bst))))
(defun lperc (bst)
(setf max-node-of-l (bst-max (node-l bst)))
(make-node :elt (node-elt max-node-of-l)
:r (node-r bst)
:l (bst-remove (node-elt max-node-of-l) (node-l bst))))