Dtrace from Touretzky - common-lisp

I am trying to learn lisp with the book "Common LISP a Gentle Introduction to Symbolic Computation" written by Touretzky. There is a utility in the book, Dtrace(I use dtrace.generic). Example of using dtrace:
(defun add-to-end (x y)
(append x (list y)))
(defun repeat-first (phrase)
(add-to-end phrase (first phrase)))
> (dtrace add-to-end repeat-first)
(ADD-TO-END REPEAT-FIRST)
> (repeat-first ’(for whom the bell tolls))
----Enter REPEAT-FIRST
| PHRASE = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | X = (FOR WHOM THE BELL TOLLS)
| | Y = FOR
| \--ADD-TO-END returned
| (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned
(FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Unfortunately in Clozure (on Win7) the result is:
? (repeat-first '(for whom the bell tolls))
----Enter REPEAT-FIRST
| Arg-1 = (FOR WHOM THE BELL TOLLS)
| ----Enter ADD-TO-END
| | Arg-1 = (FOR WHOM THE BELL TOLLS)
| | Arg-2 = FOR
| \--ADD-TO-END returned (FOR WHOM THE BELL TOLLS FOR)
\--REPEAT-FIRST returned (FOR WHOM THE BELL TOLLS FOR)
(FOR WHOM THE BELL TOLLS FOR)
Function argument names are lost. It should depend on the fetch-arglist function. Based on this answer, I wrote fetch-arglist as:
(defun fetch-arglist (x) (arglist x))
In fact:
? (arglist #'add-to-end)
(X Y)
:ANALYSIS
Unfortunately, the result is the same. Is there a way, in Clozure, to make the argument names of functions appear in dtrace?
Update:
Solution is (in dtrace.generic):
(defun fetch-arglist (x) (ccl:arglist x))
Update2:
dtrace prints strange results as:
((CCC (? AAA . #1=(0)) (? BBB . #1#)))
While trace of Clozure prints correctly:
((CCC (? AAA 0) (? BBB 0)))
Update3(and hopefully last):
Solution due to Vsevolod Dyomkin:
(defparameter *dtrace-print-circle* nil)
*print-circle* shows common substructure:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '((a b c) (d e f))))
(list l (copy-list l)))
;=> ((#1=(A B C) #2=(D E F)) (#1# #2#))

Related

About "Frames as Repository of Local State"

SICP, Exercise 3.10 in section 3.2.3 shows the following as an alternative to a previously defined make-withdraw:
(define (make-withdraw initial-amount)
(let ((balance initial-amount))
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))))
and prescribes that we
Use the environment model to analyze this alternate version of make-withdraw, drawing figures like the ones above to illustrate the interactions
(define W1 (make-withdraw 100))
(W1 50)
(define W2 (make-withdraw 100))
However, before the above request, the text recalls that (let ((<var> <exp>)) <body>) is syntactic sugar for ((lambda (<var>) <body>) <exp>).
Now I guess that suggestion means that I should analize actually this version of make-withdraw:
(define (make-withdraw initial-amount)
((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount))
or, even better (based on The procedure definition syntax is just syntactic sugar for an underlying implicit lambda expression, from section 3.2.1):
(define make-withdraw
(lambda (initial-amount)
((lambda (balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount)))
And here I see 3 lambda procedures, whereas in both this and this solutions (unofficial; I don't know of official solutions) only two procedures are shown. For instance, this is the latter solution:
; After (define W1 (make-withdraw 100))
global env
------------------
| |<--- env: global env
| | parameters: initial-amount
| make-withdraw: ----> body:
| | ((lambda (balance)
| | (lambda (amount)
| | (if (>= balance amount)
| | (begin (set! balance (- balance amount))
| | balance)
| | "Insufficient funds"))) initial-amount)
| |
| | E1
| | -----------------------
| |<----| initial-amount: 100 |
| | -----------------------
| | /\
| | E2 |
| | ----------------
| | | balance: 100 |
| | ----------------
| | /\
| | |
| | env: E2
| | parameters: amount
| W1: ---------------> body:
| | (if (>= balance amount)
| | (begin (set! balance (- balance amount))
| | balance)
| | "Insufficient funds")
------------------
whereas I would have imagined that a procedure with parameters: balance and body: (lambda (amount) …) was drawn as well, as that's the (temporary?) lambda that's run in E2 (with balance bound to initial-amount, not to 100, which is in turn bound to 100 in E1) to generate the procedure that's ultimately bound to W1.
Am I correct? If not, can you explain why?
When (make-withdraw 100) is called it constructs an environment with initial-amount bound to 100 (this is E1 in the diagram). It then immediately calls another function in this environment: that function constructs a child environment in which balance is bound to 100, which is E2 in the diagram, and returns a third function defined in that environment, which is thus the return value of make-withdraw.
So W1 is now bound to that third function, whose environment is E2. The second function, which constructed E2, has been called and has returned its value (the third function): it's no longer in the picture.
That's why it's not there any more.
I'm not sure if it helps, but it might be useful to think of the environment picture if make-withdraw didn't exist at all as its really just spurious noise at the point W1 has been defined (obviously not in real life, where you might want to make several accounts!):
(define W1 ((λ (initial-amount)
;; this function was `make-withdraw`
((λ (balance)
;; this function was `let`
(λ (amount)
;; this is what W1 will end up being
(if (>= balance amount)
(begin
(set! balance (- balance amount))
balance)
"Insufficient funds")))
initial-amount))
100))

How to go count all of the atoms in a list (or a list of nested lists) when you use recursion

I am creating a recursive function that counts the number of atoms inside a list. It should be able to count the atoms of lists that are nested.
For example: (a (b c) e d) or (a (b c (g e)) e d), it should count b and c separately or b, c, e, and d separately and not as a whole.
This is the function that I have created:
(defun count-atoms (mylist)
(cond
((null mylist) 0)
((listp (car mylist)) (count-atoms (car mylist)))
((atom (car mylist)) (+ 1 (count-atoms (rest mylist))))
)
)
The output I get is 3 but it should be 5 (based from (a (b c) e d)). I am guessing that the function stops the moment it reaches c. How do i make the function not stop at c and make it go back to the outermost list.
Here's a way we can reason about the problem -
If the input is null, return zero
'( )
^
| 0 atoms
(inductive) Otherwise the input has at least one element. If car is a list, call count-elements on car and cdr. Add the two results together and return.
'( a b c d ... )
^ ^
| | count atoms in cdr <-
| \
| count atoms in sublist <------\_ add together
(inductive) Otherwise the input has at least one element that is not a list. Call count-elements on cdr. Add one to the result and return.
'( a b c d ... )
^ ^
| | count atoms in cdr <-
| \
| one atom <-----------------\_ add together
Do you see where your program differs?
Your mistake is that you are ignoring the tail in the second clause.
(defun count-atoms (tree)
"Count atoms in all leaves of the tree, ignoring terminating NIL."
(if tree
(+ (if (atom (car tree))
1
(count-atoms (car tree)))
(count-atoms (cdr tree)))
0))
now
(count-atoms '(a (b c) e d))
==> 5
(count-atoms '(a (b c (g e)) e d))
==> 7
(count-atoms '(a (b c (g e)) nil e d))
==> 8

common lisp function/macro aliases

I would like to set aliases in common lisp(clisp to be exact) for commands that are used a lot, such as "defun" and "lambda" etc, is it possible to do this?
This is actually kind of a duplicate of this question, but I can not comment and the solution does not work for defun or lambda in both sbcl and clisp
Macros:
CL-USER 5 > (setf (macro-function 'dm) (macro-function 'defmethod))
#<Function DEFMETHOD 410009A014>
CL-USER 6 > (dm m1+ ((v vector)) (map 'vector #'1+ v))
#<STANDARD-METHOD M1+ NIL (VECTOR) 4130003913>
CL-USER 7 > (m1+ #(1 2 3 4))
#(2 3 4 5)
The whole point by macros is to provide a source rewriting service.. Thus I want to give you this and you can make that out of it:
(defmacro df (name (&rest arguments) &body body)
`(defun ,name ,arguments ,#body))
(df test (x) (+ x x))
(test 5) ; ==> 10
We have just shortened the name.. Lets make another one:
(defmacro df1 (name &body body)
`(defun ,name (_) ,#body))
(df1 test (+ _ _))
(test 5) ; ==> 10
And so on...

Implement Lisp function to compute the distance between two cities x and y

I am trying to learn lisp and code the above problem as in the map in the image. I have gone through the aima code below to understand how it works. But I am getting the below error:
Can some one please help me understand where I am going wrong?
;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: search/domains/route-finding
;;;; Find a Route Between Cities on a Map
(defun route-finding-problem (&key (n-cities 10)
(map (random-route-map :n-cities n-cities))
(start (city-name (random-element map)))
(goal (city-name (random-element map))))
"Create a route-finding problem, using a random map, unless you explicitly
specify the :map argument."
(let ((goal-city (find-city goal map)))
(make-problem
:initial-state start
:successor-fn #'(lambda (x) (route-finding-successors x map))
:goal-test #'(lambda (x) (equal x goal))
:h-cost-fn #'(lambda (x)
(straight-distance (find-city x map) goal-city))
:edge-cost-fn #'(lambda (x y)
(road-distance (find-city x map) y map))
:domain "Route Finding"
)))
;;; We define two data structures in this file:
;;; city - A structure holding a name, location, and neighbors
;;; map - A list of cities
;;; A state in a route-finding problem is just the name of the current
;;; city. We can use this name to lookup on a map and find a city
;;; structure, which contains the cities location (an (x y) pair) and
;;; a list of neighboring cities, and the distance along the road to
;;; each neighbor. Be careful to distinguish between a city name and
;;; a city structure. Note that a more complicated version of this
;;; problem would augment the state with considerations of time, gas
;;; used, wear on car, tolls to pay, etc.
(defstruct (city (:type list))
name loc neighbors)
(defun route-finding-successors (city-name map)
"Return a list of (action . new-state) pairs.
In this case, the action and the new state are both the name of the city."
(with-collection ()
(for each pair in (city-neighbors (find-city city-name map)) do
(collect (cons (first pair) (first pair))))))
(defun road-distance (city1 city-name2 map)
"The distance along the road between two cities. The first is a city
structure, the second just the name of the intended destination."
(declare (ignore map))
(cdr (assoc city-name2 (city-neighbors city1))))
(defun straight-distance (city1 city2)
"Distance between two cities on a straight line (as the crow flies)."
;; We round this to the nearest integer, just to make things easier to read
(round (xy-distance (city-loc city1) (city-loc city2))))
(defun find-city (name map)
"Look up the city on the map, and return its information."
(assoc name map))
(defun random-route-map (&key (n-cities 10) (width 100) (height 100)
(min-roads 2) (max-roads (+ min-roads 3)))
"Return a random map with n-cities in it, and some roads between them.
Each city is connected to between MIN-ROADS and MAX-ROADS other cities.
The default is from 2 to 5. The road between any two cities has a length
of 1 to 1.5 times the straight-line distance between them."
;; First build the cities
(let ((map (with-collection ()
(for i = 1 to n-cities do
(collect
(make-city :name (number->name i) :neighbors nil
:loc (# (random width) (random height))))))))
;; Now lay down the roads
;; CANDIDATES is all the cities that don't yet have a road to CITY
;; SORTED-NEIGHBORS is sorted by distance to CITY, closest first
;; We pick out the first
(for each city in map do
(let* ((n-roads (- (random-integer min-roads max-roads)
(length (city-neighbors city))))
(candidates
(remove-if #'(lambda(c)
(or (eq c city)
(assoc (city-name c)
(city-neighbors city))))
map))
(sorted-neighbors
(sort candidates #'<
:key #'(lambda (city2)
(straight-distance city city2)))))
(for each city2 in (subseq sorted-neighbors 0 (max n-roads 0)) do
(build-road city city2))))
map))
(defun build-road (city1 city2)
"Construct a road between two cities."
(let* ((distance (straight-distance city1 city2))
(road-distance (round (* (+ 1.0 (random 0.5)) distance))))
(push (cons (city-name city1) road-distance) (city-neighbors city2))
(push (cons (city-name city2) road-distance) (city-neighbors city1))))
(defun number->name (i)
"Turn an integer into a symbol. 1-26 go to A-Z; beyond that use Ci"
(if (<= 1 i 26)
(aref '#(0 a b c d e f g h i j k l m n o p q r s t u v w x y z) i)
(intern (format nil "C~D" i))))
;;;; The Romanian Map
(defparameter *romania-map*
'(
(Arad ( 91 492) ((Zerind . 75) (Sibiu . 140) (Timisoara . 118)))
(Bucharest (400 327) ((Fagaras . 211) (Pitesti . 101) (Giurgiu . 90)
(Urziceni . 85)))
(Craiova (253 288) ((Dobreta . 120) (Rimnicu . 146) (Pitesti . 138)))
(Dobreta (165 299) ((Mehadia . 75) (Craiova . 120)))
(Eforie (562 293) ((Hirsova . 86)))
(Fagaras (305 449) ((Sibiu . 99) (Bucharest . 211)))
(Giurgiu (375 270) ((Bucharest . 90)))
(Hirsova (534 350) ((Urziceni . 98) (Eforie . 86)))
(Iasi (473 506) ((Neamt . 87) (Vaslui . 92)))
(Lugoj (165 379) ((Timisoara . 111) (Mehadia . 70)))
(Mehadia (168 339) ((Lugoj . 70) (Dobreta . 75)))
(Neamt (406 537) ((Iasi . 87)))
(Oradea (131 571) ((Zerind . 71) (Sibiu . 151)))
(Pitesti (320 368) ((Rimnicu . 97) (Craiova . 138) (Bucharest . 101)))
(Rimnicu (233 410) ((Sibiu . 80) (Pitesti . 97) (Craiova . 146)))
(Sibiu (207 457) ((Arad . 140) (Oradea . 151) (Fagaras . 99)
(Rimnicu . 80)))
(Timisoara ( 94 410) ((Arad . 118) (Lugoj . 111)))
(Urziceni (456 350) ((Bucharest . 85) (Hirsova . 98) (Vaslui . 142)))
(Vaslui (509 444) ((Iasi . 92) (Urziceni . 142)))
(Zerind (108 531) ((Arad . 75) (Oradea . 71)))
)
"A representation of the map in Figure 4.2 [p 95].
But note that the straight-line distances to Bucharest are NOT the same.")
(defun romanian-problem (&key (start 'Arad) (goal 'Bucharest))
"Problem: Find a path between two cities in Romania."
(route-finding-problem :start start :goal goal :map *romania-map*))
(defun random-romanian-problem ()
"Problem: Find a path between two random cities in Romania."
(romanian-problem :start (city-name (random-element *romania-map*))
:goal (city-name (random-element *romania-map*))))
It seems that you didn't define the random-element function!
try to define it, something like this:
(defun random-element (list)
"Return some element of the list, chosen at random."
(nth (random (length list)) list))
It looks to me like you are using an example from Peter Norvig's book which I really like but which I would not consider to be the first book if you want to learn Common Lisp. You will find advices for beginners in the wiki for the 'common-lisp' tag.
Nevertheless, in the example source code of PAIP you will find a function distance which should be what you are looking for.

LISP global alist variable

I am new to LISP, and here is the question I have with its global variable.
What I am trying to do is to create a "alist" that can store key-value pairs in a structure. Here is my sample code:
(setq *x* '())
(acons 'apple 'fruit *x*)
*x*
(first *x*)
I want my output looks like, after I add the (apple.fruit) pair, x should be ((apple.fruit)), but here is what I got (on loading of the above code):
CL-USER>
NIL
((APPLE . FRUIT))
NIL <--- this is still nil?
NIL
Can anyone please help me with this, since I am not sure why I can not add value to the variable x.
Also, I have another question regarding to the alist: is there a way to look up element in the a list by a key? for example, for the above list, how can I use the key apple to find its corresponding value fruit?
thank you
The function acons has no side effects, i.e. it doesn't modify *x*.
You have to setq the result to get the result of the acons to stick in *x*:
(setq *x* (acons 'apple 'fruit *x*))
If you want to do Functional Programming, then mutable global variables are definitely not a way to go.
Functional Programming is mostly concerned with computation by calling functions with arguments.
Often solutions are recursive.
Let's say, we have a list of fruits and their prices and we want to have a price sum for each fruit category. Let's try a recursive solution using ACONS.
(defun note-category-price (type price sums)
(let ((pair (assoc type sums)))
(if pair
(progn (incf (cdr pair) price) sums)
(acons type price sums))))
In above function you can see that the function directly returns the result of calling ACONS. It is not stored.
(defun compute-price-sums (data sums)
(if (null data)
sums
(compute-price-sums (rest (rest data))
(note-category-price (first data)
(second data)
sums))))
In above function the extended data structure will be used in the recursive call.
Example:
CL-USER 22 > (compute-price-sums
'(apple 10 orange 20 banana 10 apple 20
grape 5 orange 75 apple 30 peach 30
orange 90 apple 20)
nil)
((PEACH . 30) (GRAPE . 5) (BANANA . 10) (ORANGE . 185) (APPLE . 80))

Resources