I want to be able to do something like this:
(struct point (x y))
(define p1 (point 1 2))
(define p2 (point 10 20))
(+ p1 p2) ; -> (point 11 22)
Is it possible to teach a struct like point to work with built-in math operators like +?
The docs seem to manage to implement custom (equal? ...) handling in section 5.5 on this page. What I'm trying to do is quite similar ...
Or should I just define function like (point-add p1 p2)?
You can either
Go with point-add
Use your own + that matches against all possible value types that you want to take on. This is sufficient if you know all possible value types beforehand, but it wouldn't be easy to extend it to include newly created struct definitions in client's code. For example:
;; We will "shadow" Racket's + with our own +, but we still
;; need the functionality of Racket's +, so let's require
;; Racket's + but use the name racket:+ instead
(require (only-in racket/base [+ racket:+]))
(struct point (x y) #:transparent)
(define (+ x y)
(match* (x y)
[((point a b) (point c d)) (point (+ a c) (+ b d))]
[((point _ _) _) (error '+ "Can't add a point with non point")]
[(_ (point _ _)) (error '+ "Can't add a point with non point")]
[(_ _) (racket:+ x y)]))
;; in client's code
(+ (point 1 2) (point 3 4)) ;=> (point 4 6)
(+ 1 2) ;=> 3
Define a new generics so that we can do something similar to gen:equal+hash for equal?. For example:
(require racket/generic
(only-in racket/base [+ racket:+]))
(define-generics addable
(add addable _)
#:fast-defaults ([number?
(define (add x y) (racket:+ x y))]))
(define + add)
;; in client's code
(struct point (x y)
#:transparent
#:methods gen:addable
[(define (add x y)
(match* (x y)
[((point a b) (point c d)) (point (+ a c) (+ b d))]
[(_ _) (error 'add "Can't add a point with non point")]))])
(struct point-3d (x y z)
#:transparent
#:methods gen:addable
[(define (add x y)
(match* (x y)
[((point-3d a b c) (point-3d d e f))
(point-3d (+ a d) (+ b e) (+ c f))]
[(_ _) (error '+ "Can't add a point-3d with non point-3d")]))])
(+ (point 1 2) (point 3 4)) ;=> (point 4 6)
(+ (point-3d 1 2 3) (point-3d 4 5 6)) ;=> (point-3d 5 7 9)
(+ 1 2) ;=> 3
To accept multiple arguments, modify (3) as follows
(define +
(case-lambda
[() 0]
[(x . xs) (foldl add x xs)]))
;; client's code
(+ (point 1 2) (point 3 4) (point 5 6)) ;=> (point 9 12)
(+ 1 2 3) ;=> 6
(+) ;=> 0
(+ 1) ;=> 1
(+ (point-3d 1 2 3)) ;=> (point-3d 1 2 3)
Related
This procedure to identify that a tic-tac-toe row is marked does not work (X _ _ row is identified as fully marked when it is not)
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? (list ,#r))) rr))))
while the procedure below works
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(or (row-marked? '(0 1 2)) (row-marked? '(3 4 5)) (row-marked? '(6 7 8))
(row-marked? '(0 3 6)) (row-marked? '(1 4 7)) (row-marked? '(2 5 8))
(row-marked? '(0 4 8)) (row-marked? '(2 4 6))))
I've tried with no luck
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? ,r)) rr)))
and
(let ([rr '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))])
`(or ,#(map (lambda (r) `(row-marked? ',r)) rr)))
as well. What I'm doing wrong?
My goal is to avoid code repetition and automatically generate the executable (or ...) expression while keeping the short-circuiting of both or and every-ec
Thank you!
What you need isn't a macro (and as you've specified it it can not be done by a macro), it's SRFI 1's any function:
(define (won? b m)
(define (row-marked? r)
(every?-ec (:vector c (index i) b) (if (memv i r)) [char=? c m]))
"Returns #t if the mark m won"
(any row-marked?
'((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))))
A single-list version of any, which is all you need, is very easy to write:
(define (any/1 p l)
(if (null? l)
#f
(or (p (first l))
(any/1 p (rest l)))))
A fully-fledged any is a bit harder to get right, especially if you want it to be efficient in the simple cases.
It's worth while perhaps seeing why what you want to achieve can't be done with a macro. If you consider the fragment
(let ([rr ...])
(m row-marked? rr))
Then can m be a macro whose expansion is (or (row-marked ...) ...)? No, it can't be, because macros transform source code and the list which is bound to rr is not available until run time: the macro does not have the source code it needs to transform.
Really, the thing you want to avoid here, is that the forms in the body of row-marked? should be evaluated only as many times until they return true, and the mechanism for doing that is just wrapping them up in a function and calling it only as many times as needed.
However that mechanism is sometimes a bit syntactically clumsy: if I have something like
(any (λ (e1 e2)
(and (integer? e1) (integer? e2)
(even? e1) (even? e2))
(not (= e1 e2)))
l1 l2)
I might rather write this as
(finding-first ((e1 l1) (e2 l2))
(and (integer? e1) (integer? e2)
(even? e1) (even? e2)
(not (= e1 e2))))
And, of course, you can:
(define-syntax finding-first
(syntax-rules ()
[(_ ((v l) ...) form ...)
(any (λ (v ...) form ...) l ...)]))
I have the following task:
To build the function (REMOVE EL), that removes given atom or list from another list, and this should apply on each level of the list
Example :
L=(A B A (B A C X ) X B)
(REMOVE A L ) -> (B (B C X) X B)
I wrote the following code :
(defun removeel(el tree)
(mapcan (lambda(subtree)
(cond ((null subtree) (list nil))
((consp subtree) (list (removeel el subtree)))
((eql subtree el) nil)
(t (list subtree))))
tree))
The problem is that when I remove atom, it works excellent
(removeel 'B' (A B A (B A C X ) X B))
(A A (A C X) X)
But it doesn't work If I want to remove a list
(removeel '(B A C X) ' (A B A (B A C X ) X B))
(A B A (B A C X) X B)
What should be done to make it to remove lists too ?
the simplest way would be to introduce optional equality test function, as in remove standard procedure.
it could look this way:
(defun rem-rec (item data &key (test #'eql))
(mapcar (lambda (x) (if (listp x)
(rem-rec item x :test test)
x))
(remove item data :test test)))
CL-USER> (rem-rec 1 `(1 2 (3 4 (1 2 3)) (1 (1 2 3) 3 4)))
;;=> (2 (3 4 (2 3)) ((2 3) 3 4))
for lists equality you can use equal (or equalp or anything more specific)
CL-USER> (rem-rec '(1 2 3) '(1 2 (3 4 (1 2 3)) (1 (1 2 3) 3 4)) :test #'equal)
;;=> (1 2 (3 4) (1 3 4))
I would like to write a macro to create shorthand syntax for hiding more verbose lambda expressions, but I'm struggling to understand how to write macros (which I realize is an argument against using them).
Given this example:
(define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(define ($ alist name)
(cdr (assoc name alist)))
((lambda (a) (map (lambda (x y z) (+ x y z)) ($ a 'x) ($ a 'y) ($ a 'z))) alist-example)
((lambda (a) (map (lambda (y) (/ y (apply max ($ a 'y)))) ($ a 'y))) alist-example)
I would like to write a macro, with-alist, that would allow me to write the last two expressions similar to this:
(with-alist alist-example (+ x y z))
(with-alist alist-example (/ y (apply max y)))
Any advice or suggestions?
Here is a syntax-rules solution based on the feedback that I received in the other answer and comments:
(define ($ alist name)
(cdr (assoc name alist)))
(define-syntax with-alist
(syntax-rules ()
[(_ alist names expr)
(let ([alist-local alist])
(apply map (lambda names expr)
(map (lambda (name) ($ alist-local name)) (quote names))))]))
Here is some example usage:
> (define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
> (with-alist alist-example (x) (+ x 2))
(3 4 5)
> (with-alist alist-example (x y) (+ x y))
(5 7 9)
> (with-alist alist-example (x y z) (+ x y z))
(12 15 18)
This answer stops short of solving the more complicated example, (with-alist alist-example (/ y (apply max y))), in my question, but I think this is a reasonable approach for my purposes:
> (with-alist alist-example (y) (/ y (apply max ($ alist-example 'y))))
(2/3 5/6 1)
EDIT: After some additional tinkering, I arrived at a slightly different solution that I think will provide more flexibility.
My new macro, npl, expands shorthand expressions into a list of names and procedures.
(define-syntax npl
(syntax-rules ()
[(_ (names expr) ...)
(list
(list (quote names) ...)
(list (lambda names expr) ...))]))
The output of this macro is passed to a regular procedure, with-list-map, that contains most the core functionality in the with-alist macro above.
(define (with-alist-map alist names-proc-list)
(let ([names-list (car names-proc-list)]
[proc-list (cadr names-proc-list)])
(map (lambda (names proc)
(apply map proc
(map (lambda (name) ($ alist name)) names)))
names-list proc-list)))
The 3 examples of with-alist usage above can be captured in a single call to with-alist-map.
> (with-alist-map alist-example
(npl ((x) (+ x 2))
((x y) (+ x y))
((x y z) (+ x y z))))
((3 4 5) (5 7 9) (12 15 18))
The immediate problem I see is that there is no way to tell which bindings to pick. Eg. is apply one of the elements in the alist or is it a global variable? That depends. I suggest you do:
(with-alist ((x y z) '((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(+ x y z))
(let ((z 10))
(with-alist ((x y) alist-example)
(+ x y z)))
And that it should translate to:
(let ((tmp '((x 1 2 3) (y 4 5 6) (z 7 8 9))))
(apply map (lambda (x y z) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y z))))
(let ((z 10))
(let ((tmp alist-example))
(apply map (lambda (x y) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y)))))
This is then straight forward to do with syntax-rules. Eg. make a pattern and write the replacement. Good luck.
I need to write procedure for calculation of weighted sum in follow functionality:
((weighted-sum 1) 5)
5
((weighted-sum 1/2 1/2) 3 1)
2
etc..
So far I did only how to get parameters for procedure:
(define (weighted-sum x . xn) (cons x xs))
(weighted-sum 2 3)
> '(2 3)
How to get ((weighted-sum 2 3) X X) parameters?
Thank you.
Your question doesn't have one easy answer. It sounds like you're supposed to write a function that accepts a sequence of weights, and returns a function that accepts a sequence of weights, and sums the products of the weights and the sums (by the way, stating this yourself would have been really helpful...).
1) Is this your design, or someone else's? I would not design this function this way.
2) You can write functions that return functions in a bunch of different ways. E.g.:
;; these all do the same thing.
;; they all have the type (number -> (number -> number))
(define a (lambda (x) (lambda (y) (+ x y))))
(define ((a x) y) (+ x y))
(define (a x)
(define (b y) (+ x y))
b)
So weighted-sum takes a variable number of values as parameters (let's call them ws) , and returns a new procedures that, in its turn, takes a variable number of parameters (vs) and does the calculation.
In racket, the for/fold construct comes in handy:
(define (weighted-sum . ws)
(lambda vs
(for/fold ((res 0)) ((i (in-list ws))
(j (in-list vs)))
(+ res (* i j)))))
or even
(define ((weighted-sum . ws) . vs)
(for/fold ((res 0)) ((i (in-list ws))
(j (in-list vs)))
(+ res (* i j))))
Alternatively, using a more classic foldl returning a named inner procedure:
(define (weighted-sum . ws)
(define (sub . vs)
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws
vs))
sub)
For any of those:
> ((weighted-sum 1) 5)
5
> ((weighted-sum 1/2 1/2) 3 1)
2
I have two lists: (1 2 3) and (a b) and I need to create something like this (1 2 3 1 2 3). The result is a concatenation of the first list as many times as there are elements in the second. I should use some of the functions (maplist/mapcar/mapcon, etc.). This is exactly what I need, although I need to pass first list as argument:
(mapcan #'(lambda (x) (list 1 2 3)) (list 'a 'b))
;=> (1 2 3 1 2 3)
When I try to abstract it into a function, though, Allegro freezes:
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) (list 'a 'b))
; <freeze>
Why doesn't this definition work?
There's already an accepted answer, but I think some more explanation about what's going wrong in the original code is in order. mapcan applies a function to each element of a list to generate a bunch of lists which are destructively concatenated together. If you destructively concatenate a list with itself, you get a circular list. E.g.,
(let ((x (list 1 2 3)))
(nconc x x))
;=> (1 2 3 1 2 3 1 2 3 ...)
Now, if you have more concatenations than one, you can't finish, because to concatenate something to the end of a list requires walking to the end of the list. So
(let ((x (list 1 2 3)))
(nconc (nconc x x) x))
; ----------- (a)
; --------------------- (b)
(a) terminates, and returns the list (1 2 3 1 2 3 1 2 3 ...), but (b) can't terminate since we can't get to the end of (1 2 3 1 2 3 ...) in order to add things to the end.
Now that leaves the question of why
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) '(a b))
leads to a freeze. Since there are only two elements in (a b), this amounts to:
(let ((x (list 1 2 3)))
(nconc x x))
That should terminate and return an infinite list (1 2 3 1 2 3 1 2 3 ...). In fact, it does. The problem is that printing that list in the REPL will hang. For instance, in SBCL:
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
; <I manually stopped this, because it hung.
CL-USER> (let ((x (list 1 2 3)))
(nconc x x) ; terminates
nil) ; return nil, which is easy to print
NIL
If you set *print-circle* to true, you can see the result from the first form, though:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
#1=(1 2 3 . #1#) ; special notation for reading and
; writing circular structures
The simplest way (i.e., fewest number of changes) to adjust your code to remove the problematic behavior is to use copy-list in the lambda function:
(defun foo (a b)
(mapcan #'(lambda (x)
(copy-list a))
b))
This also has an advantage over a (reduce 'append (mapcar ...) :from-end t) solution in that it doesn't necessarily allocate an intermediate list of results.
You could
(defun f (lst1 lst2)
(reduce #'append (mapcar (lambda (e) lst1) lst2)))
then
? (f '(1 2 3) '(a b))
(1 2 3 1 2 3)
Rule of thumb is to make sure the function supplied to mapcan (and destructive friends) creates the list or else you'll make a loop. The same applies to arguments supplied to other destructive functions. Usually it's best if the function has made them which makes it only a linear update.
This will work:
(defun foo (a b)
(mapcan #'(lambda (x) (copy-list a)) b))
Here is some alternatives:
(defun foo (a b)
;; NB! apply sets restrictions on the length of b. Stack might blow
(apply #'append (mapcar #'(lambda (x) a) b))
(defun foo (a b)
;; uses loop macro
(loop for i in b
append a))
I really don't understand why b cannot be a number? You're really using it as church numbers so I think I would have done this instead:
(defun x (list multiplier)
;; uses loop
(loop for i from 1 to multiplier
append list))
(x '(a b c) 0) ; ==> nil
(x '(a b c) 1) ; ==> (a b c)
(x '(a b c) 2) ; ==> (a b c a b c)
;; you can still do the same:
(x '(1 2 3) (length '(a b))) ; ==> (1 2 3 1 2 3)