define scheme macro for xor - macros

Notice the following macro is working.
(define-syntax xor
(syntax-rules ()
((xor a1 a2)
(if a1
(false? a2)
(true? a2)))
((xor a1 a2 a3 ...)
(let ((a (xor a1 a2)))
(xor a a3 ...)))))
However it seems if I leave out the a3 in the parameter list of the general case, it won't work properly.
(define-syntax xor
(syntax-rules ()
((xor a1 a2)
(if a1
(false? a2)
(true? a2)))
((xor a1 a2 ...)
(let ((a (xor a1 a2)))
(xor a ...)))))
Thus I am wondering what is going on exactly to the ellipsis in the second case.
Q1. Does that mean the each parameter list excluding the ellipsis should be unique for it to run properly?
For example given input (xor #t #t #t), the first will produce #t, whereas the second will produce #f.
The interpreter I am using is mit-scheme.
Q2. And is it possible to make it short circuiting?
Thanks,

The ellipses tells you something about the second symbol. a2 ... can be zero or more elements and you need to use a2 in what is being repeated for it to work. In your second macro the result with a2 is missing ellipsis for the recurring elements and you have ellipsis after a which isn't a part of the match pattern and also does not have ellipsis. Both of these facts make the macro invalid.
The first macro is correct since you have one term that matches two elements. Your second term also matches two terms, but since the first pattern that matches is run you are sure you have more than two arguments for your second pattern since it matched two with a3 ... being at least one element.
I'm not sure what the true? is for. A slight simplification:
(define-syntax xor
(syntax-rules ()
((xor a1 a2)
(if a1 (not a2) a2))
((xor a1 a2 a3 ...)
(xor (xor a1 a2) a3 ...))))
(xor 1 2 3 4 5) ; ==> 5 (odd number of true values)
(xor 1 2 3 4) ; ==> #f (even number of true values)
(xor 1 2 3 4 #f) ; ==> #f (even number of true values)
(xor 1 #f #f #f) ; ==> #t (odd number of true values)
Now this will calculate the odd parity of the argument expressions. It can not be short circuited since it flip flops. (xor #t #t #f #f #t) ; ==> #t since it has an odd number of true arguments. That's about what it does and while it's daisy chaining xor logic it doesn't really have the only one true logic left. Since you can never short circuit it you might as well use a procedure that does the exact same thing:
(define (xor . args)
(= (remainder (count values args) 2) 1))
(xor 1 2 3 4 5) ; ==> #t (odd number of true values)
(xor 1 2 3 4) ; ==> #f (even number of true values)
(xor 1 2 3 4 #f) ; ==> #f (even number of true values)
(xor 1 #f #f #f) ; ==> #t (odd number of true values)
Count can be found in the SRFI-1 list library.
There is another interpretation of xor and that is the first one I though about when I read this question since it's the only case where short circuit works. It is one that is true iff one expression is true, otherwise the result is false. Here, when encountering the second false value you can short circuit to #f without evaluating the rest of the arguments.
(define-syntax xor
(syntax-rules ()
((_) #f)
((_ a) a)
((_ a b ...)
(if a
(not (or b ...))
(xor b ...)))))
(xor 1 2 3 4 5) ; ==> #f (more than one true value)
(xor 1 2 3 4) ; ==> #f (more than one true value)
(xor 1 2 3 4 #f) ; ==> #f (more than one true value)
(xor 1 #f #f #f) ; ==> #t (only one true value)
;; Slightly more complex version where
;; the result is always the one true value or #f
(define-syntax xor
(syntax-rules ()
((_) #f)
((_ a) a)
((_ a b ...)
(let ((tmp a))
(if tmp
(and (not (or b ...)) tmp)
(xor b ...))))))
(xor 1 2 3 4 5) ; ==> #f
(xor 1 2 3 4) ; ==> #f
(xor 1 2 3 4 #f) ; ==> #f
(xor 1 #f #f #f) ; ==> 1 (the actual true value, consistent)
Most algorithms won't have any speed penalties from using a procedure, but I guess there might be a few situations where this macro might be in handy as a macro. The procedure version of the one that doesn't keep the value is very similar to the procedure version of the other one:
(define (xor . args)
(= (count values args) 1))

I don't know how to use fanciful define-syntax but this might offer some help.
If anyone can explain why xor should be defined as syntax instead of a simple procedure, I'd like to know ^_^
(define (xor a b . xs)
(cond [(and a b) #f]
[(empty? xs) (or a b)]
[else (apply xor (or a b) (car xs) (cdr xs))]))
(xor #t #f) ; => #t
(xor #t #t) ; => #f
(xor #t #f #f) ; => #t
(xor #t #f #f #t) ; => #f
(xor #f #f #f #f #f #t) ; => #t

Related

Append two functions recursively with Racket?

I'm using racket language, but i'm having some trouble getting some expected results for a recursive function. My goal is to input an integer n and output the element n times, as a list.
' exclude the ' and the text, #lang racket
; take n (integer) e (scheme) build new list
; 2 `() -> () ()
; 3 `a -> a a a
; 4 `(a) -> (a) (a) (a) (a)
(define (list n e)
(if (= n 0) e
(append e(list (- n 1) e)) ))
; (list 0 '())
; prints '()
; (list 2 '())
; should print '() '()
Your problem would appear to be that append isn't doing what you're expecting it to - it unwraps and discards top-level empty lists. (e.g. (append '(1) '() '(2) '() '(3)) ;; => '(1 2 3)).
So, swapping cons in for append will result in (what I believe to be) the expected output.
(define (my-list n empty-list)
(if (= n 0)
empty-list
(cons
empty-list
(my-list (- n 1) empty-list))))
(my-list 2 '()) ;; => '(() ())
You should also reconsider clobbering Racket's built-in list function.
This answer has a useful breakdown of what append is doing internally and why it's undesirable in this scenario.

Lisp - if statements various actions

This is my lisp code.
(DEFUN F (A B)
(SETF C (* 4 A))
(SETF D (* 2 (EXPT B 3)))
(SETF RES (+ C D))
(IF (AND (TYPEP A 'INTEGER) (TYPEP B 'INTEGER))
(list 'Final 'value '= res)
'(YOUR INPUTS ARE NOT NUMBERS)))
For example, (f 5 9) works well.
But (f 'w 'q) doesn't work with the following error message:
(ERROR TYPE-ERROR DATUM W EXPECTED-TYPE NUMBER FORMAT-CONTROL
~#<~s' is not of the expected type~s'~:#> FORMAT-ARGUMENTS
(W NUMBER))
Error: W' is not of the expected typeNUMBER'
I want to make if A,B is integer calculate 4A+2B^3.
Else if at least one is not an integer print error message.
I try to the code shown above.
But how can I make this error handling using if statements?
First, you should use LET or LET* to define local variables.
(defun f (a b)
(let* ((c (* 4 a)) ; You need LET* instead of LET because
(d (* 2 (expt b 3))) ; RES depends on the previous variables.
(res (+ c d)))
(if (and (typep a 'integer) (typep b 'integer))
(list 'final 'value '= res)
'(your inputs are not numbers))))
The actual problem is that you're doing the calculations before you check that the arguments are integers. You should move the calculation inside the IF.
(defun f (a b)
(if (and (integerp a) (integerp b))
(let* ((c (* 4 a))
(d (* 2 (expt b 3)))
(res (+ c d)))
(list 'final 'value '= res))
'(your inputs are not numbers)))
Returning lists like that is kind of strange. If you intend them as output for the user, you should instead print the messages and return the actual result.
(defun f (a b)
(if (and (integerp a) (integerp b))
(let ((result (+ (* 4 a)
(* 2 (expt b 3)))))
(format t "Final value = ~a~%" result)
result) ; Return RESULT or
(format t "Your inputs are not integers.~%"))) ; NIL from FORMAT.
In most cases you should signal an error if the arguments are not correct type. Printing output from a function that does the calculation is usually a bad idea.
(defun f (a b)
(check-type a integer "an integer")
(check-type b integer "an integer")
(+ (* 4 a)
(* 2 (expt b 3))))
(defun main (a b)
(handler-case
(format t "Final value = ~a~%" (f a b))
;; CHECK-TYPE signals a TYPE-ERROR if the type is not correct.
(type-error () (warn "Your inputs are not integers."))))
(main 12 1)
; Final value = 50
;=> NIL
(main 12 'x)
; WARNING: Your inputs are not integers.
;=> NIL
Common Lisp condition system also allows you to use restarts to fix errors. CHECK-TYPE establishes a restart named STORE-VALUE, which you can invoke to supply a correct value for the place. In this case it probably doesn't make sense, but you could do something like use 1 as a default.
(defun main (a b)
(handler-bind ((type-error (lambda (e)
(store-value 1 e))))
(format t "Final value = ~a~%" (f a b))))
(main 12 1)
; Final value = 50
;=> NIL
(main 12 'x)
; Final value = 50
;=> NIL
Notice that conditions/error handlers do add some overhead, so for performance critical functions you might not want to use them and instead check your arguments before calling the function.
(declaim (ftype (function (integer integer) integer) f))
(defun f (a b)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(+ (* 4 a)
(* 2 (expt b 3))))
(defun main (a b)
(if (and (integerp a)
(integerp b))
(format t "Final value = ~a~%" (f a b))
(warn "Your inputs are not integers.")))

Creating repetitions of list with mapcan freezes?

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)

returning the best element from the list L according to function F?

i am trying to write a function in lisp which have 2 parameters one function F and one list L
if i place '> in place of F and list L is '(1 2 3 4 5) it will return 5 as 5 is biggest.
and if we put '< then it compares all list elements and gives the smallest one as output.
and so on.
we can even put custom written function in place of F for comparison.
i wish i could provide more sample code but i am really stuck at the start.
(DEFUN givex (F L)
(cond
(F (car L) (car (cdr L))
;after this i got stuck
)
)
another attemp to write this function
(defun best(F list)
(if (null (rest list)) (first list)
(funcall F (first List) (best (F list)))))
You are almost there, just the else clause returns the f's return value instead of the the best element:
(defun best (F list)
(let ((first (first list))
(rest (rest list)))
(if (null rest)
first
(let ((best (best f rest)))
(if (funcall F first best)
best
first)))))
Examples:
(best #'< '(1 2 3))
==> 3
(best #'> '(1 2 3))
==> 1
Note that this recursive implementation is not tail-recursive, so it is not the most efficient one. You might prefer this instead:
(defun best (f list)
(reduce (lambda (a b) (if (funcall f a b) b a)) list))
Or, better yet,
(defmacro fmax (f)
`(lambda (a b) (if (,f a b) b a)))
(reduce (fmax <) '(1 2 3))
==> 1
(reduce (fmax >) '(1 -2 3 -4) :key #'abs)
==> 1
(reduce (fmax <) '(1 -2 3 -4) :key #'abs)
==> 4

Exclusive OR in Scheme

What is the exclusive or functions in scheme? I've tried xor and ^, but both give me an unbound local variable error.
Googling found nothing.
I suggest you use (not (equal? foo bar)) if not equals works. Please note that there may be faster comparators for your situiation such as eq?
As far as I can tell from the R6RS (the latest definition of scheme), there is no pre-defined exclusive-or operation. However, xor is equivalent to not equals for boolean values so it's really quite easy to define on your own if there isn't a builtin function for it.
Assuming the arguments are restricted to the scheme booleans values #f and #t,
(define (xor a b)
(not (boolean=? a b)))
will do the job.
If you mean bitwise xor of two integers, then each Scheme has it's own name (if any) since it's not in any standard. For example, PLT has these bitwise functions, including bitwise-xor.
(Uh, if you talk about booleans, then yes, not & or are it...)
Kind of a different style of answer:
(define xor
(lambda (a b)
(cond
(a (not b))
(else b))))
Reading SRFI-1 shed a new light upon my answer. Forget efficiency and simplicity concerns or even testing! This beauty does it all:
(define (xor . args)
(odd? (count (lambda (x) (eqv? x #t)) args)))
Or if you prefer:
(define (true? x) (eqv? x #t))
(define (xor . args) (odd? (count true? args)))
(define (xor a b)
(and
(not (and a b))
(or a b)))
Since xor could be used with any number of arguments, the only requirement is that the number of true occurences be odd. It could be defined roughly this way:
(define (true? x) (eqv? x #t))
(define (xor . args)
(odd? (length (filter true? args))))
No argument checking needs to be done since any number of arguments (including none) will return the right answer.
However, this simple implementation has efficiency problems: both length and filter traverse the list twice; so I thought I could remove both and also the other useless predicate procedure "true?".
The value odd? receives is the value of the accumulator (aka acc) when args has no remaining true-evaluating members. If true-evaluating members exist, repeat with acc+1 and the rest of the args starting at the next true value or evaluate to false, which will cause acc to be returned with the last count.
(define (xor . args)
(odd? (let count ([args (memv #t args)]
[acc 0])
(if args
(count (memv #t (cdr args))
(+ acc 1))
      acc))))
> (define (xor a b)(not (equal? (and a #t)(and b #t))))
> (xor 'hello 'world)
$9 = #f
> (xor #f #f)
$10 = #f
> (xor (> 1 100)(< 1 100))
$11 = #t
I revised my code recently because I needed 'xor in scheme and found out it wasn't good enough...
First, my earlier definition of 'true? made the assumption that arguments had been tested under a boolean operation. So I change:
(define (true? x) (eqv? #t))
... for:
(define (true? x) (not (eqv? x #f)))
... which is more like the "true" definition of 'true? However, since 'xor returns #t if its arguments have an 'odd? number of "true" arguments, testing for an even number of false cases is equivalent. So here's my revised 'xor:
(define (xor . args)
(even? (count (lambda (x) (eqv? x #f)) args)))