how to create an alist with initial values - functional-programming

I'm learning scheme (using guile) and I found the need to create an initial alist, with some keys and empty lists as their values. I was wondering what's the best practice when doing something like this. My goal is to keep this alist around so I can later add items to the lists. This is what I have now:
(define buckets
`((hourly . ())
(daily . ())
(monthly . ())
(yearly . ())))
However, this does not work when trying to assoc-set!, to append items to the list. This, however, works:
(define buckets
(acons 'hourly '()
(acons 'daily '()
(acons 'monthly '()
(acons 'yearly '() '())))))
Clearly not the best looking piece of code. Is there a more idiomatic way of building such an alist? Maybe I'm doing this completely wrong. The end goal is to have these buckets that I can refer to later in different parts of code by their key.
Thanks!

scheme#(guile-user)> (acons 'hourly '()
(acons 'daily '()
(acons 'monthly '()
(acons 'yearly '() '()))))
$2 = ((hourly) (daily) (monthly) (yearly))
is the same as
scheme#(guile-user)> '((hourly) (daily) (monthly) (yearly))
$3 = ((hourly) (daily) (monthly) (yearly))
scheme#(guile-user)> (equal? $2 $3)
$4 = #t
EDIT assoc-set! doesn't work in this case because these lists are not mutable. One way to achieve a mutable list while still shortening the way to define it is to use this expression instead:
(map list '(hourly daily montly yearly))

My answer is in Scheme but can easily be translated to guile
If you want an advanced solution you can take an approach which will give you an abstraction layer and easier data management once done.
Take a step into Object Modeling!
Depending on the behavior(the set of methods you will support) you'd like your object to have, it should generally look like this:
(define make-state-manager
(lambda()
(let ((data_lst '()))
(letrec
((get-lst (lambda (key) (assoc key data_lst)))
((get-data (lambda (key) (assoc-ref key data_lst)))
((add-item (lam ...)
... here you should have add-data , remove-data etc.
(action_n ....)
(dispatch (lambda (action)
(cond ((eq? action ’full-list) get-lst)
((eq? action ’value) get-data)
((eq? action ’add-to-list) add-item)
...
((eq? action ’action_n) func_n)
(else (error "Unknown request: ~s" action)))))
)
dispatch))
))
...)))
Usage:
>(define data_manager (make-state-manager))
> data_manager
> #<procedure... >
> ((data_manager 'add-data) 'hourly '())
> ((data_manager 'value) 'hourly)
> ()
> ((data_manager 'full-list) 'hourly)
> (hourly . ())
Explanation:
First let creates a local state, so that you can run
(define data_manager1 (make-state-manager))
(define data_manager2 (make-state-manager))
and they will have different scopes, the actions will not affect one another.
Then in letrec you define the object methods with your method names.
In the dispatch (which gets dispatched :) to the user) you set the method names that the user will use.
sources : my brain & this crazy book
if this blows your mind too hard - come back to it later...

Related

Defining a type on a list that begins with a particular symbol

I am trying to use generic functions' ability to specify behaviour based on the first argument of a list.
In other words, I want the list (atypelist 1 2 3) and the list (btypelist 1 2 3) to have their individual behaviour when passed to foo. So far, this is what I came up with:
(deftype atypelist (lst)
`(eq (car ,lst) 'atypelist))
(deftype btypelist (lst)
`(eq (car ,lst) 'btypelist))
(defmethod foo ((lst atypelist))
(format nil "success atypelist: ~S" lst))
(defmethod foo ((lst btypelist))
(format nil "success btypelist: ~S" lst))
However, when I call (typep (list 'atypelist 1 2 3) 'atypelist) I get the following error:
error while parsing arguments to DEFTYPE ATYPELIST:
too few elements in
()
to satisfy lambda list
(LST):
exactly 1 expected, but got 0
I am guessing the error is in my definition of atypelist.
Questions:
Is there a better way to get the functionality I am looking for?
If yes - what is the way?
If not - how to properly define a type on a list/cons that has a particular symbol in the car?
Before I start: what you want to do can't work, and is confused in two ways.
Firstly deftype defines a type in terms of other type specifiers: the body of a deftype form must expand into a type specifier, not an expression, as yours does. And deftype's arguments are not the thing you want to check the type for, they are parts of the type specification.
In this case you want to specify that the thing is a cons, and that its car is eql to something. Fortunately there are specializing type specifiers for both of these things, and you end up with something like this:
(deftype cons-with-specified-car (x)
`(cons (eql ,x) t))
And now
> (typep '(1) '(cons-with-specified-car 1))
t
> (typep '(a) '(cons-with-specified-car a))
t
> (typep '() '(cons-with-specified-car a))
nil
And if you want:
(deftype cons-with-a ()
'(cons-with-specified-car a))
and now
> (typep '(a) 'cons-with-a)
t
Secondly none of this will work because this it not how CLOS works. CLOS dispatches on classes not types, and you have merely defined a type, not a class: your method definitions simply cannot work, since classes cannot be parametrized in this way like types can.
Some ways you might achieve what you want.
If what you want to do is to dispatch on the first element of a list, then the obvious approach, if you want to use CLOS, is to use a two-level approach where you first dispatch on the class of the thing (cons is a class), and then use eql specializers to pick out the things you want.
(defgeneric select (it)
(:method ((it cons))
(select* (car it) it))
(:method (it)
nil))
(defgeneric select* (key it)
(:method (key it)
(format t "~&unknown key ~S in ~S~%" key it)))
(defmethod select* ((key (eql 'a)) it)
(format t "~&~S begins with a~%" it))
However in a case like this, unless you very much want the extensibility that CLOS gets you (which is a good reason to use CLOS here), I'd just use typecase. You could do this using the type defined above:
(defun select (it)
(typecase it
((cons-with-specified-car a)
'(cons a))
(cons
'cons)
(t
nil)))
or, probably simpler, just use what the deftype expands into:
(defun select (it)
(typecase it
((cons (eql a) t)
'(cons a))
(cons
'cons)
(t
nil)))
Finally probably what anyone doing this would actually write (again, assuming you do not want the extensibility CLOS gets you) is:
(defun select (it)
(typecase it
(cons
(case (car it)
...))
(t
...)))
Here is a possible solution, using the type specifier satisfies:
CL-USER> (defun is-atypelist (list)
(eq (car list) 'atypelist))
IS-ATYPELIST
CL-USER> (defun is-btypelist (list)
(eq (car list) 'btypelist))
IS-BTYPELIST
CL-USER> (deftype atypelist ()
`(satisfies is-atypelist))
ATYPELIST
CL-USER> (deftype btypelist ()
`(satisfies is-btypelist))
BTYPELIST
CL-USER> (typep (list 'atypelist 1 2 3) 'atypelist)
T
CL-USER> (typep (list 'atypelist 1 2 3) 'btypelist)
NIL
Note that this does not define a class, but a type, if this is what you need.
Is there a better way to get the functionality I am looking for?
1. Wrap your lists in container types
(defclass lst () ((items :initarg :items :reader items)))
(defclass alst (lst) ())
(defclass blst (lst) ())
It may be a little bit more cumbersome to work with but this is pretty much straightforward and not too suprising.
2. Douple-dispatch
(defgeneric foo (val))
(defgeneric foo/tag (tag val))
For example:
(defmethod foo ((c cons))
(destructuring-bind (tag . list) c
(foo/tag tag list)))
3. Define a custom method combination
It should be possible to hack the meta-object protocol dispatch mechanism to dispatch on the first item of a list. I wouldn't recommend it however.
4. Use a different dispatch mechanism
Use a completely different dispatching mechanism outside of CLOS, like pprint-dispatch does. For example you may want to use trivia or optima pattern-matching libraries, or cl-algebraic-data-type. This may be more useful if you are dealing with trees of symbols.

Representing a queue as a procedure with local state

Section §2.1.3 at page 90 explains, with a very clear example, that first class functions in a language make functions themselves and data be the same thing looked at from different perspectives, or, to cite the book:
the ability to manipulate procedures as objects automatically provides the ability to represent compound data.
At page 266, exercise 3.22 from Section §3.3.2, proposes the following
Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form
(define (make-queue)
(let ((front-ptr ...)
(rear-ptr ...))
<definitions of internal procedures>
(define (dispatch m) ...)
dispatch))
Complete the definition of make-queue and provide implementations of the queue operations using this representation.
I easily came up with the following (I've used names the-list and last-pair instead of front-ptr and rear-ptr because I found it clearer, in this case):
(define (make-queue)
(let ((the-list '())
(last-pair '()))
(define (dispatch m)
(cond ((eq? m 'empty) (null? the-list))
((eq? m 'front) (if (null? the-list)
(error "can't take front of empty list")
(car the-list)))
((eq? m 'ins) (lambda (e)
(if (null? the-list)
(begin (set! the-list (list e))
(set! last-pair the-list))
(begin (set-cdr! last-pair (list e))
(set! last-pair (cdr last-pair))))
the-list))
((eq? m 'del) (begin
(if (null? the-list)
(error "can't delete from emtpy list")
(set! the-list (if (pair? the-list) (cdr the-list) '())))
the-list))
((eq? m 'disp) (display the-list)) ; added this for convenience
(else "error")))
dispatch))
(define (empty-queue? q) (q 'empty))
(define (front-queue q) (q 'front))
(define (insert-queue! q e) ((q 'ins) e))
(define (delete-queue! q) (q 'del))
(define (display-queue q) (q 'disp))
which seems to work pretty fairly well…
… except for one crucial point!
At the beginning of §3.3.2 the two desired mutators (that are part of the queue interface) are defined like this (my emphasis):
(insert-queue! <queue> <item>)
inserts the item at the rear of the queue and returns the modified queue as its value.
(delete-queue! <queue>)
removes the item at the front of the queue and returns the modified queue as its value, signaling an error if the queue is empty before the deletion.
My solution doesn't abide by those parts of the definition, because both insert-queue! and delete-queue! are returning the-list, which is the bare list, an implementation detail of the queue interface. Indeed, my solution doesn't support things like these
(define q (make-queue)) ; ok
(insert-queue! (insert-queue! q 3) 4) ; doesn't work
(delete-queue! (delete-queue! q)) ; doesn't work
whereas I think it should.
I guess that the solution should see delete-queue! and insert-queue! return a mutated version of the dispatch function.
How do I do that?
No need for that. Simply define
(define (insert-queue! q e)
((q 'ins) e)
q)
(define (delete-queue! q)
(q 'del)
q)
The design is not clean though, as in, these queues are not persistent. The new version and the old share the same underlying buffer (list). There is no old version preserved anymore, just the current version.
So we don't return a new, modified queue; we return the same queue which has been mutated. Conceptually, that is. On a little bit lower level, we return the same dispatch procedure which is a part of the same closure which holds the same internal binding for the internal buffer, which has been mutated.
By the way, using the head sentinel trick, were you start with e.g. (list 1) instead of '(), usually leads to much simplified, clearer code.

What does this self referencing code do?

What is this self reference for?
Could it be written in any other way?
Is there any advantage?
(defmacro sublet (bindings% &rest body)
(let ((bindings (let-binding-transform
bindings%)))
(setq bindings
(mapcar
(lambda (x)
(cons (gensym (symbol-name (car x))) x))
bindings))
`(let (,#(mapcar #'list
(mapcar #'car bindings)
(mapcar #'caddr bindings)))
,#(tree-leaves
body
#1=(member x bindings :key #'cadr)
(caar #1#)))))
It's just a way of reusing structure somewhere else. In the macro you have:
(tree-leaves body
#1=(member x bindings :key #'cadr)
(caar #1#))
Which is just a fancy way of writing:
(tree-leaves body
(member x bindings :key #'cadr)
(caar (member x bindings :key #'cadr)))
On the positive side if you correct a bug in the member form you'll fix it both places, but it's runs the same code twice so if member was expensive this wouldn't be the wise way to do it. However it is a macro, thus run at compile time, and member is fairly fast on mall lists (small == millions of elements or below) so I guess it won't matter if you read the references just as good as any other CL code. An alternative and perhaps more readable for other kind of lispers would be:
(let ((found (member x bindings :key #'cadr)))
(tree-leaves body found (caar found)))

Let being called multiple times in recursion

I am trying to declare a local variable for use within a recursive function, but my let seems to be being called each time the function recurses. I want the let function to be called once to declare a variable and give it the value nil, I'd then like to update the value of this local variable within my recursive function without it being wiped with each recurse.
Here is a simplified framework of my code.
(defun recursive-function (l1 l2)
(let ((?x nil))
(cond (...
...
... ;trying to update value of ?x here with (setf ?x 5)
(recursive-funtion (rest l1)(restl2)) ;recursive call made
))))
What you've written is exactly what you've said you don't want; a local variable inside of the recursive function that should be updating it with each pass. If I've understood you correctly, you'll need to do something like
(defun recursive-function (l1 l2)
(let ((?x nil))
(labels ((actual-recursion (a b)
(cond (...
...
...
(actual-recursion (rest a) (rest b))))))
(actual-recursion l1 l2))))
so that each recursive call doesn't create a new binding of ?x.

Avoiding mutable state when I need to store (current-seconds) multiple times

I've put together the following rudimentary stopwatch in Racket (just learning now, the final aim is a pomodoro-timer).
#lang racket
(define start-time 0)
(define end-times '())
(define (start);; stores start-time
(set! start-time (current-seconds)))
(define (lap);; stores "laps" in list
(set! end-times (cons (current-seconds) end-times)))
(define (stop);; stores final time, displays lap-times in h, m, s and resets end-times
(begin
(set! end-times (cons (current-seconds) end-times))
(display
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
(set! end-times '())
))
While this does exactly what it should, I was wondering how I could avoid mutable state. If I follow HTDP, this is the kind of situation where mutable state is warranted, but after browsing Wadler's "Monads for Functional Programming", I'm still curious about how I could do without set!.
I know that to make it functional, I should add arguments to my functions. For instance, start would become
(define (start [now (current-seconds)])
now)
and a similar approach could work with lap and stop.
Still, while I know that after adding additional arguments to restore functionality, I should also pass arguments rather than storing values in variables, I don't see how in this case I can leverage this to avoid set! as well.
Update: Since all three answers below are highly valuable (thanks!), I didn't mark any of them as the unique correct one. Below is the minimal solution to my initial question. It is a combination of the loop-proposal of #Metaxal, with the example-usage of #Greg Hendershott.
#lang racket
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([t0 (current-seconds)] [times '()])
(match (read-line)
["quit" (reverse
(map (lambda (x)
(let ((the-date (seconds->date x)))
(list
(sub1(date-hour the-date))
(date-minute the-date)
(date-second the-date)))) times))]
["lap" (loop t0 (cons (- (current-seconds) t0) times))]
[_ (loop t0 times)])))
What will likely happen in the following of your program is that you will have a loop.
Then this loop can be a function that takes as input the whole current state, and when you want to update its state, just call the loop again with the new state (you may also call the loop again with the same exact state of course).
Simplified example:
(define (loop [t0 (current-seconds)] [times '()])
;; ... do things here, possibly depending on user input ...
;; then loop with a new state:
(cond [<some-start-condition> (loop (current-seconds) '())]
[<some-lap-condition> (loop t0 (cons (- (current-seconds) t0) times))]
[<some-stop-condition> times])) ; stop, no loop, return value
This certainly changes the approach to your design though.
It's harder to use this approach when designing GUI programs, because the event loop often prevents you from (or makes it difficult) passing values from one event to the next.
However, in Racket, there is (the pedagogical, but still very good) big-bang that is made just for that.
In this case using set! is justified and hard to avoid, because we must "remember" state between invocations of the procedures. What we can do is improving the encapsulation of state, by hiding the variables that change inside a procedure and using a message dispatcher for accessing the procedures that refer to the mutable state. This is very similar to what we do with object-oriented programming, but only lambdas are required to implement it!
(define (make-timer)
; the "attributes" of the object
(let ([start-time 0]
[end-times '()])
; the "methods" of the object
(define (start)
(set! start-time (current-seconds)))
(define (lap)
(set! end-times (append end-times (list (current-seconds)))))
(define (stop)
(lap)
(display
(map (lambda (an-end)
(let ((the-date (seconds->date (- an-end start-time))))
(list
(sub1 (date-hour the-date))
(date-minute the-date)
(date-second the-date))))
end-times))
(set! end-times '()))
; return a dispatch procedure
(lambda (msg)
(case msg
((start) (start)) ; call the start procedure defined above
((lap) (lap)) ; call the lap procedure defined above
((stop) (stop)) ; call the stop procedure defined above
(else (error "unknown message:" msg))))))
I took the liberty of modifying some of your procedures to make them a bit simpler. Here's how we would use the timer object we just created:
(define timer (make-timer))
(timer 'start)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'stop)
=> ((18 0 1) (18 0 2) (18 0 3) (18 0 4))
This technique is called "message passing", learn more about it in the wonderful SICP book.
For a simple example like this, I would probably do what #Metaxal
suggested.
However another approach is that you could explicitly define the state
as a struct:
(struct state (start-time end-times))
Then change the start, lap, and stop to be functions on state:
;; start : -> state
;; stores start-time
(define (start)
(state (current-seconds) '()))
;; lap : state -> state
;; stores "laps" in list
(define (lap st)
(match-define (state start-time end-times) st)
(state start-time
(cons (current-seconds) end-times)))
;; stop : state -> list
;; stores final time, displays lap-times in h, m, s
(define (stop st)
(match-define (state start-time end-times*) st)
(define end-times (cons (current-seconds) end-times*))
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
As in #Metaxal's answer, your "main loop" needs to handle the state and "thread" it through the functions as appropriate:
Example usage:
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([st (start)])
(match (read-line)
["quit" (stop st)]
["lap" (loop (lap st))]
[_ (loop st)])))
Whereas #Óscar López's answer shows a style of OOP as explained in SICP.
A nice thing about Racket (and Scheme) is that you can choose whatever approach on the spectrum you think best fits the problem at hand, and your taste -- simple imperative, OOP imperative, pure functional.

Resources