Classical Problem Solving. Design of Computer Problem Solvers CS 344 Winter 2000. Last time. AI programming versus conventional programming Emphasis on knowledge representation Overview of systems Homework 0 Preview of homework 1. This week’s themes.
Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author.While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server.
Problemsolvers
see the world
in terms of
problem spaces
Problemsolvers
see the world
in terms of
problem spaces
Problemsolvers
see the world
in terms of
problem spaces
Problemsolvers
see the world
in terms of
problem spaces
Problemsolvers
see the world
in terms of
problem spaces
Problem
Space
Search
Engine
Reasoning
Engine
Knowledge of the domain
Computer Program
Representation
of Domain Knowledge
How Problem Spaces provide modularity and explicitnessSearch Engine
Problem Space
Representation
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
Once we have these, we can create “generic” search engines that will work with any problem space.
Function description:
PROBLEM slot:
When has goal been found?
Return set of applicable operators
Are states the same?
Remove path from possible paths?
Estimate of distance to goal
Print state
Print solution path segment
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Code
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
(defun bsolve (initial &aux currpath newpaths)
“Apply breadthfirst search to problem space.”
(do ((queue (list (list initial initial))
(append (cdr queue) newpaths)))
((null queue))
(setq currpath (car queue))
(when (goalrecognized? (car currpath)
(return currpath))
(setq newpaths (extendpath currpath))
(defun extendpath (path &aux newpaths newpath pr)
“Extend the given path, and return a list of possible paths+1”
(setq pr (pathpr path))
(dolist (op (properators pr) newpaths)
(dolist (oppair (applyop path op pr))
(setq newpath
(makepath
(addtopath path (cdr oppair) (car oppair))))
(unless (pathhasloop? newpath) ;avoid loops
(unless (and (prpathfilter pr)
(funcall (prpathfilter pr) newpath))
(push newpath newpaths))))))
(defun extendpath (path &aux newpaths newpath pr)
“Extend the given path, and return a list of possible paths+1”
(setq pr (pathpr path))
(dolist (op (properators pr) newpaths)
(dolist (oppair (applyop path op pr))
(setq newpath
(makepath
(addtopath path (cdr oppair) (car oppair))))
(unless (pathhasloop? newpath) ;avoid loops
(unless (and (prpathfilter pr)
(funcall (prpathfilter pr) newpath))
(push newpath newpaths))))))
Apply each op to path’s end state.
(defun extendpath (path &aux newpaths newpath pr)
“Extend the given path, and return a list of possible paths+1”
(setq pr (pathpr path))
(dolist (op (properators pr) newpaths)
(dolist (oppair (applyop path op pr))
(setq newpath
(makepath
(addtopath path (cdr oppair) (car oppair))))
(unless (pathhasloop? newpath) ;avoid loops
(unless (and (prpathfilter pr)
(funcall (prpathfilter pr) newpath))
(push newpath newpaths))))))
Apply domainspecific filter.
(defun bsolve (initial &aux currpath newpaths)
“Apply breadthfirst search to problem space.”
(do ((queue (list (list initial initial))
(append (cdr queue) newpaths)))
((null queue))
(setq currpath (car queue))
(when (goalrecognized? (car currpath)
(return currpath))
(setq newpaths (extendpath currpath))
Fifo queue
(defun bsolve (initial &aux currpath newpaths)
“Apply breadthfirst search to problem space.”
(do ((queue (list (list initial initial))
(append (cdr queue) newpaths)))
((null queue))
(setq currpath (car queue))
(when (goalrecognized? (car currpath)
(return currpath))
(setq newpaths (extendpath currpath))
Bsolve function (simplified)
Fifo queue
(defun bsolve (initial &aux currpath newpaths)
“Apply breadthfirst search to problem space.”
(do ((queue (list (list initial initial))
(append (cdr queue) newpaths)))
((null queue))
(setq currpath (car queue))
(when (goalrecognized? (car currpath)
(return currpath))
(setq newpaths (extendpath currpath))
Check current state to see if goal reached:
Fifo queue
(defun bsolve (initial &aux currpath newpaths)
“Apply breadthfirst search to problem space.”
(do ((queue (list (list initial initial))
(append (cdr queue) newpaths)))
((null queue))
(setq currpath (car queue))
(when (goalrecognized? (car currpath)
(return currpath))
(setq newpaths (extendpath currpath))
Dsolve
LIFO
(append newpaths (cdr queue)))
Let’s use our search engine to tackle a commonlyused search space: the Boston “T”
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
(defstruct (subwaystation (:PRINTFUNCTION subwaystationprintprocedure))
"Data structure representating a single subway station."
(name nil) ;; Name of station.
(lines nil) ;; Subways lines it is on.
(coordinates nil)) ;; For advanced CPS versions which use a distance metric.
(defun subwaystationprintprocedure (pr str ignore)
"Print name of station."
(declare (ignore ignore))
(format str "<Station ~A>" (subwaystationname pr)))
(defvar KENDALLSQUARE)
(setq KENDALLSQUARE
(makesubwaystation
:name ‘Kendallsquare
:lines ‘(REDLINE)
:coordinates ‘(1 . 0))
(push ‘Kendallsquare (subwaylinestations REDLINE))
(push ‘Kendallsquare *stations*)
(defmacro defstation (name lines &optional (x 0) (y 0))
"Define a subway station."
`(progn
(defvar ,name)
(setq ,name (makesubwaystation
:NAME ',name
:LINES ',lines
:COORDINATES (cons ,x ,y)))
,@ (mapcar #'(lambda (line)
`(push ',name (subwaylinestations ,line))) lines)
(push ',name *stations*)))
(defvar KENDALLSQUARE)
(setq KENDALLSQUARE
(makesubwaystation
:name ‘Kendallsquare
:lines ‘(REDLINE)
:coordinates ‘(1 . 0))
(push ‘Kendallsquare (subwaylinestations REDLINE))
(push ‘Kendallsquare *stations*)
(defstation KendallSquare (RedLine) 1.0 0.0)
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
(defstation SouthStation (RedLine) 3.0 1.0)
(defstation Washington (RedLine OrangeLine) 2.75 0.75)
(defstation KendallSquare (RedLine) 1.0 0.0)
(defstation CentralSquare (RedLine) 1.0 0.0)
(defstation HarvardSquare (RedLine) 2.0 1.0)
(defline RedLine)
(defline GreenLine)
(defline OrangeLine)
(defline BlueLine)
Describe the
problem in
its own terms,
and let Lisp
make up
the difference.
PROBLEM:
?
?
?
?
?
?
?
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
PROBLEM:
Subwaystatesidentical?
Subwayoperatorfinder
Subwaystatesidentical?
Prunesubwaypath
Subwaydistance
Format
Printsubwaypath
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
RUN
1. loge(x+1) + loge (x1) = c.
2. loge[(x+1) * (x1)] = c.
3. loge[x21] = c.
4. x21=ec.
5. x2 = ec +1.
6. x = +/ sqrt(ec + 1).
Standard Lisp expressions forstates...
…named functionsfor operators (takeequation, returns transformed equation).
Algebra as a Problem SpaceData
structures?
Note: There’s a distance metric hiding in here that we can use later...
Bundy’s ClaimIsolation methods use later...
= use later...
log

=
c
e

expt
1
expt
1
expt
x
2
e
c
x
2
Isolation methods
Reduce the depth of unknowns.
3. loge[x21] = c.
4. x21=ec.
Depth=4.
Depth=3.
Collection methods use later...
= use later...
log
c
*
e


expt
1
+
x
2
x
1
x
1
Collection methods
Collect together multiple instances of the unknown:
2. loge[(x+1) * (x1)] = c.
3. loge[x21] = c.
One less X.
Attraction methods use later...
+ use later...
log
log
U
W
V
W
log
*
W
U
V
Attraction methods
Bring occurrences of the unknown “closer together”
Distance=4.
1. loge(x+1) + loge (x1) = c.
2. loge[(x+1) * (x1)] = c.
Distance=2.
1. loge(x+1) + loge (x1) = c.
2. loge[(x+1) * (x1)] = c.
3. loge[x21] = c.
4. x21=ec.
5. x2 = ec +1.
6. x = +/ sqrt(ec + 1).
1. Initial
2. Attract log sum.
3. Collect prod diffs
4. Isolate log.
5. Isolate difference.
6. Isolate square
Standard Lisp expressions for use later...states...
Isolation methodsCollection methodsAttraction methods
…named functionsfor operators (takeequation, returns transformed equation).
Measure number and depths of unknowns in equation...
Algebra as a problem spaceData
structures?
Function description:
PROBLEM slot:
When has goal been found?
Return set of applicable operators
Are states the same?
Remove path from possible paths?
Estimate of distance to goal
Print state
Print solution path segment
Operator list
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Operators
Problem space use later...
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Operators
Algebra domainStates: Lisp expressionOperators: Isolation, collection, & attraction methods
“Pluggable” problem spacePROBLEM:
?
?
?
?
?
?
?
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
PROBLEM:
Gotalgebragoal?
Findalgebraoperator
Equal
NIL
Algebradistance
Format
Printderivativestep
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Operators
(defun occursin? (exp1 exp2)
"True if expression 1 is contained somewhere in expression 2."
(cond ((equal exp1 exp2) t)
((null exp2) nil)
((listp exp2)
(or (occursin? exp1 (car exp2))
(occursin? exp1 (cdr exp2))))))
(defun hasunknown? (exp)
"True if expression contains unknown value."
(occursin? 'x exp))
(defun nounknown? (exp)
"True if expression contains no unknown values."
(not (occursin? 'x exp)))
(defun gotalgebragoal? (state)
"Has goal of algebra
problem been met?"
(and (eq (cadr state) 'x) ;; LHS=X
(nounknown? (rhs state))))
Treewalking: Apply Foo to every element in tree thing.
Function footreewalk (thing)
Null thing? Return nil.
Atom thing? Then FooThing.
List thing? Footreewalk the car(thing).Footreewalk the cdr(thing).
(defun match (pat dat &optional (dict nil))
"Take a single pattern and data, and return any matches based on the pattern. Dictionary contains binding list."
(cond ((eq dict :FAIL) :FAIL) ;; Propagate lossage
((eq pat dat) dict)
((elementvar? pat)
(matchelementvar pat dat dict))
((not (consp pat))
(if (equal? pat dat) dict :FAIL))
((segmentvar? (car pat))
(matchsegmentvar pat dat dict))
((not (consp dat)) :FAIL)
(t (match (cdr pat) (cdr dat)
(match (car pat) (car dat) dict)))))
(defun matchelementvar (pat dat dict &aux entry pred)
"Match single element pattern variable to given data, using
the bindings in dictionary. Returns either :FAIL or updated binding dictionary."
(setq entry (lookupvar pat dict))
(cond (entry
(if (equal? (cadr entry) dat) dict :FAIL))
(t (setq pred (varrestriction pat))
(cond ((or (not pred)
(funcall pred dat))
(bindelementvar (varname pat) dat dict))
(t :FAIL)))))
(defun matchsegmentvar (pat dat dict &aux entry rest)
"Given sequence pattern variable, attempt matching. Returns either bindings or :FAIL."
(setq entry (lookupvar (car pat) dict))
(cond (entry ;; check for match
(setq rest
(checksegment dat (segmentbeg entry)
(segmentend entry)))
(if (eq rest :FAIL) :FAIL
(match (cdr pat) rest dict)))
(t ;; Search for alternate segment bindings
(trysegmentbindings (car pat) (cdr pat) dat dict))))
;; Flush degenerate cases
((? op +/*?) (? e)) (? e))
((+ (? zero zero?) (?? e)) (+ (?? e)))
;; Combine numerical constants
(((? op +/*?) (? e1 numberp) (? e2 numberp) (?? e3))
((? op) (:EVAL ((? op) (? e1) (? e2))) (?? e3)))
(( (? e1 numberp) (? e2 numberp)) (:EVAL ( (? e1) (? e2))))
(( (? e1 numberp)) (:EVAL ( (? e1))))
;; Flatten +,*
(((? op +/*?) (?? e1) ((? op) (?? e2) (?? e3)))
((? op) (?? e1) (?? e2) (?? e3)))
;; Canonicalize +,*
(((? op +/*?)
(?? terms,#'(lambda (terms) (not (sorted? terms #'alg<)))))
((? op) (:SPLICE (:EVAL (sort (quote (? terms)) #'alg<)))))
TRYCANONICALIZATION
+> SIMPLIFY
+> SIMPLIFYIT
+> TRYMATCHERRULES
(defun trymatcherrules (exp rules)
;; Return the original expression by default
(dolist (rule rules exp)
(let ((bindings (match (rulepattern rule) exp nil)))
(unless (eq bindings :FAIL)
(returnfrom trymatcherrules
(substitutein (ruleresult rule)
bindings))))))
PROBLEM:
Gotalgebragoal?
Findalgebraoperator
Equal
NIL
Algebradistance
Format
Printderivativestep
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Operators
(defun setupalgebraproblem ()
"Create an generic algebra 'problem space'."
(makeproblem
:NAME 'Algebra
:GOALRECOGNIZER 'gotalgebragoal?
:OPERATORAPPLIER 'findalgebraoperator
:STATEPRINTER #'(lambda (f) (format nil "~A" f))
:SOLUTIONELEMENTPRINTER #'printderivationstep
:STATESIDENTICAL? 'equal
:DISTANCEREMAINING 'algebradistance
:OPERATORS '((IsolateLog tryisolatelog)
(IsolateSum tryisolatesum)
(IsolateDifference tryisolatedifference)
(IsolateSquare tryisolatesquare)
(CollectProductDifference trycollectproddiff)
(AttractLogSum tryattractlogsum)
(Canonicalize trycanonicalization))))
(defun findalgebraoperator (state operator)
;; Operators take the form (<name> <procedure>)
(funcall (cadr operator) state))
(defun tryisolatesquare (form &aux bindings)
(setq bindings
(match '(= (sqr (? arg hasunknown?))
(? rhs nounknown?))
form))
(unless (eq bindings :FAIL)
`(,(cons `(isolatesquare ,form)
(simplify (substitutein `(= (? arg) (sqrt (? rhs)))
bindings))))))
Operators
(defun tryisolatesquare (form &aux bindings)
(setq bindings
(match '(= (sqr (? arg hasunknown?))
(? rhs nounknown?))
form))
(unless (eq bindings :FAIL)
`(,(cons `(isolatesquare ,form)
(simplify (substitutein `(= (? arg) (sqrt (? rhs)))
bindings))))))
Attempt to match X^2 = expression.
Operators
(defun tryisolatesquare (form &aux bindings)
(setq bindings
(match '(= (sqr (? arg hasunknown?))
(? rhs nounknown?))
form))
(unless (eq bindings :FAIL)
`(,(cons `(isolatesquare ,form)
(simplify (substitutein `(= (? arg) (sqrt (? rhs)))
bindings))))))
Attempt to match X^2 = expression.
If success, substitute bindings into new expression
(defun trycollectproddiff (form &aux bindings results)
(dolist (ldt (findleastdominatingterms form) results)
(setq bindings
(match '(* (+ (? v nounknown?)
(? u hasunknown?))
( (? u) (? v)))
ldt))
(unless (eq bindings :FAIL)
(push (cons `(collectproductsum ,ldt)
(simplify
(subst (substitutein
`( (sqr (? U)) (sqr (? V)))
bindings)
ldt form)))
results))))
PROBLEM:
Gotalgebragoal?
Findalgebraoperator
Equal
NIL
Algebradistance
Format
Printderivativestep
Goalrecognizer
Operatorapplier
Statesidentical
Pathfilter
Distanceremaining
Stateprinter
Solutionelementprinter
Operators
(defun algebradistance (expr)
"Estimate how close this expression is to solution, return number."
(labels ((sumtreedepth
(exp depth)
(cond ((null exp) 0)
((eq exp 'X) depth)
((not (listp exp)) 0)
(t (+ (sumtreedepth (car exp) (1+ depth))
(sumtreedepth (cdr exp) depth))))))
(+ (sumtreedepth (lhs expr) 1)
(sumtreedepth (rhs expr) 1))))
Due: January 21 by midnight!
Build a better algebra system.
Chapter 3, Problem 5 (parts a & b), then extend system to solve 10 problems given on web page.
(defun trycollectproddiff (form &aux bindings results)
(dolist (ldt (findleastdominatingterms form) results)
(setq bindings
(match '(* (+ (? v nounknown?)
(? u hasunknown?))
( (? u) (? v)))
ldt))
(unless (eq bindings :FAIL)
(push (cons `(collectproductsum ,ldt)
(simplify
(subst (substitutein
`( (sqr (? U)) (sqr (? V)))
bindings)
ldt form)))
results))))
(defAlgebraOperator collectproddiff COLLECTION;;; (U+v)*(Uv) => (U^2  V^2).
(* (+ (? v nounknown?)
(? u hasunknown?))
( (? u) (? v)))
( (sqr (? U)) (sqr (? V))))
Extend the Natural Deduction system to use premises and goals.
BPS, pp. 148149:
Hints:
Due: January 28 by midnight!