I'm trying to code small program, ancient game Hamurabi in Scheme (guile to be exact). I want to learn about preferred approach to "design" of such program, extensively dealing with user input. E.g. using loops, mutable or immutable variables etc.
I have some working variants which I don't like well. I believe I miss some better approach. Below are details. Sorry for long explanations.
The game itself is simple "economics" simulation - we have 3 values, for population of our kingdom, land area and amount of grain (also serving as currency). Player rules for several years, choosing each year consecutively:
how many land to buy or sell for grain
then how many grain to use for feeding people
at last how many grain to use for sowing
So we have outer loop with iterations representing years. Inside we have three steps. First changes amounts of area and grain. Second
changes amounts of grain and population. Third is changing amount of grain (with respect to available land and people to tend fields). The fourth step (without user input) determines how many new crops we gathered and what was eaten by rats (i.e. increases amount of grain).
This can easily be done with using global variables and (set! ...) forms. However I wonder to find way to code this in more "functional style". It seems I then need to use several mutually recursive (tail-optimized) functions to represent steps. And pass changed values as parameters each time. Here is gist with this approach implemented with only step of buying/selling land. And it works like this:
You have 100 people, 700 acres of land and 9600 bushels of grain.
Land trades at 24 bushels of grain for acre
How many acres to buy? -100
You have 100 people, 600 acres of land and 12000 bushels of grain.
Land trades at 21 bushels of grain for acre
How many acres to buy? 200
It is not very convenient as there would be many small functions and most of them need all variables even though some are passed through. And besides the pop, area and grain we need some accumulators (e.g. total people died of starvation).
So I created two functions to maintain immutable key-value structure like
(list (cons 'pop 100) (cons 'area 1000) (cons 'grain 2800))
And use them as state passed to every function. prop-get fetches value by key from the state while prop-set returns modified copy (I suspect there is some similar structure already implemented in library).
(load "props.scm")
(define (one-year state)
(map display
(list "You have "
(prop-get state 'pop) " people, "
(prop-get state 'area) " acres of land and "
(prop-get state 'grain) " bushels of grain."))
(newline)
(let ((state-upd (buy-land state)))
(step-2 state-upd)))
(define (buy-land state)
(let ((price (+ (random 10) 17))
(area (prop-get state 'area))
(grain (prop-get state 'grain)))
(map display
(list "Land trades at " price " bushels of grain for acre"))
(newline)
(display "How many acres to buy? ")
(let ((b (read)))
(prop-set (prop-set state 'area (+ area b)) 'grain (- grain (* price b))))))
Please here is the complete code in another gist.
This is somewhat better but still the complete code is a bit verbose with all those prop-gets, lets and mutual recursion.
What other options could be here? I think there is "intermediate" solution between mutable global variables and immutables with tail recursion - like using named let for outer loop and some mutable structure to hold the state in a local variable. But I feel like I may be miss something more simple and elegant.
If you want to use a purely functionnal approach, you need to pass a state variable from one place to another.
We can use an association list to store elements, and since in Hammurabi the game finishes in 10 steps, we can easily use the state variable as a journal, a log of all events that happened in the game.
Association lists have the property that mappings can occur multiple times, but only the first match is returned.
So basically, if the state is ((population . 100) (population . 30)), then it means the current population is 100, and at the previous turn it was 30. We store all values in slots, which means we can perfom statistics on the resulting game as much as we want.
For exemple, the initial state is:
(define initial-state '((population . 100)
(acres . 1000)
(grain . 3000)
(year . 0)))
We can hide the specific implementation details behind auxiliary accessor functions:
(define (value state slot)
(cdr (assoc slot state)))
And also, we can use a useful syntax to add multiple elements at once in a state:
(define (extend0 state key/values)
(if (null? key/values)
state
(let ((key (car key/values))
(val (cadr key/values))
(tail (cddr key/values)))
(extend0 (acons key val state) tail))))
(define (extend state . key/values)
(extend0 state key/values))
So, for example, you can do:
(extend initial-state 'grain 1000 'population 200)
$1 = ((population . 200) (grain . 1000) (population . 100) (acres . 1000) (grain . 3000) (year . 0))
We can also define accessors for common slots:
(define (getter slot)
(lambda (state)
(value state slot)))
(define (setter slot)
(lambda (state value)
(acons slot value state)))
(define population (getter 'population))
(define set-population (setter 'population))
(define acres (getter 'acres))
(define set-acres (setter 'acres))
(define grain (getter 'grain))
(define set-grain (setter 'grain))
(define price (getter 'price))
(define set-price (setter 'price))
(define year (getter 'year))
(define set-year (setter 'year))
You could also shorten the above with a macro. The approach here consists in designing little auxiliary functions along the way, to ensure that the actual code we write is as expressive as we want it to be.
Also, test often and in isolation, which is easier to do when no internal state is involved.
Define also a smart object printer:
(define (echo items state)
(if (list? items)
(map (lambda (u)
(cond
((null? u) (newline))
((symbol? u) (display (value state u)))
((procedure? u) (display (u)))
(else (display u))))
items)
(begin (display items) (newline)))
state)
... and a generic prompt:
(define (prompt state message tester setter)
(echo message state)
(let ((value (read)))
(if (tester value)
(setter state value)
(prompt state message tester setter))))
Once all the vocabulary is in place, here is how you could write buy-land:
(define (buy-land state)
(let ((max-acres (floor/ (grain state) (price state))))
(if (zero? max-acres)
(echo "You cannot buy any acre." state)
(prompt state
`("Land trades at " price " bushels of grain for acre." ()
"You have " grain " bushel(s) of grain." ()
"How many acres to buy (0-" ,max-acres ")? ")
(lambda (v) (and (integer? v) (<= 0 v max-acres)))
(lambda (state buy)
(extend state
'buy buy
'acres (+ (acres state) buy)
'grain (- (grain state)
(* buy (price state)))))))))
You can split functions into little ones that do less things, but that compose better:
(define (random-events state)
(let ((starve (random 20)))
(extend state
'starve starve
'price (+ 17 (random 10))
'population (max 0 (- (population state) starve)))))
(define (game-step state)
(if (= (year state) 10)
(end-game state)
(let ((state (set-year state (+ 1 (year state)))))
(display-new-year-text state)
(let ((state (random-events state)))
(game-step (buy-land state))))))
(define hammurabi
(game-step initial-state))
Related
I have a recursive function that counts the number of occourances in a file.
A common task I like to do is report the outcome of a function with a format:
(defun csv-counter (list)
(let ((counter 0)
(email (first list)))
(if (null list)
nil
(progn
(+ 1 (count email list :test #'string=))
(incf counter)
(csv-counter (rest list))))
(format t "count for email ~a is ~a~%" email counter)))
The counter number in the format function doesnt actually accumulate the total number, instead it reports each occurance as 1
...
count for email fred#test.com is 1
count for email fred#test.com is 1
count for email fred#test.com is 1
...
What am I doing wrong?
It is unclear what your function is meant to do or what you are trying to achieve. Even so it's possible to say some things about it. Below I have reindented it and annotated some points with numbers
(defun csv-counter (list)
(let ((counter 0)
(email (first list)))
;; (0)
(if (null list)
nil
(progn
(+ 1 (count email list :test #'string=)) ;(1)
(incf counter) ;(2)
(csv-counter (rest list))))
;; (3)
(format t "count for email ~a is ~a~%" email counter)))
At (0) counter will be zero, on every call.
At (1) is an expression, (+ 1 (count email list :test #'string=)) whose value is not used. So this expression does not do anything useful at all: it merely serves to make the time complexity quadratic rather than linear.
At (2) counter is incremented by 1, which means it will now be 1. The result of (2) is that, if the list is not empty, the value of counter will be 1.
At (3) this value is reported: it will be 1 if the list is not empty, 0 otherwise.
So we get:
count for email nil is 0
count for email fish#bat is 1
count for email foo#bar is 1
count for email foo#bar is 1
Now, as I said above, it is not clear what you are trying to achieve. However, it might be to count the number of distinct occurrences of each email address (represented as a string) in a list of them. So for instance, given ("foo#bar" "foo#bar" "fish#bat") you want a count of 2 for "foo#bar and of 1 for "fish#bat".
In order to do this you need two things: a count for each email, and a notion of which emails you have seen. The second is crucial.
So here is an initial approach to doing this:
(defun count-distinct-emails (emails)
(labels ((cde-loop (tail seen counts)
(cond
((null tail)
counts)
((member (first tail) seen :test #'string=)
;; already counted this one
(cde-loop (rest tail) seen counts))
(t
;; a new email
(let ((email (first tail))
(more (rest tail)))
(cde-loop more
(cons email seen)
(acons email (+ 1 (count email more :test #'string=)) counts)))))))
(cde-loop emails '() '())))
This function is not itself recursive, but it has a recursive helper function, cde-loop, which is written as an internal definition. It is written as an internal function to avoid the nightmare of needing all sorts of weird extra, perhaps optional, arguments to the function you actually call and because it is not called by any other function than its parent. In cde-loop you can see that it maintains a table (a list) of emails it has seen, and builds up another table (an alist) of addresses with counts.
For this function:
> (count-distinct-emails '("foo#bar" "foo#bar" "fish#bat"))
(("fish#bat" . 1) ("foo#bar" . 2))
And you can then write a little reporter function:
(defun report-emails (table)
(dolist (email&count table)
(format t "~&count for ~A: ~D~%"
(car email&count) (cdr email&count))))
So:
> > (report-emails (count-distinct-emails '("foo#bar" "foo#bar" "fish#bat")))
count for fish#bat: 1
count for foo#bar: 2
nil
Now count-distinct-emails is horrible: not because it's recursive (any reasonable implementation will turn that into a loop) but because it's repeatedly probing the list of things it has seen and the list of emails it is looking for. A much better approach is to unify these two things into one thing, and use a hashtable which has better search performance:
(defun count-distinct-emails (emails)
(labels ((cde-loop (tail table)
(if (null tail)
table
(progn
(incf (gethash (first tail) table 0))
(cde-loop (rest tail) table)))))
(cde-loop emails (make-hash-table :test #'equal))))
And then the reporter function needs to know to use a hashtable as well:
(defun report-emails (table)
(maphash (lambda (email count)
(format t "~&count for ~A: ~D~%"
email count))
table))
Note that cde-loop uses a nice trick: it says (incf (gethash (first tail) table 0)): incf knows how to increment the value of an entry in a hashtable, and using the default of 0 when the entry is not present means that the entry will spring into being so you don't have to do the awkward 'check if entry is present, increment if so' thing yourself.
Finally, once you've given in and used a hashtable, this is a case where a straightforward iterative solution is probably clearer:
(defun count-distinct-emails (emails)
(let ((table (make-hash-table :test #'equal)))
(dolist (email emails table)
(incf (gethash email table 0)))))
For completeness I think you could use remove-duplicates here:
(defun count-distinct-emails (emails)
(length (remove-duplicates emails :test #'string=)))
I am trying to compare the performance of a function and a macro.
EDIT: Why do I want to compare the two?
Paul Graham wrote in his ON LISP book that macros can be used to make a system more efficient because a lot of the computation can be done at compile time. so in the example below (length args) is dealt with at compile time in the macro case and at run time in the function case. So, I just wanted how much faster did (avg2 super-list) get computed relative to (avg super-list).
Here is the function and the macro:
(defun avg (args)
(/ (apply #'+ args) (length args)))
(defmacro avg2 (args)
`(/ (+ ,#args) ,(length args)))
I have looked at this question How to pass a list to macro in common lisp? and a few other ones but they do not help because their solutions do not work; for example, in one of the questions a user answered by saying to do this:
(avg2 (2 3 4 5))
instead of this:
(avg2 '(2 3 4))
This works but I want a list containg 100,000 items:
(defvar super-list (loop for i from 1 to 100000 collect i))
But this doesnt work.
So, how can I pass super-list to avg2?
First of all, it simply makes no sense to 'compare the performance of a function and a macro'. It only makes sense to compare the performance of the expansion of a macro with a function. So that's what I'll do.
Secondly, it only makes sense to compare the performance of a function with the expansion of a macro if that macro is equivalent to the function. In other words the only places this comparison is useful is where the macro is being used as a hacky way of inlining a function. It doesn't make sense to compare the performance of something which a function can't express, like if or and say. So we must rule out all the interesting uses of macros.
Thirdly it makes no sense to compare the performance of things which are broken: it is very easy to make programs which do not work be as fast as you like. So I'll successively modify both your function and macro so they're not broken.
Fourthly it makes no sense to compare the performance of things which use algorithms which are gratuitously terrible, so I'll modify both your function and your macro to use better algrorithms.
Finally it makes no sense to compare the performance of things without using the tools the language provides to encourage good performance, so I will do that as the last step.
So let's address the third point above: let's see how avg (and therefore avg2) is broken.
Here's the broken definition of avg from the question:
(defun avg (args)
(/ (apply #'+ args) (length args)))
So let's try it:
> (let ((l (make-list 1000000 :initial-element 0)))
(avg l))
Error: Last argument to apply is too long: 1000000
Oh dear, as other people have pointed out. So probably I need instead to make avg at least work. As other people have, again, pointed out, the way to do this is reduce:
(defun avg (args)
(/ (reduce #'+ args) (length args)))
And now a call to avg works, at least. avg is now non-buggy.
We need to make avg2 non-buggy as well. Well, first of all the (+ ,#args) thing is a non-starter: args is a symbol at macroexpansion time, not a list. So we could try this (apply #'+ ,args) (the expansion of the macro is now starting to look a bit like the body of the function, which is unsurprising!). So given
(defmacro avg2 (args)
`(/ (apply #'+ ,args) (length ,args)))
We get
> (let ((l (make-list 1000000 :initial-element 0)))
(avg2 l))
Error: Last argument to apply is too long: 1000000
OK, unsurprising again. let's fix it to use reduce again:
(defmacro avg2 (args)
`(/ (reduce #'+ ,args) (length ,args)))
So now it 'works'. Except it doesn't: it's not safe. Look at this:
> (macroexpand-1 '(avg2 (make-list 1000000 :initial-element 0)))
(/ (reduce #'+ (make-list 1000000 :initial-element 0))
(length (make-list 1000000 :initial-element 0)))
t
That definitely is not right: it will be enormously slow but also it will just be buggy. We need to fix the multiple-evaluation problem.
(defmacro avg2 (args)
`(let ((r ,args))
(/ (reduce #'+ r) (length r))))
This is safe in all sane cases. So this is now a reasonably safe 70s-style what-I-really-want-is-an-inline-function macro.
So, let's write a test-harness both for avg and avg2. You will need to recompile av2 each time you change avg2 and in fact you'll need to recompile av1 for a change we're going to make to avg as well. Also make sure everything is compiled!
(defun av0 (l)
l)
(defun av1 (l)
(avg l))
(defun av2 (l)
(avg2 l))
(defun test-avg-avg2 (nelements niters)
;; Return time per call in seconds per iteration per element
(let* ((l (make-list nelements :initial-element 0))
(lo (let ((start (get-internal-real-time)))
(dotimes (i niters (- (get-internal-real-time) start))
(av0 l)))))
(values
(let ((start (get-internal-real-time)))
(dotimes (i niters (float (/ (- (get-internal-real-time) start lo)
internal-time-units-per-second
nelements niters)))
(av1 l)))
(let ((start (get-internal-real-time)))
(dotimes (i niters (float (/ (- (get-internal-real-time) start lo)
internal-time-units-per-second
nelements niters)))
(av2 l))))))
So now we can test various combinations.
OK, so now the fouth point: both avg and avg2 use awful algorithms: they traverse the list twice. Well we can fix this:
(defun avg (args)
(loop for i in args
for c upfrom 0
summing i into s
finally (return (/ s c))))
and similarly
(defmacro avg2 (args)
`(loop for i in ,args
for c upfrom 0
summing i into s
finally (return (/ s c))))
These changes made a performance difference of about a factor of 4 for me.
OK so now the final point: we should use the tools the language gives us. As has been clear throughout this whole exercise only make sense if you're using a macro as a poor-person's inline function, as people had to do in the 1970s.
But it's not the 1970s any more: we have inline functions.
So:
(declaim (inline avg))
(defun avg (args)
(loop for i in args
for c upfrom 0
summing i into s
finally (return (/ s c))))
And now you will have to make sure you recompile avg and then av1. And when I look at av1 and av2 I can now see that they are the same code: the entire purpose of avg2 has now gone.
Indeed we can do even better than this:
(define-compiler-macro avg (&whole form l &environment e)
;; I can't imagine what other constant forms there might be in this
;; context, but, well, let's be safe
(if (and (constantp l e)
(listp l)
(eql (first l) 'quote))
(avg (second l))
form))
Now we have something which:
has the semantics of a function, so, say (funcall #'avg ...) will work;
isn't broken;
uses a non-terrible algorithm;
will be inlined on any competent implementation of the language (which I bet is 'all implementations' now) when it can be;
will detect (some?) cases where it can be compiled completely away and replaced by a compile-time constant.
Since the value of super-list is known, one can do all computation at macro expansion time:
(eval-when (:execute :compile-toplevel :load-toplevel)
(defvar super-list (loop for i from 1 to 100000 collect i)))
(defmacro avg2 (args)
(setf args (eval args))
(/ (reduce #'+ args) (length args)))
(defun test ()
(avg2 super-list))
Trying the compiled code:
CL-USER 10 > (time (test))
Timing the evaluation of (TEST)
User time = 0.000
System time = 0.000
Elapsed time = 0.000
Allocation = 0 bytes
0 Page faults
100001/2
Thus the runtime is near zero.
The generated code is just a number, the result number:
CL-USER 11 > (macroexpand '(avg2 super-list))
100001/2
Thus for known input this macro call in compiled code has a constant runtime of near zero.
I don't think you really want a list of 100,000 items. That would have terrible performance with all that cons'ing. You should consider a vector instead, e.g.
(avg2 #(2 3 4))
You didn't mention why it didn't work; if the function never returns, it's likely a memory issue from such a large list, or attempting to apply on such a large function argument list; there are implementation defined limits on how many arguments you can pass to a function.
Try reduce on a super-vector instead:
(reduce #'+ super-vector)
I am reading Structure and Interpretation of Computer Programs (SICP) and would like to make sure that my thinking is correct.
Consider the following simple stream using the recursive definition:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define ints (integers-starting-from 1))
(car (cdr-stream (cdr-stream (cdr-stream (cdr-stream ints)))))
If we adopt the implementation in SICP, whenever we cons-stream, we are effectively consing a variable and a lambda function (for delayed evaluation). So as we cdr-stream along this stream, nested lambda functions are created and a chain of frames is stored for the evaluation of lambda functions. Those frames are necessary since lambda functions evaluate expressions and find them in the enclosing frame. Therefore, I suppose that in order to evaluate the n-th element of the stream, you need to store n extra frames that take up linear space.
This is different from the behavior of iterators in other languages. If you need to go far down the stream, much space will be taken. Of course, it is possible to only keep the direct enclosing frame and throw away all the other ancestral frames. Is this what the actual scheme implementation does?
Short answer, yes, under the right circumstances the directly enclosing environment is thrown away.
I don't think this would happen in the case of (car (cdr-stream (cdr-stream (cdr-stream (... but if you instead look at stream-refin sect. 3.5.1:
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
and if you temporarily forget what you know about environment frames but think back to Chapter 1 and the disussion of recursive vs iterative processes, then this is a iterative process because the last line of the body is a call back to the same function.
So perhaps your question could be restated as: "Given what I know now about the environmental model of evaluation, how do iterative processes use constant space?"
As you say it's because the ancestral frames are thrown away. Exactly how this happens is covered later in the book in chapter 5, e.g., sect. 4.2 "Sequence Evaluation and Tail Recursion", or if you like the videos of the lectures, in lecture 9b.
A significant part of Chapter 4 and Chapter 5 covers the details necessary to answer this question explicitly. Or as the authors put it, to dispel the magic.
I think it's worth pointing out that the analysis of space usage in cases like this is not always quite simple.
For instance here is a completely naïve implementation of force & delay in Racket:
(define-syntax-rule (delay form)
(λ () form))
(define (force p)
(p))
And we can build enough of something a bit compatible with SICP streams to be dangerous on this:
(define-syntax-rule (cons-stream kar kdr)
;; Both car & cdr can be delayed: why not? I think the normal thing is
;; just to delay the cdr
(cons (delay kar) (delay kdr)))
(define (stream-car s)
(force (car s)))
(define (stream-cdr s)
(force (cdr s)))
(define (stream-nth s n)
(if (zero? n)
(stream-car s)
(stream-nth (stream-cdr s) (- n 1))))
(Note there is lots missing here because I am lazy.)
And on that we can build streams of integers:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
And now we can try this:
(define naturals (integers-starting-from 0))
(stream-nth naturals 10000000)
And this last thing returns 10000000, after a little while. And we can call it several times and we get the same answer each time.
But our implementation of promises sucks: forcing a promise makes it do work each time we force it, and we'd like to do it once. Instead we could memoize our promises so that doesn't happen, like this (this is probably not thread-safe: it could be made so):
(define-syntax-rule (delay form)
(let ([thunk/value (λ () form)]
[forced? #f])
(λ ()
(if forced?
thunk/value
(let ([value (thunk/value)])
(set! thunk/value value)
(set! forced? #t)
value)))))
All the rest of the code is the same.
Now, when you call (stream-nth naturals 10000000) you are probably going to have a fairly bad time: in particular you'll likely run out of memory.
The reason you're going to have a bad time is two things:
there's a reference to the whole stream in the form of naturals;
the fancy promises are memoizing their values, which are the whole tail of the stream.
What this means is that, as you walk down the stream you use up increasing amounts of memory until you run out: the space complexity of the program goes like the size of the argument to stream-nth in the last line.
The problem here is that delay is trying to be clever in a way which is unhelpful in this case. In particular if you think of streams as objects you traverse generally once, then memoizing them is just useless: you've carefully remembered a value which you will never use again.
The versions of delay & force provided by Racket memoize, and will also use enormous amounts of memory in this case.
You can avoid this either by not memoizing, or by being sure never to hold onto the start of the stream so the GC can pick it up. In particular this program
(define (silly-nth-natural n)
(define naturals (integers-starting-from 0))
(stream-nth naturals n))
will not use space proportional to n, because once the first tail call to stream-nth is made there is nothing holding onto the start of the stream any more.
Another approach is to make the memoized value be only weakly held, so that if the system gets desperate it can drop it. Here's a hacky and mostly untested implementation of that (this is very Racket-specific):
(define-syntax-rule (delay form)
;; a version of delay which memoizes weakly
(let ([thunk (λ () form)]
[value-box #f])
(λ ()
(if value-box
;; the promise has been forced
(let ([value-maybe (weak-box-value value-box value-box)])
;; two things that can't be in the box are the thunk
;; or the box itself, since we made those ourselves
(if (eq? value-maybe value-box)
;; the value has been GCd
(let ([value (thunk)])
(set! value-box (make-weak-box value))
value)
;; the value is good
value-maybe))
;; the promise has not yet been forced
(let ((value (thunk)))
(set! value-box (make-weak-box value))
value)))))
I suspect that huge numbers of weak boxes may make the GC do a lot of work.
"nested lambda functions are created"
nope. There is no nested scope. In
(define integers-starting-from
(lambda (n)
(cons-stream n (integers-starting-from (+ n 1)))))
the argument to the nested call to integers-starting-from in the (integers-starting-from (+ n 1)) form, the expression (+ n 1), refers to the binding of n in the original call to (integers-starting-from n), but (+ n 1) is evaluated before the call is made.
Scheme is an eager programming language, not a lazy one.
Thus the lambda inside the result of cons-stream holds a reference to the call frame, yes, but there is no nesting of environments. The value is already obtained before the new lambda is created and returned as part of the next cons cell representing the stream's next state.
(define ints (integers-starting-from 1))
=
(define ints (let ((n 1))
(cons-stream n (integers-starting-from (+ n 1)))))
=
(define ints (let ((n 1))
(cons n (lambda () (integers-starting-from (+ n 1))))))
and the call proceeds
(car (cdr-stream (cdr-stream ints)))
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints ((cdr ints)))
(cdr-cdr-ints ((cdr cdr-ints)))
(res (car cdr-cdr-ints)))
res)
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints ((cdr ints))
=
((let ((n 1))
(lambda () (integers-starting-from (+ n 1)))))
=
(integers-starting-from 2) ;; args before calls!
=
(let ((n 2))
(cons n
(lambda () (integers-starting-from (+ n 1)))))
)
(cdr-cdr-ints ((cdr cdr-ints)))
(res (car cdr-cdr-ints)))
res)
=
(let* ((ints (let ((n 1))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-ints (let ((n 2))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(cdr-cdr-ints (let ((n 3))
(cons n
(lambda () (integers-starting-from (+ n 1))))))
(res (car cdr-cdr-ints)))
res)
=
3
So there is no nested lambdas here. Not even a chain of lambdas, because the implementation is non-memoizing. The values for cdr-ints and cdr-cdr-ints are ephemeral, liable to be garbage-collected while the 3rd element is being calculated. Nothing holds any reference to them.
Thus getting the nth element is done in constant space modulo garbage, since all the interim O(n) space entities are eligible to be garbage collected.
In (one possible) memoizing implementation, each lambda would be actually replaced by its result in the cons cell, and there'd be a chain of three -- still non-nested -- lambdas, congruent to an open-ended list
(1 . (2 . (3 . <procedure-to-go-next>)))
In programs which do not hold on to the top entry of such chains, all the interim conses would be eligible for garbage collection as well.
One such example, even with the non-memoizing SICP streams, is the sieve of Eratosthenes. Its performance characteristics are consistent with no memory retention of the prefix portions of its internal streams.
I am studying the SICP book with Racket and Dr. Racket. I am also watching the lectures on:
https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/video-lectures/5a-assignment-state-and-side-effects/
At chapter 3, the authors present the concept of imperative programming.
Trying to illustrate the meaning, they contrast an implementation of a factorial procedure using functional programming and to one which used imperative programming.
Bellow you have a recursive definition of an iterative procedure using functional programming:
(define (factorial-iter n)
(define (iter n accu)
(if (= n 0)
accu
(iter (- n 1) (* accu n))))
; (trace iter)
(iter n 1))
Before the professor was going to present an imperative implementation, I tried myself.
I reached this code using the command "set!":
(define (factorial-imp n count product)
(set! product 1)
(set! count 1)
(define (iter count product)
(if (> count n)
product
(iter (add1 count) (* product count))))
(iter count product))
However, the professor's implementation is quite different of my imperative implementation:
(define (factorial-imp-sicp n)
(let ((count 1) (i 1))
(define (loop)
(cond ((> count n) i)
(else (set! i (* count i))
(set! count (add1 count))
(loop))))
(loop)))
Both codes, my implementation and the professor's code, reach the same results. But I am not sure if they have the same nature.
Hence, I started to ask myself: was my implementation really imperative? Just using "set!" guaranties that?
I still use parameters in my auxiliary iterative procedure while the professor's auxiliary iterative function does not have any argument at all. Is this the core thing to answer my question?
Thanks! SO users have been helping me a lot!
Your solution is splendidly mad, because it looks imperative, but it really isn't. (Some of what follows is Racket-specific, but not in any way that matters.)
Starting with your implementation:
(define (factorial-imp n count product)
(set! product 1)
(set! count 1)
(define (iter count product)
(if (> count n)
product
(iter (add1 count) (* product count))))
(iter count product))
Well, the only reason for the count and product arguments is to create bindings for those variables: the values of the arguments are never used. So let's do that explicitly with let, and I will bind them initially to an undefined object so it's clear the binding is never used (I have also renamed the arguments to the inner function so it is clear that these are different bindings):
(require racket/undefined)
(define (factorial-imp n)
(let ([product undefined]
[count undefined])
(set! product 1)
(set! count 1)
(define (iter c p)
(if (> c n)
p
(iter (add1 c) (* p c))))
(iter count product)))
OK, well, now it is obvious that any expression of the form (let ([x <y>]) (set! x <z>) ...) can immediately be replaced by (let ([x <z>]) ...) so long as whatever <y> is has no side effects and terminates. That is the case here, so we can rewrite the above as follows:
(define (factorial-imp n)
(let ([product 1]
[count 1])
(define (iter c p)
(if (> c n)
p
(iter (add1 c) (* p c))))
(iter count product)))
OK, so now we have something of the form (let ([x <y>]) (f x)): this can be trivially be replaced by (f <y>):
(define (factorial-imp n)
(define (iter c p)
(if (> c n)
p
(iter (add1 c) (* p c))))
(iter 1 1))
And now it is quite clear that your implementation is not, in fact, imperative in any useful way. It does mutate bindings, but it does so only once, and never uses the original binding before the mutation. This is essentially something which compiler writers call 'static single assignment' I think: each variable is assigned once and not used before it is assigned to.
PS: 'splendidly mad' was not meant as an insult, I hope it was not taken as such, I enjoyed answering this!
Using set! introduces side effects by changing a binding, however you change it from the passed value to 1 without using the passed value and you never change the value afterwards one might look at it as if 1 and 1 were constants passed to the helper like this:
(define (factorial-imp n ignored-1 ignored-2)
(define (iter count product)
(if (> count n)
product
(iter (add1 count) (* product count))))
(iter 1 1))
The helper updates it's count and product by recursing and thus is 100% functional.
If you were to do the same in an imperative language you would have made a variable outside a loop that you would update at each step in a loop, just like the professors implementation.
In your version you have altered the contract. The user needs to pass two arguments that are not used for anything. I've illustrated that by calling them ignored-1 and ignored-2.
I am new to Lisp and have an issue regarding recursion and function returns. In the interests of trying to better understand and solve my problem, I provide the following scenario. I apologize if it is verbose. If this aggravates others, I'm happy to trim it down. To skip right to the business, please read from the horizontal line onward.
Imagine a waitress at a bar. Instead of taking drink orders, she forces her patrons to identify themselves as drinkers of beer, rum, whiskey, or some combination of these. Then she grabs a tray full of either beer, rum or whiskey and does a lap around the bar, leaving exactly one drink with any customer who has identified themself as a drinker of that particular beverage. When she's finished each round, she always sits down and has a Long Island Ice Tea. Afterward, she proceeds to grab another tray of exclusively one type of drink and goes out for delivery again. No customer can ever refuse a drink, and no one can change their drink preferences.
Now, Mindy (the waitress) needs a novel way of keeping track of how many drinks of each type she is delivering to each patron. Mindy isn't very good at math and by the end of the night all of those Long Island Ice Teas are really adding up.
So when she asked for a simple solution for tracking her drink dispensing, I naturally suggested creating a simple little Lisp program. Here's how it is to work: When she has finished delivering a round of tasty beverages, Mindy simply walks up to her Altair 8800 and types the following:
(update-orders <order-list> <drink>)
where is the list of all customers and their orders, and is the drink she just served in her most recent outing.
It should properly go through the lists of customers and their drink counts, updating the proper drinks by one and leaving the others alone. To interface with the computer system in place, a newly-updated orders-list needs to be returned from the function when it is complete.
Just today I came across the following bug: after properly calling the function, the value returned is not what I want. The list only includes the very last drink count list of the very first customer in the list, every time. Recursive programming is the real culprit here, as opposed to Lisp, and I have tried altering the code to fix this, but to no avail. I need a full list returned from the function.
As you may have guessed, this story is not true. The real problem I am trying to solve is related to calculus, and is a well-known topic for those getting their feet wet with Lisp. However, my problem is not with my assignment, but rather with wrapping my mind around the recursive calls and returning full lists of values to calling functions, so that I may build a complete list of all terms to return when finished. After I am able to solve this sub-problem, I am just a stones throw away from applying it to my actual assignment and solving it.
Running the following function call:
(update-orders (quote ( (bill (4 beer) (5 whiskey)) (jim (1 beer)) (kenny (1 whiskey) (4 rum)) (abdul (1 beer) (3 whiskey) (2 rum) ))) (quote beer))
gets me the following returned:
((5 WHISKEY))
I would, instead, like a list in the same format as the one supplied to the function above.
Please see the code below. It has been modified to include debugging output to the screen for convenience. Function drink-list is likely where my trouble lies.
(defun update-orders (x d)
(print 'orders)
(prin1 x)
(order (car x) d)
)
(defun order (x d)
(print 'order)
(prin1 x)
(drink-list (cdr x) d)
)
(defun drink-list (x d)
(print 'drink-list)
(prin1 x)
;(append
;(cons
;(list
(drink-count (car x) d)
(cond
((cdr x) (drink-list (cdr x) d))
(t x)
)
;)
)
(defun drink-count (x d)
(print 'drink-count)
(prin1 x)
(list
(cond
((eq (car (cdr x)) d)
(modify-count (car x) 1))
(t x)
)
)
)
(defun modify-count (x d)
(print 'modify-count)
(prin1 x)
(print 'new-modify-count)
(prin1 (+ (parse-integer (subseq (write-to-string x) 0)) 1))
(list
(+ (parse-integer (subseq (write-to-string x) 0)) 1)
)
)
EDIT:
I have incorporated ooga's suggestions into my code. The new order and update-order functions are shown below:
(defun update-orders (x d)
(cond
((null x) ())
(t (cons (order (car x) d) (update-orders (cdr x) d)))
)
)
(defun order (x d)
;(print 'order)
;(prin1 x)
(drink-list (cdr x) d)
)
I now get the following list returned, running the same function call as above:
(((5 WHISKEY)) ((1 BEER)) ((4 RUM)) ((2 RUM)))
which is a list of embedded lists (2 deep, I believe) that include all of the last drink item and drink count of each patron in the list (Bill's final list entry is 5 whiskey, Jim final entry is 1 beer, etc). Their first n-1 drinks are not added to the returned list of their drinks.
Have I misread your suggestion? I have a feeling I am a half step away here.
In update-orders you only pass the car of x to order. The rest of x is completely ignored. Then you only pass the cdr of that is on to drink-list.
As an example of how your code should be structured, here's a program that adds 1 to each member of the given list.
Example call: (increment-list '(1 2 3))
(defun increment-list (x)
(cond
((null x) ())
(t (cons (increment (car x)) (increment-list (cdr x))))
)
)
(defun increment (x)
(+ x 1)
)
Change increment-list to update-orders and increment to orders (and add the second input, etc.) and that, I think, should be your program structure.
Also, you should try to build it from the bottom up. Try writing a function that will add one to the number if the given drink in a (number drink) list matches. I.e., given this:
(add-one-if '(4 beer) 'beer)
It should return this
(5 BEER)
And given this
(add-one-if '(3 whiskey) 'beer)
It should return this
(3 WHISKEY)
As suggest above, here is the full code I have implemented to solve my problem, incorporating the suggested structure provided by ooga.
;;;; WAITING-TABLES
(defun update-orders (x d)
(cond
((null x) ())
(t (cons (order (car x) d) (update-orders (cdr x) d)))
)
)
(defun order (x d)
(cons (car x) (drink-list (cdr x) d))
)
(defun drink-list (x d)
(cond
((null x) ())
(t (cons (drink-count (car x) d) (drink-list (cdr x) d)))
)
)
(defun drink-count (x d)
(cond
((eq (car (cdr x)) d)
(cons (modify-count (car x) 1) (drink-count (cdr x) d)))
(t x)
)
)
(defun modify-count (x d)
(+ (parse-integer (subseq (write-to-string x) 0)) 1)
)