I been writting fortran code in lisp for the last decade....would like to
learn to write lisp. got the sytle books coming. If you have time (and the
energy) please tell me how I shoul have written the three coin problem.
T'is an embarrassing fortran attemp. Geeez when you guys do it it looks so
easy and makes so much sense.
;;; three coins problem presented in _introduction to artifical
;;; intelligence_ by philip jackson jr
;;; state-space problem specifications of three things
;;; S, a set of possible starting state
;;; F, as set of operators
;;; G, a set of desired goals
;;; S == three coins two or heads and one is tails
;;; S -> '(h h t)
;;; problem:-> you have exactly two moves of the coins
;;; to make '(h h h) or '(t t t) therefore moving position
;;; "C" to heads on the first move doesn't count
;;;muLISP90 16 bit (sorry don't use common lisp)
;;;thanks rusty craine
; S -> starting state
(setq tst-0 '(h h t))
;
(defun invert-coin (coin)
(if (equal coin '(t)) '(h)
'(t)))
; G-1 operator
(defun flipper-a (coins)
(append (invert-coin (sublist coins 0 0))
(sublist coins 1 2)))
;G-2 operator
(defun flipper-b (coins)
(append (sublist coins 0 0)
(invert-coin (sublist coins 1 1))
(sublist coins 2 2)))
;G-3 operator
(defun flipper-c (coins)
(append (sublist coins 0 1)
(invert-coin (sublist coins 2))))
;
(defun move-coins (lst)
(setq tst-1 (list (cons 'a (flipper-a lst))
(cons 'b (flipper-b lst))
(cons 'c (flipper-c lst))))
(terpri)
(print tst-0)
(print tst-1)
;muLISP loop has implied cond in loop
(loop
((atom tst-1))
((or (equal '(h h h) temp) (equal '(t t t) temp)))
(if (eq 'a (caar tst-1)) (setq temp (flipper-b (cdar tst-1))))
(if (eq 'b (caar tst-1)) (setq temp (flipper-c (cdar tst-1))))
(if (eq 'c (caar tst-1)) (setq temp (flipper-a (cdar tst-1))))
; G -> goal
(if (or (equal '(h h h) temp) (equal '(t t t) temp))
(print (list (caar tst-1) temp)))
(setq tst-1 (cdr tst-1)))
(terpri))
;
(move-coins tst-0)
;;;
;;;output of move-coins ->
;;;(H H T)
;;;((A T H T) (B H T T) (C H H H))
;;;(A (T T T))
I'll give two replies to this, first I'll rip your code to bits, then
I'll post my solution for others to rip to bits. (Expect it in a day
or two)
"rusty craine" <········@flash.net> writes:
[Lots of stuff deleted]
> Geeez when you guys do it it looks so easy and makes so much sense.
If you think that, there is hope for you, grasshopper.
> (defun invert-coin (coin)
> (if (equal coin '(t)) '(h)
> '(t)))
Use 't and 'h instead of '(t) and '(h). (Of course, the rest of the
code has to be switched to match. :-)
> ; G-1 operator
> (defun flipper-a (coins)
> (append (invert-coin (sublist coins 0 0))
> (sublist coins 1 2)))
> ;G-2 operator
> (defun flipper-b (coins)
> (append (sublist coins 0 0)
> (invert-coin (sublist coins 1 1))
> (sublist coins 2 2)))
> ;G-3 operator
> (defun flipper-c (coins)
> (append (sublist coins 0 1)
> (invert-coin (sublist coins 2))))
> ;
These three functions should be one function. Don't use (sublist) but
(nth) to pick out single elements. (Which will then be _elements_, not
length-1 lists, see above)
> (defun move-coins (lst)
<ironic>
You have hardcoded everything else, why give lst as an argument?
</ironic>
> (setq tst-1 (list (cons 'a (flipper-a lst))
> (cons 'b (flipper-b lst))
> (cons 'c (flipper-c lst))))
> (terpri)
> (print tst-0)
Err... you are using _both_ lst and tst-0? But, but...
> (print tst-1)
> ;muLISP loop has implied cond in loop
> (loop
> ((atom tst-1))
You are testing whether the list is empty here, right?
In that case, use (null) rather than (atom).
> ((or (equal '(h h h) temp) (equal '(t t t) temp)))
> (if (eq 'a (caar tst-1)) (setq temp (flipper-b (cdar tst-1))))
> (if (eq 'b (caar tst-1)) (setq temp (flipper-c (cdar tst-1))))
> (if (eq 'c (caar tst-1)) (setq temp (flipper-a (cdar tst-1))))
You aren't testing all possibilites here. You are testing A followed
by B, B followed by C, C followed by A. There are six other
combinations, which you leave untested.
If course, from knowing the problem domain, we can deduce that the
solution has to be one of the above, but from knowing the problem
domain one can also just write down the solution, so, well...
You solution would be very hard to extend beyond 2 flips.
> ; G -> goal
> (if (or (equal '(h h h) temp) (equal '(t t t) temp))
> (print (list (caar tst-1) temp)))
This (if) duplicates the loop termination test. Duplicated code like
this is a symptom of bad code design. (This is just a rule of thumb,
exceptions abound)
> (setq tst-1 (cdr tst-1)))
Rather than changing tst-1 like this, you should use the extended loop
(if muLISP has that) or a mapping function to iterate over the list
elements. This will also let you change all (cdar tst-1) into (cdr
element-of-tst-1) and so on. Tends to be more readable.
> (terpri))
> ;
> (move-coins tst-0)
>
> ;;;
> ;;;output of move-coins ->
> ;;;(H H T)
> ;;;((A T H T) (B H T T) (C H H H))
> ;;;(A (T T T))
This output is not complete. It shows that the first flip you have to
do is type A, but not what you should do next. Of course, from the
limited selection of flip combinations you tested, we know this to be
a type B flip, but...
> ^Z^Z
The intention of this bit of code is unclear. (Sorry :-)
Stig Hemmer,
Jack of a Few Trades.
Stig Hemmer wrote in message ...
>I'll give two replies to this, first I'll rip your code to bits, then
>I'll post my solution for others to rip to bits. (Expect it in a day
>or two)
Thank you very much for your critique. I had not considered the pressure of
posting code as an expert to a news groups of experts :o).
apt at leaping before looking,
Rusty (hip shot) Craine
>
>"rusty craine" <········@flash.net> writes:
>[Lots of stuff deleted]
>
>> Geeez when you guys do it it looks so easy and makes so much sense.
>If you think that, there is hope for you, grasshopper.
>
>> (defun invert-coin (coin)
>> (if (equal coin '(t)) '(h)
>> '(t)))
>
>Use 't and 'h instead of '(t) and '(h). (Of course, the rest of the
>code has to be switched to match. :-)
>
>> ; G-1 operator
>> (defun flipper-a (coins)
>> (append (invert-coin (sublist coins 0 0))
>> (sublist coins 1 2)))
>> ;G-2 operator
>> (defun flipper-b (coins)
>> (append (sublist coins 0 0)
>> (invert-coin (sublist coins 1 1))
>> (sublist coins 2 2)))
>> ;G-3 operator
>> (defun flipper-c (coins)
>> (append (sublist coins 0 1)
>> (invert-coin (sublist coins 2))))
>> ;
>
>These three functions should be one function. Don't use (sublist) but
>(nth) to pick out single elements. (Which will then be _elements_, not
>length-1 lists, see above)
>
>> (defun move-coins (lst)
>
><ironic>
>You have hardcoded everything else, why give lst as an argument?
></ironic>
>
>> (setq tst-1 (list (cons 'a (flipper-a lst))
>> (cons 'b (flipper-b lst))
>> (cons 'c (flipper-c lst))))
>> (terpri)
>> (print tst-0)
>
>Err... you are using _both_ lst and tst-0? But, but...
>
>> (print tst-1)
>> ;muLISP loop has implied cond in loop
>> (loop
>> ((atom tst-1))
>
>You are testing whether the list is empty here, right?
>In that case, use (null) rather than (atom).
>
>> ((or (equal '(h h h) temp) (equal '(t t t) temp)))
>> (if (eq 'a (caar tst-1)) (setq temp (flipper-b (cdar tst-1))))
>> (if (eq 'b (caar tst-1)) (setq temp (flipper-c (cdar tst-1))))
>> (if (eq 'c (caar tst-1)) (setq temp (flipper-a (cdar tst-1))))
>
>You aren't testing all possibilites here. You are testing A followed
>by B, B followed by C, C followed by A. There are six other
>combinations, which you leave untested.
>
>If course, from knowing the problem domain, we can deduce that the
>solution has to be one of the above, but from knowing the problem
>domain one can also just write down the solution, so, well...
>
>You solution would be very hard to extend beyond 2 flips.
>
>> ; G -> goal
>> (if (or (equal '(h h h) temp) (equal '(t t t) temp))
>> (print (list (caar tst-1) temp)))
>
>This (if) duplicates the loop termination test. Duplicated code like
>this is a symptom of bad code design. (This is just a rule of thumb,
>exceptions abound)
>
>> (setq tst-1 (cdr tst-1)))
>
>Rather than changing tst-1 like this, you should use the extended loop
>(if muLISP has that) or a mapping function to iterate over the list
>elements. This will also let you change all (cdar tst-1) into (cdr
>element-of-tst-1) and so on. Tends to be more readable.
>
>> (terpri))
>> ;
>> (move-coins tst-0)
>>
>> ;;;
>> ;;;output of move-coins ->
>> ;;;(H H T)
>> ;;;((A T H T) (B H T T) (C H H H))
>
>> ;;;(A (T T T))
>
>This output is not complete. It shows that the first flip you have to
>do is type A, but not what you should do next. Of course, from the
>limited selection of flip combinations you tested, we know this to be
>a type B flip, but...
>
>> ^Z^Z
>
>The intention of this bit of code is unclear. (Sorry :-)
>
>Stig Hemmer,
>Jack of a Few Trades.
"rusty craine" <········@flash.net> writes:
> ;;; three coins problem presented in _introduction to artifical
> ;;; intelligence_ by philip jackson jr
> ;;; state-space problem specifications of three things
> ;;; S, a set of possible starting state
> ;;; F, as set of operators
> ;;; G, a set of desired goals
> ;;; S == three coins two or heads and one is tails
> ;;; S -> '(h h t)
> ;;; problem:-> you have exactly two moves of the coins
> ;;; to make '(h h h) or '(t t t) therefore moving position
> ;;; "C" to heads on the first move doesn't count
> ;;;muLISP90 16 bit (sorry don't use common lisp)
Well, I'll go with Common Lisp, but I believe the translation should
be trivial.
The "Lisp Way" of doing a task like this is to code a general solution
and then applying that solution to the specific case.
In general terms what we want to do is to explore a state space and
find a path of a certain length from one state to one of several goal
states.
There are (at least) two different ways of doing this:
- One can generate a list of _all_ possible states reachable in
exactly n steps from the start and then check if any of these are
goal states.
- One can generate the possible states one by one and check them as
they are generated.
At the first glace, these two solutions seem identical, but they are
not. The first one will use an amount of memory exponential in the
length of the path sought, while the second will only need linear
space. In the given problem, exponential space means 3^2 =9, not a
big deal, but the code will not be reusable for anything but toy
problems. (Both solutions will use exponential _time_, but that is
unavoidable)
(I expect one of the experts to step in at this point with a comment
about streams. I'm not an expert and will leave that to them)
Now, how does one formulate the solution in more detail? By
specifying an interface for the general path finder. My suggestion is
the following:
(defun find-paths (start-state next-states is-goal-state depth)
"Returns a list of paths of exactly DEPTH length from START-STATE to
states that IS-GOAL-STATE. NEXT-STATES takes one state argument and
returns an alist of (designator . new-state) pairs. Each path
returned by FIND-PATHS is a list of these designators, with the
reached goal state as the last element"
;;; The reason I chose to let IS-GOAL-STATE be a predicate rather than
;;; just giving a list of possible goal states is that it is more
;;; general. Sometimes the number of possible goal states is large,
;;; even infinte, but you can still check if a state is a goal
;;; state. (If you can't, the problem isn't well-defined)
;;; Also note that I have made no comments on exactly what a 'state'
;;; is. In fact, it can be any kind of Lisp object.
;;; Now, if DEPTH is 0, we just check if we have reached a goal state.
(if (eql depth 0)
(if (funcall is-goal-state start-state)
`((,start-state)) ; One zero-length path found.
()) ; No paths found.
;;; When DEPTH is greater than 0, we generate all the possible next
;;; states and recursively find all paths from them to goal states and
;;; combine the restults.
(mapcan #'(lambda (pair)
(let ((designator (car pair))
(new-state (cdr pair)))
;; Add the current designator to each path.
(mapcar #'(lambda (one-path)
(cons designator one-path))
(find-paths new-state next-states
is-goal-state (- depth 1)))))
(funcall next-states start-state))))
;;; I would like to state for the record that the just completed piece
;;; of code is much too convoluted. My appologies.
;;; Now, to the specific problem.
(setf coins-start-state '(H H T))
(defun coins-next-states (coin-list)
"See documentation of FIND-PATHS."
(list
(cons 'A (flip-coin coin-list 0))
(cons 'B (flip-coin coin-list 1))
(cons 'C (flip-coin coin-list 2))))
(defun flip-coin (coin-list which-coin)
"Returns a copy of COIN-LIST with coin number WHICH-COIN flipped."
(let ((temp (copy-list coin-list)))
(setf (nth which-coin temp)
(if (eq (nth which-coin temp) 'H)
'T 'H))
temp))
(defun coins-is-goal-state (coin-list)
(or (equal coin-list '(T T T))
(equal coin-list '(H H H))))
(find-paths coins-start-state #'coins-next-states #'coins-is-goal-state 2)
;;; outputs ((A B (T T T)) (B A (T T T)))
(find-paths coins-start-state #'coins-next-states #'coins-is-goal-state 1)
;;; outputs ((C (H H H)))
(find-paths coins-start-state #'coins-next-states #'coins-is-goal-state 3)
;;; outputs ((A A C (H H H)) (A C A (H H H)) (B B C (H H H))
;;; (B C B (H H H)) (C A A (H H H)) (C B B (H H H))
;;; (C C C (H H H)))
;;; Stig Hemmer,
;;; Jack of a Few Trades.
;;; PS: I would like to remind everybody that you are supposed to rip
;;; this code to pieces :-)