CS 22
Clab 21: Queues, Tables, and an Introduction to Simulation
Queues
Review the material on pp. 261-265 making sure you understand
what a queue is and how your authors' choose to represent one.
http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-22.html#%_sec_3.3.2
It is important to understand how and why all the queue operations
in this implementation take O(1) steps.
Here is the sicp queue code and the definition of and insertion into
a couple of queues:
<![CDATA[
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
(if (empty-queue? queue)
(error "FRONT called with an empty queue" queue)
(car (front-ptr queue))))
(define (insert-queue! queue item)
(let ((new-pair (cons item '())))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-pair)
(set-rear-ptr! queue new-pair)
queue)
(else
(set-cdr! (rear-ptr queue) new-pair)
(set-rear-ptr! queue new-pair)
queue))))
(define (delete-queue! queue)
(cond ((empty-queue? queue)
(error "DELETE! called with an empty queue" queue))
(else
(set-front-ptr! queue (cdr (front-ptr queue)))
queue)))
(define q1 (make-queue))
(define q2 (make-queue))
(insert-queue! q1 'a)
(insert-queue! q1 'b)
(insert-queue! q2 'bat)
(insert-queue! q2 'cat)
(insert-queue! q2 'hat)
]]>
Play around with the queue operations front-queue, delete-queue!,
insert-queue! on these two queues.
Then do ex 3.21 on p. 265-266.
Tables
As we saw in the number handling package, a table can help us get
around many problems and be used productively in a data-driven system.
We used a two-dimensional table of operations (i.e. functions) whose
rows were indexed by the operation name and whose columns were indexed
by the representation. Here is some code for maintaining a two-dimensional
table.
<![CDATA[
(define (assoc key records)
(cond ((null? records) #f)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
#f))
#f)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
]]>
Here are a couple of test evals.
<![CDATA[
> (put 'x1 'x11 'val11)
ok
> (put 'x1 'x12 'val12)
ok
> (put 'x2 'x21 'val21)
ok
> (get 'x1 'x11)
val11
> (get 'x3 'x11)
#f
> (get 'x2 'x21)
val21
> (get 'x1 'x12)
val12
]]>
So it looks like we can put things in the table and get things out.
The code that maintains the table is a good example of gross-lisp. It
leaves the beauty of the stateless world for the practical advantages
of a world with state. The state changing functions are the ones that
end in ! (pronounced bang by most lispers). Let's take a peek at how
the table is implemented.
The table is pretty well encapsulated. make-table just returns a
function dispatch which internally holds a state-full entity called
local-table. There is no way we can get at it now except through
get and put. So let's break the rules a bit and put a spy function
peek into dispatch function. Here is how.
In the definition of make-table, just before the internal definition
of dispatch add the following internal definition.
<![CDATA[
(define peek (lambda () (display local-table)))
]]>
Add
<![CDATA[
((eq? m 'peek) peek)
]]>
inside the conditional defining dispatch. And add
<![CDATA[
(define peek (operation-table 'peek))
]]>
at the top-level say after the definition of put. Now try a
sequence of puts and peeks. e.g.
<![CDATA[
> (put 'x1 'x11 'val11)
ok
> (peek)
(*table* (x1 (x11 . val11)))
> (put 'x1 'x12 'val12)
ok
> (peek)
(*table* (x1 (x12 . val12) (x11 . val11)))
> (put 'x2 'x21 'val21)
ok
> (peek)
(*table* (x2 (x21 . val21)) (x1 (x12 . val12) (x11 . val11)))
> (put 'x1 'x13 'val13)
ok
> (peek)
(*table* (x2 (x21 . val21)) (x1 (x13 . val13) (x12 . val12) (x11 . val11)))
>
]]>
You can see that, except for the header, the table is a list of lists.
Each sublist
represents a row whose car is the name of the row. Within a row,
each column is represented by a dotted pair whose car is the column
name and whose cdr is the table value for that row and column.
Simulation
In his rush for class, professor K. wrote a somewhat weak simulation
program to illustrate the use of queues.
In fact, he was so excited about discovering the looping command
do and the let* construction (check them out in help) that
at first he forgot
to use queues at all. Here is his first attempt.
<![CDATA[
;; real-random by cfk is a parameterless function that returns
;; an inexact random number uniformly distributed between 0 and 1
(define real-random (lambda ()
(/ (random (- (expt 2 31) 1))
(exact->inexact (expt 2 31)))))
;; randomrange by cfk is a function that takes two parameters
;; min and max and returns
;; an inexact random number uniformly distributed between min and max
(define randomrange
(lambda (min max)
(+ min (* (real-random) (- max min)))))
(define (simulate prob minsvctim maxsvctim totsimtim)
(define (newcust) (< (real-random) prob))
(let ((timinq 0)
(numcustserved 0)
(custslost 0)
(p1tim 0))
(define (outputstats) ;;;output summary stats
(begin
(display "timinq = ") (display timinq)
(newline)
(display "numcustserved = ") (display numcustserved )
(newline)
(display "custslost = ") (display custslost)
(newline)
))
(define (nextminute simtim) ;;;do sim for next minute
(let* ((newc (newcust))
(svctim (randomrange minsvctim maxsvctim)))
(begin
(if (<= p1tim simtim) ;;;p1 avail
(if newc
(begin
(set! numcustserved (+ 1 numcustserved))
(set! p1tim (+ simtim svctim))
(set! newc #f)
))
;;; p1 not available
(if newc
(set! custslost (+ 1 custslost)))
))))
(do ((simt 0 (+ 1 simt)))
((>= simt totsimtim) (outputstats))
(nextminute simt)
)
))
(simulate 0.5 3 5 100)
]]>
This is really bad. The lack of meaningful comments means Prof. K
will have to explain some of this in class. Of course if he was
grading he would have to take off lots.
After getting over his excitement about do and let*, Professor K
wrote a slightly improved simulation.
<![CDATA[
;; you need the sicp queue stuff.
;; real-random by cfk is a parameterless function that returns
;; an inexact random number uniformly distributed between 0 and 1
(define real-random (lambda ()
(/ (random (- (expt 2 31) 1))
(exact->inexact (expt 2 31)))))
;; randomrange by cfk is a function that takes two parameters
;; min and max and returns
;; an inexact random number uniformly distributed between min and max
(define randomrange
(lambda (min max)
(+ min (* (real-random) (- max min)))))
(define (makecust arrtim stim) (cons arrtim stim))
(define (arrtim cust) (car cust))
(define (svctim cust) (cdr cust))
;;; simulate simulates a gas station with one pump
;;; prob is the probablility that a customer shows up in any one minute
;;; minsvctim is the minimum time to service a customer
;;; maxsvctim is the maximum time to service a customer
;;; totsimtim is the total number of minutes to run the simulation for.
;;;
(define (simulate prob minsvctim maxsvctim totsimtim)
(define (newcust) (< (real-random) prob))
(let ((timinq 0)
(numcustserved 0)
(custslost 0)
(p1tim 0)
(p1q (make-queue)))
(define (outputstats) ;;;output summary stats
(begin
(display "timinq = ") (display timinq)
(newline)
(display "numcustserved = ") (display numcustserved )
(newline)
(display "custslost = ") (display custslost)
(newline)
))
(define (nextminute simtim) ;;;do sim for next minute
(let* ((newc (newcust))
(svtim (randomrange minsvctim maxsvctim))
(thiscust (makecust simtim svtim)))
(begin
(if (<= p1tim simtim) ;;;p1 avail
(cond
((not (empty-queue? p1q)) ;;; move cust in from queue
(let ((qperson (front-queue p1q)))
(delete-queue! p1q)
(set! timinq (+ timinq (- simtim (arrtim qperson))))
(set! numcustserved (+ 1 numcustserved))
(set! p1tim (+ simtim (svctim qperson)))
))
(else ;;; p1 queue is empty
(if newc ;;;move right to pump
(begin
(set! p1tim (+ simtim svtim))
(set! numcustserved (+ 1 numcustserved))
(set! newc #f)
)))))
(if newc ;;; if still customer waiting put in queue
(insert-queue! p1q thiscust)
))))
(do ((simt 0 (+ 1 simt)))
((>= simt totsimtim) (outputstats))
(nextminute simt)
)
))
(simulate 0.5 3 5 100)
]]>
It's still a little lame. Your job is to fix it up a little. The
documentation is so poor, the professor will have to say a few words
in class, but it would be a good idea for you to look this over before
the few words.
The overall idea is this: We have a gas station with one pump. In any
given minute, with probability prob, a driver comes along who wants
gas. If the pump is available the car will pull in and buy gas. If
the line for the pump is longer than 3 cars, the car will go to
another gas station and be a customer lost. If the car wants gas and
there are 3 or fewer cars in the line for the pump, the car will get
in line.
Professor K's simulation is a start. Since he didn't
have a function to find the length of a queue, he just added cars to
the queue. Due to an oversight, when he printed statistics, he forgot
to count time in the queue for customers who were still waiting at the
end of the simulation time. Pretty lame!! Fix this up, please. If there
is time, show
me what you get. If you want some fun, after
you have the one pump simulation working properly, you
might do 2 pumps with separate queues for each pump. Then try
2 pumps with one common queue. Or generalize to n pumps with
n separate queues and n pumps with a common queue.
<![CDATA[
]]>
<![CDATA[
]]>