Racket GUI: how to reference widgets created dynamically during the runtime? - racket

This is the first time I use Racket GUI and I must say that I feel really confused.
I have these requirements:
a window composed of several widgets
the widgets state must change with user actions
it is possible to have several instances of these windows in the same time
Because of (3), I created a function create-window which create a new window with the new widgets.
But because of this, I have no global variable to reference my widgets.
How to reference widgets created dynamically during the runtime?
How to organize the GUI code in an idiomatic Racket GUI style?

It depends where the reference needs to occur. Who needs to talk to whom?
For example, if one widget has a callback to another widget in the same frame, and if you're creating both widgets together, then you can just name them and have the callback closure refer to the right name (ie, variable). Here's a little example program:
#lang racket/gui
;; create-hello-window : -> Void
(define (create-hello-window)
(define f (new frame% (label "Example") (width 600) (height 400)))
(define t (new text%))
(define ec (new editor-canvas% (parent f) (editor t)))
(define b (new button% (parent f) (label "Say hello")
(callback (lambda (b ce) (say-hello t)))))
(send f show #t)
(void))
;; say-hello : Editor -> Void
(define (say-hello t)
(send t set-position (send t last-position))
(send t insert "Hello world!\n"))
;; Create two independent hello windows
(for ([i 2]) (create-hello-window))
Notice that the button callback refers to the local variable t (the editor).
For more complicated communication, you need to save references somewhere to the objects you want to refer to. Here's another version of the previous program, where the windows are organized into groups, and each window has a button that writes a greeting to the other windows in the group. The group manages a list of windows and their editors.
#lang racket/gui
;; A HelloWin is (hellowin Editor Frame)
(struct hellowin (editor frame))
;; A HelloGroup is (hellogroup String (Listof HelloWin))
(struct hellogroup (name [wins #:mutable]))
;; create-hello-window : HelloGroup -> Void
(define (create-hello-window group)
(define f
(new frame% (label (hellogroup-name group)) (width 600) (height 400)))
(define t (new text%))
(define ec (new editor-canvas% (parent f) (editor t)))
(define hi-b
(new button% (parent f) (label "Say hello")
(callback (lambda (b ce) (add-to-end t "Hello world!\n")))))
(define greet-b
(new button% (parent f) (label "Greet others in group")
(callback (lambda (b ce) (greet-everyone-else t group)))))
(send f show #t)
(set-hellogroup-wins! group (cons (hellowin t f) (hellogroup-wins group))))
;; add-to-end : Editor String -> Void
(define (add-to-end t str)
(send t set-position (send t last-position))
(send t insert str))
;; greet-everyone-else : Editor HelloGroup -> Void
(define (greet-everyone-else my-t group)
(for ([h (in-list (hellogroup-wins group))])
(define t (hellowin-editor h))
(unless (equal? t my-t)
(add-to-end t (format "~a, hello from another window!\n"
(hellogroup-name group))))))
;; Create two groups, and create windows for each group.
(define group1 (hellogroup "Group 1" null))
(for ([i 3]) (create-hello-window group1))
(define group2 (hellogroup "Group 2" null))
(for ([i 2]) (create-hello-window group2))
My code doesn't use hellowin-frame, but you could use it to write a procedure that closes all of the windows in a group, for example.
Maybe you don't want the group to have direct access to the frame and its widgets. Then you could change the protocol so that groups contain some sort of greeting callbacks, or an object (not the widget itself) implementing a greetable<%> interface that you define, or so on. Then the callback (or greetable<%> object) will have references (or fields) to the widgets but not expose them directly to the group code. Also, maybe a group should be an object with a registration method instead of a struct with a mutable field.

Related

racket - define-struct and abstract list function

I am trying to create a function games-won that consumes a list of Games, results, and a string, name, and produces the number of games in results that name won.
For example:
(define-struct game (winner loser high low))
(check-expect (games-won (list (make-game "Lori" "Troy" 52 34)
(make-game "Mary" "Lori" 30 20)) "Lori") 1)
Below is what I have so far:
(define (won? game name)
(equal? (game-winner game) name))
(define (wonlst results)
(filter won? results))
(define (lst-length lst)
(cond
[(empty? lst) 0]
[(cons? lst) (+ 1 (length (rest lst)))]))
(define (games-won results)
(cond
[(cons? (wonlst results)) (lst-length (wonlst results))]
[else 0]))
Can anyone help correct the errors in my code and maybe tell me how to use local and put the functions all together?
Here are the fixes:
As the test suggests, games-won should accept two arguments: a results list and a name. So we add a parameter - name - to games-won.
You don't need a custom lst-length function, you can just use length. Also, games-won doesn't need to worry about returning 0 in the else case. The base case is taken care of by the list-abstractions.
Note that won? takes in two inputs, but the predicate function in a filter only accepts one input. So we remove name from won?. Once we put won? in a local, it can just use name from the surrounding function's context.
We put a local in games-won and put the two helpers - won? and won-lst - in the local.
You should use string=? instead of equal?for since we know that name and winner field of game is always a String.
(define-struct game (winner loser high low))
; games-won : [List-of Game] String -> Number
(define (games-won results name)
(local (; won? : Game -> Boolean
(define (won? game)
(string=? (game-winner game) name))
; wonlst : [List-of Game] -> [List-of Game]
(define (wonlst results)
(filter won? results)))
(length (wonlst results))))
(define my-games1 (list (make-game "Lori" "Troy" 52 34)
(make-game "Mary" "Lori" 30 20)))
(check-expect (games-won my-games1 "Lori") 1)
We can just put everything in one function along with a lambda like the following:
(define (games-won results name)
(length (filter (λ (game) (string=? (game-winner game) name)) results)))
How to use local
A local expression has the following shape:
(local [definition ...] body-expression)
Within the square brackets, you can put as many definitions (i.e. defines, define-structs) as you want, and in the body of the local — body-expression — you can put any expression that may or may not use the definitions within the square brackets. The definitions are only available in the body.
From HtDP, here's how we compute with locals:
We rename the locally defined constants and functions to use names that aren’t used elsewhere in the program.
We lift the definitions in the local expression to the top level and evaluate the body of the local expression next.

Does racket allow for function overloading?

I am new to Lisp-scheme and fairly new to the functional paradigm as a whole, and am currently doing an assignment which requires me to overload a function with the same name, but different sets of parameters in racket. Below is an example of what I'm trying to achieve:
#lang racket
(define (put-ball-in-box two-by-fours nails ball)
... )
(define (put-ball-in-box box ball)
... )
These are not the actual functions, but close enough. As implied, both functions would put a ball in a box, but one would assemble the box from its components first, then call the other. Obviously, when I try the above in DrRacket or using the command line, I get a module: duplicate definition for identifier ... error.
Is there a way to achieve this in racket?
Maybe the answer is right in front of me, but I have spent the last two hours searching for this and couldn't find anything, so would appreciate any pointers.
Thank you.
It doesn't in the usual sense of "writing another definition somewhere else."
It allows shadowing, which is defining a procedure with the same name as an imported procedure. Thus you can (define + ...) and your definition of + will hide the + from racket/base. If you want the original procedure, then you can do something like the following, where I define + to be either addition or string-appending.
#lang racket/base
(require (rename-in racket/base (+ base:+)))
(define (+ . args)
(if (andmap string? args)
(apply string-append args)
(apply base:+ args)))
Another thing you can do is use racket/match to have different behavior based on the shape of the argument.
#lang racket/base
(require racket/match)
(define (fib . arg)
(match arg
[(list n) (fib n 1 0)]
[(list 1 a b) a]
[(list 0 a b) b]
[(list n a b) (fib (sub1 n) (+ a b) a)]))
This second example still doesn't quite do what you want since you have to go to the original definition point and modify the match clauses. But it might be sufficient for your purposes.
A more complicated example would be to use custom syntax to create a define/overload form. But I think you'll find the racket/match solution to be best.
You have the concept of default values as in JS and PHP:
(define (fib n (a 0) (b 1))
(if (zero? n)
a
(fib (sub1 n) b (+ a b))))
(fib 10) ; ==> 55
Now if you had 5 optional parameters you need to order them and even pass some values just to be able to add a later one. To avoid that you can use keywords:
(define (test name #:nick [nick name] #:job [job "vacant"])
(list name nick job))
(test "sylwester" #:job "programmer")
; ==> ("sylwester" "sylwester" "programmer")
Now Racket has classes. You can call a method like (send object method args ...).
(define circle%
(class object%
(super-new)
(init-field radius)
(define/public (area)
(* radius radius 3.1415))))
(define cube%
(class object%
(super-new)
(init-field side)
(define/public (area)
(* side side))))
(define circle (new circle% [radius 7]))
(define cube (new cube% [side 7]))
(map
(lambda (o) (send o area))
(list circle cube))
; ==> (153.9335 49)
Notice that the two classes hasn't really commited to a joint interface with area so this is pure duck typing. Thus you can make a function that expects a class that implements a message and it doesn't need to worry about other aspects of the class at all.

Tacit programming in Lisp

Is it possible to use/implement tacit programming (also known as point-free programming) in Lisp? And in case the answer is yes, has it been done?
This style of programming is possible in CL in principle, but, being a Lisp-2, one has to add several #'s and funcalls. Also, in contrast to Haskell for example, functions are not curried in CL, and there is no implicit partial application. In general, I think that such a style would not be very idiomatic CL.
For example, you could define partial application and composition like this:
(defun partial (function &rest args)
(lambda (&rest args2) (apply function (append args args2))))
(defun comp (&rest functions)
(flet ((step (f g) (lambda (x) (funcall f (funcall g x)))))
(reduce #'step functions :initial-value #'identity)))
(Those are just quick examples I whipped up – they are not really tested or well thought-through for different use-cases.)
With those, something like map ((*2) . (+1)) xs in Haskell becomes:
CL-USER> (mapcar (comp (partial #'* 2) #'1+) '(1 2 3))
(4 6 8)
The sum example:
CL-USER> (defparameter *sum* (partial #'reduce #'+))
*SUM*
CL-USER> (funcall *sum* '(1 2 3))
6
(In this example, you could also set the function cell of a symbol instead of storing the function in the value cell, in order to get around the funcall.)
In Emacs Lisp, by the way, partial application is built-in as apply-partially.
In Qi/Shen, functions are curried, and implicit partial application (when functions are called with one argument) is supported:
(41-) (define comp F G -> (/. X (F (G X))))
comp
(42-) ((comp (* 2) (+ 1)) 1)
4
(43-) (map (comp (* 2) (+ 1)) [1 2 3])
[4 6 8]
There is also syntactic threading sugar in Clojure that gives a similar feeling of "pipelining":
user=> (-> 0 inc (* 2))
2
You could use something like (this is does a little more than -> in
Clojure):
(defmacro -> (obj &rest forms)
"Similar to the -> macro from clojure, but with a tweak: if there is
a $ symbol somewhere in the form, the object is not added as the
first argument to the form, but instead replaces the $ symbol."
(if forms
(if (consp (car forms))
(let* ((first-form (first forms))
(other-forms (rest forms))
(pos (position '$ first-form)))
(if pos
`(-> ,(append (subseq first-form 0 pos)
(list obj)
(subseq first-form (1+ pos)))
,#other-forms)
`(-> ,(list* (first first-form) obj (rest first-form))
,#other-forms)))
`(-> ,(list (car forms) obj)
,#(cdr forms)))
obj))
(you must be careful to also export the symbol $ from the package in
which you place -> - let's call that package tacit - and put
tacit in the use clause of any package where you plan to use ->, so -> and $ are inherited)
Examples of usage:
(-> "TEST"
string-downcase
reverse)
(-> "TEST"
reverse
(elt $ 1))
This is more like F#'s |> (and the shell pipe) than Haskell's ., but they
are pretty much the same thing (I prefer |>, but this is a matter of personal taste).
To see what -> is doing, just macroexpand the last example three times (in SLIME, this is accomplished by putting the cursor on the first ( in the example and typing C-c RET three times).
YES, it's possible and #danlei already explained very well. I am going to add up some examples from the book ANSI Common Lisp by Paul Graham, chapter 6.6 on function builders:
you can define a function builder like this:
(defun compose (&rest fns)
(destructuring-bind (fn1 . rest) (reverse fns)
#'(lambda (&rest args)
(reduce #'(lambda (v f) (funcall f v))
rest
:initial-value (apply fn1 args)))))
(defun curry (fn &rest args)
#'(lambda (&rest args2)
(apply fn (append args args2))))
and use it like this
(mapcar (compose #'list #'round #'sqrt)
'(4 9 16 25))
returns
((2) (3) (4) (5))
The compose function call:
(compose #'a #'b #'c)
is equlvalent to
#'(lambda (&rest args) (a (b (apply #'c args))))
This means compose can take any number of arguments, yeah.
Make a function which add 3 to argument:
(curry #'+ 3)
See more in the book.
Yes, this is possible in general with the right functions. For example, here is an example in Racket implementing sum from the Wikipedia page:
#lang racket
(define sum (curry foldr + 0))
Since procedures are not curried by default, it helps to use curry or write your functions in an explicitly curried style. You could abstract over this with a new define macro that uses currying.

Is it possible to dynamically add one more super class in existing class

In Common-Lisp CLOS
Is it possible to dynamically add one more super class
in existing class.
Update:
I wanted to defined defassoc kind of macro that will associated some behaviour
with method/function using same argument
e.g.
(defassoc (gname (s (g group)))
((name1 (name ((corresponding-task task g) s)))
(record1 (record ((corresponding-task task g) s))))
(let ((n name1)
(r record1))
(if (and name1 record1)
(display name1 record1)
(call-next-method))))
expand to
(symbol-macrolet ((name1 (name ((corresponding-task task g) s)))
(record1 (record ((corresponding-task task g) s))))
(defmethod gname :after (s (g group))
(let ((n name1) (r record1))
(if (and name1 record1)
(display name1 record1)
(call-next-method)))))
Here it is ensuring when ever (gname (s (g group)) is call
here should be call for corresponding task to group
(name ((corresponding-task task g) s)
(record ((corresponding-task task g) s)
I used this macro
(defmacro defassoc ((main-method main-method-lambda-list)
funspec-list &body body)
`(symbol-macrolet ,(mapcar (lambda (fspec)
(destructuring-bind (name f) fspec
(list name f)))
funspec-list)
(defmethod
,main-method ,mod ,main-method-lambda-list
,#(if body
body
`(if (and
,#(mapcar (lambda (e)
(car e))
funspec-list))
(call-next-method)))))
But problem is that it will overwrite the
(defmethod gname :after (s (g group))
...)
(If it has any, I can verify it if it has one or not,)
But I want it to work for any object whether it has that method to overwrite or not
So basically it should be needed to change in code for any thing in that classes and methods.
So one way I decided that to dynamically add parent class to define this method on it.
Other way could be defadvide or fwrapper but it is not present in SBCL.
Yes, it's possible. The easiest way would be to simply redefine the class. You do that by issuing another call to DEFCLASS. If you want to do more complicated things, you have to resort to the MOP (MetaObject Protocol). Essentially everything you'd ever want to do is possible using the MOP, but I would need more detailed information as to what it is you're trying to do in order to explain it further.

Common Lisp: non-nil arguments and their names to alist, how?

I am quite new to Common Lisp and programming, and I'm trying to write a certain function that turns all non-nil args into an alist. The only way I can think of so far is:
(let ((temp nil))
(if arg1
(setf temp (acons 'arg1 arg1 nil)))
(if arg2
(setf temp (acons 'arg2 arg2 temp)))
...
(if arg20-ish
(setf temp (acons 'arg20-ish arg20-ish temp)))
(do-something-with temp))
which does not seem very elegant, it would be messy with many arguments and when these need to be changed. I am looking for a smarter way to do this, both for the sake of writing this particular function and for learning how to think in Lisp and/or functional programming.
The tricky part for me is figuring out how to get the names of the arguments or what symbol to use, without hand coding each case. If &rest provided arg names it would be easy to filter out NILs with loop or mapcar, but since it doesn't, I can't see how to "automate" this.
I'm totally interested in other solutions than the one described, if people think this way is unnatural.
Edit: Below is an example of what I am trying to do:
An object is created, with a non-fixed number of data pairs and some tags, e.g.:
user = "someone"
creation-time = (get-universal-time)
color-of-sky = "blue"
temperature-in-celsius = 32
language = "Common Lisp"
...
tags = '("one" "two" "three")
These properties (i.e. key/arg names) could be different each time. The new object will then be added to a collection; I thought the array might work well since I want constant access time and only need a numeric ID.
The collection will hold more and more such custom objects, indefinitely.
I want to be able to quickly access all objects matching any combination of any of the tags used in these objects.
Since the array is supposed to store more and more data over a long period, I don't want to parse every item in it each time I need to search for a tag. Thus I also store the index of each object with a given tag in a hash-table, under the tag name. I have written this function, what I find difficult is figuring out how to collect the data and turn it into an alist or anything that I can easily parse, index, and store.
This macro will define a function that turns its non-nil arguments into an alist bound during execution of the body:
(defmacro defnamed (fun-name alist-sym (&rest args) &body body)
`(defun ,fun-name (,#args)
(let ((,alist-sym))
,#(mapcar
(lambda (s)
`(when ,s
(push (cons ',s ,s) ,alist-sym)))
(reverse args))
,#body)))
Demonstration:
(defnamed make-my alist (a b c)
alist)
(make-my 1 NIL 3)
=> ((A . 1) (C . 3))
Here's a sort of solution using macros:
(defmacro named-args (fun-name alist-sym (&rest syms) &body body)
`(defun ,fun-name (&key ,#syms)
(declare (special ,#syms))
(let ((,alist-sym
(loop
for s in ',syms
collecting (cons s (symbol-value s)))))
,#body)))
You can then use it with something like
(named-args f u (a b c)
(format t "~A~%" u))
which expands to
(DEFUN F (&KEY A B C)
(DECLARE (SPECIAL A B C))
(LET ((U
(LOOP FOR S IN '(A B C)
COLLECTING (CONS S (SYMBOL-VALUE S)))))
(FORMAT T "~A~%" U)))
Finally, calling will give
(f :a 3) => ((A . 3) (B) (C))
Note that we need the special declaration otherwise symbol-value doesn't work (you need a global binding for symbol-value). I couldn't find a way to get rid of that.
Looking at your question again, it looks like you actually don't want the keyword arguments that didn't get passed. In which case you could parse a &rest argument (although that's a flat list, so you'd need to map along it in twos) or you could modify the macro as follows:
(defmacro named-args (fun-name alist-sym (&rest syms) &body body)
`(defun ,fun-name (&key ,#syms)
(declare (special ,#syms))
(let ((,alist-sym
(loop
for s in ',syms
when (symbol-value s)
collecting (cons s (symbol-value s)))))
,#body)))
and then you get
(f :a 3) => ((A . 3))