Functional variant of 'oneof' function in Racket - functional-programming

I have written following function to find if one and only one of 5 variables is true:
(define (oneof v w x y z)
(or (and v (not w) (not x) (not y) (not z))
(and w (not v) (not x) (not y) (not z))
(and x (not v) (not w) (not y) (not z))
(and y (not v) (not w) (not x) (not z))
(and z (not v) (not w) (not x) (not y)) ))
(xor takes only 2 arguments)
However, it is very imperative and not functional. Moreover, I want to write a function (oneof N) which will be generic rather than specific for 5 variables. How can this be done? Thanks.
Edit: As pointed out in the comments, the code is 'repetitive' and not 'imperative', though the need for its improvement remains.

Your final note is accurate: it sounds like xor is the right function but this, but it only takes two arguments. It would likely be better if xor took any number of arguments, but given that it doesn’t, we can implement it ourselves.
Perhaps the most naïve way would just to be to count the number of truthy values and check if that number is precisely 1. We can do this with count or for/sum, depending on your preference:
; using count
(define (xor . args)
(= 1 (count identity args)))
; using for/sum
(define (xor . args)
(= 1 (for/sum ([x (in-list args)])
(if x 1 0))))
Both of these work, but they don’t preserve a useful property of Racket’s xor, which returns the single truthy element upon success rather than always returning a boolean. To do this, we could use a fold, using foldl, foldr, or for/fold. However, given that we want to ideally exit as soon as possible, using the #:final option of for/fold is pretty convenient:
(define (xor . args)
(for/fold ([found #f])
([arg (in-list args)])
#:final (and found arg)
(if (and found arg) #f
(or found arg))))
However, this is actually still not really optimal. The two-argument version of xor is a function, not a macro like and and or, because it cannot be lazy in either of its arguments. However, a many-argument xor actually can be. In order to add this short-circuiting behavior, we can write xor as a macro:
(define-syntax xor
(syntax-rules ()
[(_) #f]
[(_ x) x]
[(_ x rest ...)
(let ([v x])
(if v
(and (nor rest ...) v)
(xor rest ...)))]))
In general, this works just like the function versions of xor:
> (xor #f #f #f #f #f)
#f
> (xor #f #f 1 #f #f)
1
> (xor #f #f 1 2 #f)
#f
However, like and and or, it sometimes “short-circuits”, not evaluating expressions if their results will not mater:
> (xor #f #f #f #f (begin (displayln "hello!") #f))
hello!
#f
> (xor #f #f 1 #f (begin (displayln "hello!") #f))
hello!
1
> (xor #f #f 1 2 (begin (displayln "hello!") #f))
#f
(Note that hello! is never printed in the last example.)
Is this a good idea, is it a bad idea…? I don’t really know. It does seem unlikely that this behavior will ever be super useful, and it adds a lot of complexity. It also prevents xor from being used higher-order, but you could get around that with syntax-id-rules and expanding to the procedure version when xor is used in an expression position. Still, it’s potentially interesting, and it makes its behavior more consistent with and and or, so I figured I’d include it for completeness.

You can literally count how many true values you have in a list of arbitrary length, if that number is 1 then we're good (remember that in Scheme any non-false value is considered true). Also notice how to create a procedure with a variable number of arguments, using the dot notation:
(define (oneof . vars)
(= 1
(count (lambda (v) (not (false? v)))
vars)))
For example:
(oneof #f #f #f #f #t)
=> #t
(oneof #f #f #f #f #f)
=> #f
(oneof #t #t #t #t #t)
=> #f

Another solution, more concise, is the following:
(define (oneof . vars)
(= 1 (count identity vars)))

Related

or as procedure in scheme

I want to apply or to every element of list, example:
(apply or '(#t #t #f)) expected result #t, but I'm getting error:
'#' to 'apply' has wrong type (kawa.lang.Macro) (expected: procedure, sequence, or other operator)
As I understand or is not a procedure.
Is there any procedure that can be used instead of or?
The easiest way to do this is with exists*. Whenever you would use (apply or some-list), you can use (exists values some-list). Or if you like, you can define a function that uses exists to do that:
#!r6rs
(import (rnrs base)
(rnrs lists))
(define (or* . lst)
(exists values lst))
values is the identity function, so (values x) is just x.
exists is a higher-order function defined so that (exists f (list x ...)) is equivalent to (or (f x) ...).
For example (exists values (list #t #t #f)) is equivalent to (or (values #t) (values #t) (values #f)), which is the same as (or #t #t #f).
Trying it out:
> (apply or* '(#t #t #f))
#t
> (apply or* '(#f #f #f))
#f
> (or* #t #t #f)
#t
> (or*)
#f
*exists is sometimes known as ormap or any
In SRFI-1 List Library you have every and any which basically is and and or for a procedure over a list.
#!r6rs
(import (rnrs base)
(only (srfi :1) every any)
(define num1-10 '(1 2 3 4 5 6 7 8 9 10))
(define odd1-9 '(1 3 5 7 9))
(every odd? num1-10) ; ==> #f
(any odd? num1-10) ; ==> #t
(every odd? odd1-9) ; ==> #t
For a list of booleans the procedure only need to return the argument. values returns it's argument and serve as identity:
(define booleans '(#f #t))
(every values booleans) ; ==> #f
(any values booleans) ; ==> #t
SRFI-1 is a safe choice as it is the list library of the upcoming R7RS Red edition. In many R5RS and R6RS implementations SRFI-1 is included and you can easily add it from the SRFI reference implementation if it isn't. In DrRacket's default language DrRacket, that has ormap and andmap, you can opt to use SRFI-1 instead by importing them with (require srfi/1).
You could define your own procedure that uses or
(define (orp . ls)
(if (null? ls) #f
(if (< (length ls) 2) (car ls) (or (car ls) (orp (cdr ls))))))
And use it:
(apply orp '(#t #f #t))
The main point is that or (and if, cond, and ....) operator has lazy evaluation semantics. Hence (or #t (/ 1 0)) does not make a division by zero. Because of that or cannot be an ordinary function.
You might code a lambda to force the eager evaluation, e.g. define your eager-or variadic function, and apply that.

Implementation of scheme vector-set

I am trying to understand how vector-set! is implemented. It looks to me like vector-set! is a special form - much like set! is. When I look at examples using vector-set! I see the following, desirable behavior (in guile).
(define test (lambda (v i) (vector-set! v i 0)))
(define v (make-vector 5 1))
v
$1 = #(1 1 1 1 1)
(test v 0)
v
$2 = #(0 1 1 1 1)
I can also do this (in guile)
(define test (lambda (v i) (vector-set! (eval v (interaction-environment)) i 0)))
(test (quote v) 3)
v
$21 = #(0 1 1 0 1)
Contrasting to the set! behavior:
(define a 1)
(define test2 (lambda b (begin (set! b 0) b)))
(test2 (quote a))
$26 = 0
a
$27 = 1
In this case, to my understanding the set! changes b to 0 (and not the 'evaluated" b (which should be a). The eval trick from above does not work here.
My question is: How is vector-set! implemented compared to set! (or set-variable-value!). Does vector-set! peak at it's first argument? Or something else? I have tried to look at some of scheme implementations but extracting the gist from the code is tricky. Perhaps someone has an explanation or a link to some (sicp style) scheme implementation.
The function vector-set! is a so-called primitive.
It is a function (not a special form), but it must be implemented within the runtime.
Note: A special form is a form that uses an evaluation order different from the order used in a normal application. Therefore if, cond, or and others are special forms.
Some implementations (I can't remember if Guile is one of them) has a function primitive? that can be used to test whether a function is a primitive or not.
> (primitive? vector-set!)
#t
In "some SICP-style Scheme implementation", where vector-set! would be handled by eval-vector-mutation, it could be
(define (eval-vector-mutation exp env)
; exp = (vector-set! vec idx val)
(let ((vec (eval (vector-mutation-vec exp) env))
(idx (eval (vector-mutation-idx exp) env))
(val (eval (vector-mutation-val exp) env)))
(begin
(set-car! (cddr (drop vec idx)) val) ; srfi-1 drop
vec)))
and make-vector handled by
(define (eval-vector-creation exp env)
; exp = (make-vector cnt val)
(let ((cnt (eval (vector-creation-cnt exp) env))
(val (eval (vector-creation-val exp) env)))
(cons 'vector ; tagged list
(cons cnt ; vector size
(make-list cnt val))))) ; srfi-1 make-list
Here vectors are represented by tagged lists in the underlying Scheme implementation (not the Scheme being defined), and its mutation primitives, like set-car!, are used to manipulate them. If your implementation language were C, say, you'd just use C arrays as your vectors representation, or perhaps a structure coupling an array with the additional pertinent info, like its size ,etc.

Why are this list's contents retained between function calls? [duplicate]

Could someone explain to me what's going on in this very simple code snippet?
(defun test-a ()
(let ((x '(nil)))
(setcar x (cons 1 (car x)))
x))
Upon a calling (test-a) for the first time, I get the expected result: ((1)).
But to my surprise, calling it once more, I get ((1 1)), ((1 1 1)) and so on.
Why is this happening? Am I wrong to expect (test-a) to always return ((1))?
Also note that after re-evaluating the definition of test-a, the return result resets.
Also consider that this function works as I expect:
(defun test-b ()
(let ((x '(nil)))
(setq x (cons (cons 1 (car x))
(cdr x)))))
(test-b) always returns ((1)).
Why aren't test-a and test-b equivalent?
The Bad
test-a is self-modifying code. This is extremely dangerous. While the variable x disappears at the end of the let form, its initial value persists in the function object, and that is the value you are modifying. Remember that in Lisp a function is a first class object, which can be passed around (just like a number or a list), and, sometimes, modified. This is exactly what you are doing here: the initial value for x is a part of the function object and you are modifying it.
Let us actually see what is happening:
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote (nil)))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1))))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1 1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1 1))))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1 1 1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1 1 1))))) (setcar x (cons 1 (car x))) x))
The Good
test-b returns a fresh cons cell and thus is safe. The initial value of x is never modified. The difference between (setcar x ...) and (setq x ...) is that the former modifies the object already stored in the variable x while the latter stores a new object in x. The difference is similar to x.setField(42) vs. x = new MyObject(42) in C++.
The Bottom Line
In general, it is best to treat quoted data like '(1) as constants - do not modify them:
quote returns the argument, without evaluating it. (quote x) yields x.
Warning: quote does not construct its return value, but just returns
the value that was pre-constructed by the Lisp reader (see info node
Printed Representation). This means that (a . b) is not
identical to (cons 'a 'b): the former does not cons. Quoting should
be reserved for constants that will never be modified by side-effects,
unless you like self-modifying code. See the common pitfall in info
node Rearrangement for an example of unexpected results when
a quoted object is modified.
If you need to modify a list, create it with list or cons or copy-list instead of quote.
See more examples.
PS1. This has been duplicated on Emacs.
PS2. See also Why does this function return a different value every time? for an identical Common Lisp issue.
PS3. See also Issue CONSTANT-MODIFICATION.
I found the culprit is indeed 'quote. Here's its doc-string:
Return the argument, without evaluating it.
...
Warning: `quote' does not construct its return value, but just returns
the value that was pre-constructed by the Lisp reader
...
Quoting should be reserved for constants that will
never be modified by side-effects, unless you like self-modifying code.
I also rewrote for convenience
(setq test-a
(lambda () ((lambda (x) (setcar x (cons 1 (car x))) x) (quote (nil)))))
and then used
(funcall test-a)
to see how 'test-a was changing.
It looks like the '(nil) in your (let) is only evaluated once. When you (setcar), each call is modifying the same list in-place. You can make (test-a) work if you replace the '(nil) with (list (list)), although I presume there's a more elegant way to do it.
(test-b) constructs a totally new list from cons cells each time, which is why it works differently.

Need a little help for this scheme "leet-speak"

I wrote a program below for "Define a procedure leet-speak takes a string and returns the result of changing all s's to fives, all e's to threes, all l's to ones, and all o's to zeros. Do not write any recursive code to do this. Simply make use of string->list, map, and list->string."
The error I got is:
~ (leet-speak "leet speak neat speak")
Exception: attempt to apply non-procedure (1 3 3 #\t #\space 5 ...)
Here is my definition for leet-speak:
(define leet-speak
(lambda (y)
(list->string
((map
(lambda (x)
(cond
[(eq? #\l x) 1]
[(eq? #\s x) 5]
[(eq? #\o x) 0]
[(eq? #\e x) 3]
[else x])
) (string->list y )))))
I really can't find out where the problem is.
You have too many parentheses around the map. Remove the extra so that there's only one parenthesis before map, and you should be good to go.
Your cond also needs to return the character corresponding to the number, not the number itself. Also, consider using a case instead of the cond you have.
All up, here's how it would look:
(define (leet-speak str)
(list->string
(map (lambda (x)
(case x
[(#\l) #\1]
[(#\s) #\5]
[(#\o) #\0]
[(#\e) #\3]
[else x]))
(string->list str))))

Scheme - do iterative - return value

I trying to write a function which gets an integer number , represented by string , and check if all his chars are digits and return #t \ #f accordingly . Thats the code -
(define (splitString str) (list->vector (string->list str)))
(define myVector 0)
(define flag #t)
(define (checkIfStringLegal str) (
(set! myVector (splitString str))
(do ( (i 0 (+ i 1)) ) ; init
((= i (vector-length myVector)) flag) ; stop condition
(cond ((>= 48 (char->integer (vector-ref myVector i)) ) (set! flag #f))
((<= 57 (char->integer (vector-ref myVector i)) )(set! flag #f))
)
)
)
)
Few explanations -
(list->vector (string->list str)) - convert string the char list .
(vector-ref myVector i) - char from the myVector at place i .
Its run OK , but when I try to use this func , like (checkIfStringLegal "444") I get -
application: not a procedure;
expected a procedure that can be applied to arguments
given: #<void>
arguments...:
#t
Try this:
(define (checkIfStringLegal str)
(andmap char-numeric?
(string->list str)))
This is how the procedure works:
It transforms the string into a list of characters, using string->list
It validates each character in the list to see if it's a number, applying the predicate char-numeric? to each one
If all the validations returned #t, andmap will return #t. If a single validation failed, andmap will return #f immediately
That's a functional-programming solution (and after all, this question is tagged as such), notice that your intended approach looks more like a solution in a C-like programming language - using vectors, explicit looping constructs (do), mutation operations (set!), global mutable definitions ... that's fine and it might eventually work after some tweaking, but it's not the idiomatic way to do things in Scheme, and it's not even remotely a functional-programming solution.
EDIT:
Oh heck, I give up. If you want to write the solution your way, this will work - you had a parenthesis problem, and please take good notice of the proper way to indent and close parenthesis in Scheme, it will make your code more readable for you and for others:
(define (splitString str) (list->vector (string->list str)))
(define myVector 0)
(define flag #t)
(define (checkIfStringLegal str)
(set! myVector (splitString str))
(do ((i 0 (+ i 1)))
((= i (vector-length myVector)) flag)
(cond ((>= 48 (char->integer (vector-ref myVector i)))
(set! flag #f))
((<= 57 (char->integer (vector-ref myVector i)))
(set! flag #f)))))
Even so, the code could be further improved, I'll leave that as an exercise for the reader:
Both conditions can be collapsed into a single condition, using an or
The exit condition should be: end the loop when the end of the vector is reached or the flag is false

Resources