Recursive numeric equality in Scheme - recursion

It seems that Scheme considers integer and floating point versions of a number to be different when using equal?, but the same when using = to compare them:
(equal? 2 2.0) ; => #f
(= 2 2.0) ; => #t
However, if I have a recursive structure with some numeric parts (or even a simple list of numbers), is there a method to compare them that uses = for numeric comparisons?
(equal? '(2 3) '(2.0 3.0)) ; => #f
(= '(2 3) '(2.0 3.0)) ; error: contract violation
I can write my own equality checker, something like this:
(define myequal?
(lambda (x y)
(cond ((and (null? x) (null? y)) #t)
((or (null? x) (null? y)) #f)
((and (pair? x) (pair? y))
(and (myequal? (car x) (car y))
(myequal? (cdr x) (cdr y))))
((or (pair? x) (pair? y)) #f)
((and (number? x) (number? y)) (= x y))
((or (number? x) (number? y)) #f)
(else (equal? x y)))))
But it seems like this would be a common enough task that Scheme might have a builtin method to do this.

In Racket you can build the notion of equality that you want with the help of the equal?/recur built-in procedure:
;; equalish? : Any Any -> Boolean
;; Like equal?, but use = for numbers (including within compound data)
(define (equalish? a b)
(if (and (number? a) (number? b))
(= a b)
(equal?/recur a b equalish?)))
(equalish? '(2 3) '(2.0 3.0))
;; => #t
The equal?/recur procedure handles recurring through pairs, structures, etc.

Scheme is a minimalistic language and have very few primitives. 2 and 2.0 are not the same number because 2.0 can be lower and higher than 2 which is the exact amount 2.
If you have a list with numbers and wish to check if all are the same with = you can do it using every from SRFI-1 List Library:
;; include the library. In R5RS this is impleentation specific
;; and worst case you need to load of external file to be portable.
(load "srfi1.scm")
(every = '(2 3) '(2.0 3.0)) ; ==> #t
In R6RS it gets simpler:
#!r6rs
(import (rnrs base)
(only (srfi :1) every))
(every = '(2 3) '(2.0 3.0)) ; ==> #t
And since you have tagged Racket there is a chance that you might not write Scheme but perhaps #lang racket which has both support for SRFI-1 and its own version of every that is called andmap:
#lang racket
(andmap = '(2 3) '(2.0 3.0)) ; ==> #t
(require srfi/1)
(every = '(2 3) '(2.0 3.0)) ; ==> #t
EDIT
A generic solution for all tree structures that use itself for tree structure and equal? when there are no more type specific options:
(define (make-equal . predicates-and-equal-procedures)
(when (odd? (length predicates-and-equal-procedures))
(error "make-equal needs an even number of predicate and equal function arguments"))
(define (mequal? a b)
(if (pair? a)
(and (pair? b)
(mequal? (car a) (car b))
(mequal? (cdr a) (cdr b)))
(let loop ((pe predicates-and-equal-procedures))
(if (null? pe)
(equal? a b)
(let ((p? (car pe)))
(if (p? a)
(and (p? b)
((cadr pe) a b))
(loop (cddr pe))))))))
mequal?)
(define list=?
(make-equal number? =))
(list=? '(1 2 a b "test") '(1.0 2 a b "test")) ; ==> #t
(define equal-ci?
(make-equal string? string-ci=? char? char-ci=?))
(equal-ci? '(1 2 a b "Test") '(1 2 a b "test")) ; ==> #t
(define inexact-eq-ci?
(make-equal number? = string? string-ci=? char? char-ci=?))
(inexact-eq-ci? '(1 2 a b "test") '(1.0 2 a b "TEST")) ; ==> #t

Related

Common Lisp calling a deftype method

I'm not been able to make this working on. I'm defining a predicate using deftype SameType(x y) method, which evaluates whether the elements of list x and list y are of the same type, and in the same position. The problem comes when I try to call the predicate for testing. I receive an error ERROR: SameType is undefined This is my code:
(deftype SameType (x y)
`(cond
((and (null x) (null y) T))
(
(and (numberp (car x)) (numberp (car y)))
(SameType (cdr x) (cdr y) )
)
(
(and (stringp (car x)) (stringp (car y)))
(SameType (cdr x) (cdr y) )
)
(
(and (atom (car x)) (atom (car y)))
(SameType (cdr x) (cdr y) )
)
(T nil)
)
)
And this is how I'm calling it
(SameType '(A B C 1 2 4 A) '('() G 2 5 6 A B))
I already checked on various onine resources, even related questions on this site.
deftype can be used to define a type, not a predicate. For instance, to define the type of the lists with only integers, you could write something like:
(defun intlistp (l)
"predicate to check if l is a list consisting only of integers"
(and (listp l) ; l is a list and
(every #'integerp l))) ; every element of l is an integer
(deftype integer-list ()
"the type of list of integers"
`(satisfies intlistp))
and then you can check if a value satisfies this type:
CL-USER> (typep '(1 2 3) 'integer-list)
T
CL-USER> (typep '(1 2.5 3) 'integer-list)
NIL
If you want to check if two lists have the same type according to your definition, then you could define a regular function:
(defun same-type (l1 l2)
"check if lists l1 and l2 have the same length and corresponding
elements of the same CL type"
(cond ((null l1) ; if l1 is null
(null l2)) ; returns true only if also l2 is null
((and (consp l1) ; if l1 is a cons
(consp l2) ; and l2 is a cons too,
(typep (car l1) (type-of (car l2)))) ; and their cars have the same CL type
(same-type (cdr l1) (cdr l2))))) ; go recursively on their cdrs
CL-USER> (same-type '(1 a 3) '(2 b 4))
T
CL-USER> (same-type '(1 "a" 3) '(2 "b" 3))
T
CL-USER> (same-type '(1 a 3) '(2 b 4.5))
NIL
CL-USER> (same-type '(1 a 3) '(2 b 4 3))
NIL
CL-USER> (same-type '(1 2 (3 4)) '(1 6 (4 5)))
T
CL-USER> (same-type '(1 2 (3 4)) '(1 6 (4 5 6)))
T
Note that, as you can see from the last example, the type is checked only for the first level of the list.

Check for ascending order of a list in Racket

I'm new to racket and trying to write a function that checks if a list is in strictly ascending order.
'( 1 2 3) would return true
'(1 1 2) would return false (repeats)
'(3 2 4) would return false
My code so far is:
Image of code
(define (ascending? 'list)
(if (or (empty? list) (= (length 'list) 1)) true
(if (> first (first (rest list))) false
(ascending? (rest list)))))
I'm trying to call ascending? recursively where my base case is that the list is empty or has only 1 element (then trivially ascending).
I keep getting an error message when I use check-expect that says "application: not a procedure."
I guess you want to implement a procedure from scratch, and Alexander's answer is spot-on. But in true functional programming style, you should try to reuse existing procedures to write the solution. This is what I mean:
(define (ascending? lst)
(apply < lst))
It's shorter, simpler and easier to understand. And it works as expected!
(ascending? '(1 2 3))
=> #t
(ascending? '(1 1 2))
=> #f
Some things to consider when writing functions:
Avoid using built in functions as variable names. For example, list is a built in procedure that returns a newly allocated list, so don't use it as an argument to your function, or as a variable. A common convention/alternative is to use lst as a variable name for lists, so you could have (define (ascending? lst) ...).
Don't quote your variable names. For example, you would have (define lst '(1 2 3 ...)) and not (define 'lst '(1 2 3 ...)).
If you have multiple conditions to test (ie. more than 2), it may be cleaner to use cond rather than nesting multiple if statements.
To fix your implementation of ascending? (after replacing 'list), note on line 3 where you have (> first (first (rest list))). Here you are comparing first with (first (rest list)), but what you really want is to compare (first lst) with (first (rest lst)), so it should be (>= (first lst) (first (rest lst))).
Here is a sample implementation:
(define (ascending? lst)
(cond
[(null? lst) #t]
[(null? (cdr lst)) #t]
[(>= (car lst) (cadr lst)) #f]
[else
(ascending? (cdr lst))]))
or if you want to use first/rest and true/false you can do:
(define (ascending? lst)
(cond
[(empty? lst) true]
[(empty? (rest lst)) true]
[(>= (first lst) (first (rest lst))) false]
[else
(ascending? (rest lst))]))
For example,
> (ascending? '(1 2 3))
#t
> (ascending? '(1 1 2))
#f
> (ascending? '(3 2 4))
#f
If you write down the properties of an ascending list in bullet form;
An ascending list is either
the empty list, or
a one-element list, or
a list where
the first element is smaller than the second element, and
the tail of the list is ascending
you can wind up with a pretty straight translation:
(define (ascending? ls)
(or (null? ls)
(null? (rest ls))
(and (< (first ls) (first (rest ls)))
(ascending? (rest ls)))))
This Scheme solution uses an explicitly recursive named let and memoization:
(define (ascending? xs)
(if (null? xs) #t ; Edge case: empty list
(let asc? ((x (car xs)) ; Named `let`
(xs' (cdr xs)) )
(if (null? xs') #t
(let ((x' (car xs'))) ; Memoization of `(car xs)`
(if (< x x')
(asc? x' (cdr xs')) ; Tail recursion
#f)))))) ; Short-circuit termination
(display
(ascending?
(list 1 1 2) )) ; `#f`

Recursive Cartesian Product Function Racket

I am trying to implement a recursive function to find the cartesian product of two sets. The code I have currently is as follows:
(define (cartesian-product set-1 set-2)
(let (b (set 2))
(cond [(empty? set-1) '()]
[(empty? set-2) (cartesian-product (rest set-1) b)]
[else (append (list (list (first set-1) (first set-2))) (cartesian product set-1 (rest set-2)))]))))
However, there are errors with my logic that I haven't been able to pinpoint precisely. Any help is appreciated!
How about something with two loops instead of one?
(define (cartesian-product set-1 set-2)
(define (cartesian-product-helper element set)
(if (empty? set)
set
(cons (list element (first set))
(cartesian-product-helper element (rest set)))))
(if (or (empty? set-1)
(empty? set-2))
empty
(cons (cartesian-product-helper (first set-1) set-2)
(cartesian-product (rest set-1) set-2))))
You found the issue in your logic and attempted to save set-2 (which you typo'd as (set 2)) in b, but this value will be overwritten at each recursive call. If you call the helper function instead, which loops through all elements of one set along with the first element of the other set, your issue goes away.
Welcome to DrRacket, version 6.1.1 [3m].
Language: racket; memory limit: 128 MB.
> (cartesian-product '(1 2 3) '(x y z))
'(((1 x) (1 y) (1 z))
((2 x) (2 y) (2 z))
((3 x) (3 y) (3 z)))
> (cartesian-product '(1 2 3) '())
'()
> (cartesian-product '() '(x y z))
'()
Alternatively, something more racket-like:
(define (cartesian-product set-1 set-2)
(if (or (empty? set-1)
(empty? set-2))
empty
(for/list ([i set-1])
(for/list ([j set-2])
(list i j)))))

How can i remove parentheses in scheme?

i have a function in scheme, this function calls another function many times, and every time this function appends return value of another function to result value.
but finally i want to get a result such that '(a b c), however i get a result such that '((a) (b) (c)) how can i fix this problem? i have searched but i couldn't find good solution.
my little code like that not all of them.
(append res (func x))
(append res (func y))
(append res (func z))
my code like this
(define (check a )
'(1)
)
(define bos '())
(define (func a)
(let loop1([a a] [res '()])
(cond
[(eq? a '()) res]
[else (let ([ x (check (car a))])
(loop1 (cdr a) (append res (list x)))
)]
)
))
Try this:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) res]
[else
(let ([ x (check (car a))])
(loop1 (cdr a) (append res x)))])))
Notice that the only change I made (besides improving the formatting) was substituting (list x) with x. That will do the trick! Alternatively, but less portable - you can use append* instead of append:
(append* res (list x))
As a side comment, you should use (null? a) for testing if the list is empty. Now if we test the procedure using the sample code in the question, we'll get:
(func '(a b c))
=> '(1 1 1)
It seems that instead of
(loop1 (cdr a) (cdr b) c (append res (list x)))
you want
(loop1 (cdr a) (cdr b) c (append res x))
Basically the trick is to use cons instead of list. Imagine (list 1 2 3 4) which is the same as (cons 1 (cons 2 (cons 3 (cons 4 '())))). Do you see how each part is (cons this-iteration-element (recurse-further)) like this:
(define (make-list n)
(if (zero? n)
'()
(cons n (make-list (sub1 n)))))
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Usually when you can choose direction you can always make it tail recursive with an accumulator:
(define (make-list n)
(let loop ((x 1) (acc '()))
(if (> x n)
acc
(loop (add1 x) (cons x acc))))) ; build up in reverse!
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Now this is a generic answer. Applied to your working code:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) (reverse res)]
[else
(let ([x (check (car a))])
(loop1 (cdr a) (cons (car x) res)))])))
(func '(a b c)) ; ==> (1 1 1)
append replaces the cons so why not put the car og your result to the rest of the list. Since you want the result in order I reverse the result in the base case. (can't really tell from the result, but I guessed since you ise append)

How do you properly compute pairwise differences in Scheme?

Given a list of numbers, say, (1 3 6 10 0), how do you compute differences (xi - xi-1), provided that you have x-1 = 0 ?
(the result in this example should be (1 2 3 4 -10))
I've found this solution to be correct:
(define (pairwise-2 f init l)
(first
(foldl
(λ (x acc-data)
(let ([result-list (first acc-data)]
[prev-x (second acc-data)])
(list
(append result-list (list(f x prev-x)))
x)))
(list empty 0)
l)))
(pairwise-2 - 0 '(1 3 6 10 0))
;; => (1 2 3 4 -10)
However, I think there should be more elegant though no less flexible solution. It's just ugly.
I'm new to functional programming and would like to hear any suggestions on the code.
Thanks.
map takes multiple arguments. So I would just do
(define (butlast l)
(reverse (cdr (reverse l))))
(let ((l '(0 1 3 6 10)))
(map - l (cons 0 (butlast l)))
If you want to wrap it up in a function, say
(define (pairwise-call f init l)
(map f l (cons init (butlast l))))
This is of course not the Little Schemer Way, but the way that avoids writing recursion yourself. Choose the way you like the best.
I haven't done scheme in dog's years, but this strikes me as a typical little lisper type problem.
I started with a base definition (please ignore misplacement of parens - I don't have a Scheme interpreter handy:
(define pairwise-diff
(lambda (list)
(cond
((null? list) '())
((atom? list) list)
(t (pairwise-helper 0 list)))))
This handles the crap cases of null and atom and then delegates the meat case to a helper:
(define pairwise-helper
(lambda (n list)
(cond
((null? list) '())
(t
(let ([one (car list)])
(cons (- one n) (pairwise-helper one (cdr list))))
))))
You could rewrite this using "if", but I'm hardwired to use cond.
There are two cases here: null list - which is easy and everything else.
For everything else, I grab the head of the list and cons this diff onto the recursive case. I don't think it gets much simpler.
After refining and adapting to PLT Scheme plinth's code, I think nearly-perfect solution would be:
(define (pairwise-apply f l0 l)
(if (empty? l)
'()
(let ([l1 (first l)])
(cons (f l1 l0) (pairwise-apply f l1 (rest l))))))
Haskell tells me to use zip ;)
(define (zip-with f xs ys)
(cond ((or (null? xs) (null? ys)) null)
(else (cons (f (car xs) (car ys))
(zip-with f (cdr xs) (cdr ys))))))
(define (pairwise-diff lst) (zip-with - (cdr lst) lst))
(pairwise-diff (list 1 3 6 10 0))
; gives (2 3 4 -10)
Doesn't map finish as soon as the shortest argument list is exhausted, anyway?
(define (pairwise-call fun init-element lst)
(map fun lst (cons init-element lst)))
edit: jleedev informs me that this is not the case in at least one Scheme implementation. This is a bit annoying, since there is no O(1) operation to chop off the end of a list.
Perhaps we can use reduce:
(define (pairwise-call fun init-element lst)
(reverse (cdr (reduce (lambda (a b)
(append (list b (- b (car a))) (cdr a)))
(cons (list init-element) lst)))))
(Disclaimer: quick hack, untested)
This is the simplest way:
(define (solution ls)
(let loop ((ls (cons 0 ls)))
(let ((x (cadr ls)) (x_1 (car ls)))
(if (null? (cddr ls)) (list (- x x_1))
(cons (- x x_1) (loop (cdr ls)))))))
(display (equal? (solution '(1)) '(1))) (newline)
(display (equal? (solution '(1 5)) '(1 4))) (newline)
(display (equal? (solution '(1 3 6 10 0)) '(1 2 3 4 -10))) (newline)
Write out the code expansion for each of the example to see how it works.
If you are interested in getting started with FP, be sure to check out How To Design Program. Sure it is written for people brand new to programming, but it has tons of good FP idioms within.
(define (f l res cur)
(if (null? l)
res
(let ((next (car l)))
(f (cdr l) (cons (- next cur) res) next))))
(define (do-work l)
(reverse (f l '() 0)))
(do-work '(1 3 6 10 0))
==> (1 2 3 4 -10)

Resources