Option type encoding / robustness in Lisp - functional-programming

(define (nth n lst)
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) )))
is an unsafe partial function, n may go out of range. An error can be helpful,
(define (nth n lst)
(if (null? lst)
(error "`nth` out of range")
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))
But what would a robust Scheme analogue to Haskell's Maybe data type look like?
data Maybe a = Nothing | Just a
nth :: Int -> [a] -> Maybe a
nth _ [] = Nothing
nth 1 (x : _) = Just x
nth n (_ : xs) = nth (n - 1) xs
Is just returning '() adequate?
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))

It's easy to break your attempt. Just create a list that contains an empty list:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> ()
(nth 100 lst)
-> ()
The key point that you're missing is that Haskell's Maybe doesn't simply return a bare value when it exists, it wraps that value. As you said, Haskell defines Maybe like so:
data Maybe a = Nothing | Just a
NOT like this:
data Maybe a = Nothing | a
The latter is the equivalent of what you're doing.
To get most of the way to a proper Maybe, you can return an empty list if the element does not exist, as you were, but also wrap the return value in another list if the element does exist:
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(list (car lst)) ; This is the element, wrap it before returning.
(nth (- n 1)
(cdr lst) ))))
This way, your result will be either an empty list, meaning the element did not exist, or a list with only one element: the element you asked for. Reusing that same list from above, we can distinguish between the empty list and a non-existant element:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> (())
(nth 100 lst)
-> ()

Another way to signal, that no matching element was found, would be to use multiple return values:
(define (nth n ls)
(cond
((null? ls) (values #f #f))
((= n 1) (values (car ls) #t))
(else (nth (- n 1) ls))))
This comes at the expense of being a little bit cumbersome for the users of this function, since they now have to do a
(call-with-values (lambda () (nth some-n some-list))
(lambda (element found?)
... whatever ...))
but that can be alleviated by using some careful macrology. R7RS specifies the let-values syntax.
(let-values (((element found?) (nth some-n some-list)))
... whatever ...)

There are several ways to do this.
The direct equivalent would be to mimic the Miranda version:
#!r6rs
(library (sylwester maybe)
(export maybe nothing maybe? nothing?)
(import (rnrs base))
;; private tag
(define tag-maybe (list 'maybe))
;; exported tag and features
(define nothing (list 'nothing))
(define (maybe? v)
(and (pair? v)
(eq? tag-maybe (car v))))
(define (nothing? v)
(and (maybe? v)
(eq? nothing (cdr v))))
(define (maybe v)
(cons tag-maybe v)))
How to use it:
#!r6rs
(import (rnrs) (sylwester maybe))
(define (nth n lst)
(cond ((null? lst) (maybe nothing))
((zero? n) (maybe (car lst)))
(else (nth (- n 1) (cdr lst)))))
(nothing? (nth 2 '()))
; ==> #t
Exceptions
(define (nth n lst)
(cond ((null? lst) (raise 'nth-nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(guard (ex
((eq? ex 'nth-nothing)
"nothing-value"))
(nth 1 '())) ; ==> "nothing-value"
Default value:
(define (nth n lst nothing)
(cond ((null? lst) nothing)
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() '())
; ==> '()
Deault value derived from procedure
(define (nth index lst pnothing)
(cond ((null? lst) (pnothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda _ "list too short"))
; ==> "list too short"
Combination of exception and default procedure
Racket, a Scheme decent, often has a default value option that defaults to an exception or a procedure thunk. It's possible to mimic that behavior:
(define (handle signal rest)
(if (and (not (null? rest))
(procedure? (car rest)))
((car rest))
(raise signal)))
(define (nth n lst . nothing)
(cond ((null? lst) (handle 'nth-nothing nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda () 5)) ; ==> 5
(nth 1 '()) ; exception signalled

As a non-lisper I really can't say how idiomatic this is, but you could return the Church encoding of an option type:
(define (nth n ls)
(cond
((null? ls) (lambda (default f) default))
((= n 1) (lambda (default f) (f (car ls))))
(else (nth (- n 1) ls))))
But that's about as complicated to use as #Dirk's proposal. I'd personally prefer to just add a default argument to nth itself.

Related

Implementing last-non-zero without continuations

last-non-zero takes a list of numbers and return the last cdr whose car is 0.
So, I can implement it using continuations, but how do I do this with natural recursion.
(define last-non-zero
(lambda (ls)
(let/cc return
(letrec
((lnz
(lambda (ls)
(cond
((null? ls) '())
((zero? (car ls)) ;; jump out when we get to last 0.
(return (lnz (cdr ls))))
(else
(cons (car ls) (lnz (cdr ls))))))))
(lnz ls)))))
Here's an obvious version which is not tail-recursive:
(define (last-non-zero l)
;; Return the last cdr of l which does not contain zero
;; or #f if there is none
(cond
((null? l)
#f)
((zero? (car l))
(let ((lnzc (last-non-zero (cdr l))))
;; This is (or lnzc (cdr l)) but that makes me feel bad
(if lnzc
lnzc
(cdr l))))
(else
(last-non-zero (cdr l)))))
Here is that version turned into a tail-recursive equivalent with also the zero test moved around a bit.
(define (last-non-zero l)
(let lnzl ([lt l]
[r #f])
(if (null? lt)
r
(lnzl (cdr lt) (if (zero? (car lt)) (cdr lt) r)))))
It's much clearer in this last version that the list is traversed exactly once.
Please indicate if I have correctly understood the problem:
#lang scheme
; returns cdr after last zero in lst
(define (last-non-zero lst)
; a helper function with 'saved' holding progress
(define (lnz-iter lst saved)
(if (null? lst)
saved
(if (zero? (car lst))
(lnz-iter (cdr lst) (cdr lst))
(lnz-iter (cdr lst) saved))))
(lnz-iter lst '()))
(last-non-zero '(1 2 3 0 7 9)) ; result (7 9)
Racket's takef-right can do it:
> (takef-right '(1 2 0 3 4 0 5 6 7) (lambda (n) (not (zero? n))))
'(5 6 7)
But assuming you have an assignment where you're supposed to write the logic yourself instead of just using a built in function, one easy if not very efficient approach is to reverse the list, build a new list out of everything up to the first zero, and return that. Something like:
(define (last-non-zero ls)
(let loop ([res '()]
[ls (reverse ls)])
(if (or (null? ls) (zero? (car ls)))
res
(loop (cons (car ls) res) (cdr ls)))))
Using your implementation where you return the argument in the event there are no zero you can just have a variable to keep the value you think has no zero values until you hit it and then update both:
(define (last-non-zero lst)
(let loop ((lst lst) (result lst))
(cond ((null? lst) result)
((zero? (car lst)) (loop (cdr lst) (cdr lst)))
(else (loop (cdr lst) result)))))
(last-non-zero '()) ; ==> ()
(last-non-zero '(2 3)) ; ==> (2 3)
(last-non-zero '(2 3 0)) ; ==> ()
(last-non-zero '(2 3 0 1 2)) ; ==> (1 2)
(define last-non-zero
(lambda (l)
((lambda (s) (s s l (lambda (x) x)))
(lambda (s l* ret)
(if (null? l*)
(ret '())
(let ((a (car l*))
(r (cdr l*)))
(if (zero? a)
(s s r (lambda (x) x))
(s s r
(lambda (r)
(ret (cons a r)))))))))))
Also possible, to use foldr:
(define (last-non-zero l)
(reverse (foldl (lambda (e res) (if (zero? e) '() (cons e res))) 0 l)))
Or use recursion:
(define (last-non-zero l (res '()))
(cond ((empty? l) res)
((zero? (car l)) (last-non-zero (cdr l) (cdr l)))
(else (last-non-zero (cdr l) res))))

Scheme: Implementing a Quick-Sort

I'm trying to implement a quick sort using scheme, some dudes here already helped me fixing my split function and now I'm asking for you help with combining everything into one working algorithm.
Here is my code so far:
(define quick-sort (lambda (lst)
(define pivot (lambda (lst)
(if (null? lst)
null
(car lst))))
(define split (lambda (lst pivot)
(define lst1 null)
(define lst2 null)
(define split-helper (lambda (lst pivot lst1 lst2)
(if (null? lst)
(list lst1 lst2)
(if (<= (car lst) pivot)
(split-helper (cdr lst) pivot (cons (car lst) lst1) lst2)
(split-helper (cdr lst) pivot lst1 (cons (car lst) lst2))))))
(split-helper lst pivot lst1 lst2)))
(if (null? lst)
null
(append (quick-sort (car (split lst (pivot lst)))) (quick-sort (cdr (split lst (pivot lst))))))))
As you can see, I'm choosing the pivot to simply be the first element in the list, the problem I'm facing is that the program ran into an infinite loop when the pivot is the smallest element in the list because it makes the program choose the same pivot over and over.
Also, the way it's currently implemented makes it be really un-efficient because the split function is called twice with the same lst in every ineration of quick-sort but I just don't have good enough control over Scheme to write it any other way.
I saw some posts about Quick-Sort in Scheme but they were implemented a bit different and I rather try and correct my own implementation than copying some other dude's work.
Thank you.
This is a classical mistake when it comes to quicksort. Your pivot should not be a part of the partitions. That way a one element list makes two empty partitions, one before and one after the pivot.
As for doing the same operation twice. Use let to buffer the split result and use the variable twice.
Removed excessive lambdas, aliases, bindings, and reformatted, but didn't change or annotate semantics (Sylwester already pointed out the bug):
(define (quick-sort lst)
(define (pivot lst)
(if (null? lst)
'()
(car lst) ))
(define (split lst pivot)
(let split-helper ((lst lst) ; Named let instead of internal
(lst1 '()) ; definition
(lst2 '()) )
(if (null? lst)
(cons lst1 list2)
(if (<= (car lst) pivot)
(split-helper (cdr lst)
(cons (car lst) lst1)
lst2)
(split-helper (cdr lst)
lst1
(cons (car lst) lst2) )))))
(if (null? lst)
'()
(let ((spl (split lst (pivot lst)))) ; Memoization of the `split`
(append (quick-sort (car spl))
(quick-sort (cdr spl)) ))))
I think you're trying to implement a partition:
(define (partition pred xs)
(let part ((ps '()) (ns '()) ; Initial "positives" `ps`, and "negatives" `ns`
(xs' xs) )
(if (null? xs')
(cons ps ns) ; Returning pair of lists
(let ((x (car xs'))) ; Memoization of `(car lst)`
(if (pred x)
(part (cons x ps) ns (cdr xs'))
(part ps (cons x ns) (cdr xs')) )))))
(define (quicksort xs)
(if (null? xs) '()
(let* ((x (car xs))
(pn (partition ; Memoization of `partition`
(lambda (x')
(< x' x) )
(cdr xs) )))
(append (quicksort (car pn)) ; Extracting positives from pair
(list x) ; Pivot
(quicksort (cdr pn)) )))) ; Negatives
(display
(quicksort (list 4 2 3 5 1)) ) ; (1 2 3 4 5)
part is inefficient in strict languages like Scheme; it copies all three of its arguments for every recursive step. Often, straightforward formulations in terms of basic folds like filter and map are most efficient. A much more efficient implementation using filter:
(define (quicksort xs)
(if (null? xs) '()
(let ((x (car xs))
(xs' (cdr xs)) )
(append (quicksort
(filter (lambda (x')
(< x' x) )
xs'))
(list x)
(quicksort
(filter (lambda (x')
(>= x' x) )
xs'))))))
This strategy famously happens to be very briefly expressible in functional languages.
In lazy Haskell, a single-traversal partition is actually more efficient than filtering twice.
select :: (a -> Bool) -> ([a], [a]) -> a -> ([a], [a])
select pred (ps, ns) x | pred x = (x : ps, ns)
| otherwise = (ps, x : ns)
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition pred = foldl (select pred) ([], [])
quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (x : xs) = let (lt, gt) = partition (< x) xs
in quicksort lt ++ [x] ++ quicksort gt

Leave only the elements that are not repeated in a given list IN SCHEME [duplicate]

I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)

reversing a list in racket using recursion-Racket [duplicate]

I'm trying to reverse a list, here's my code:
(define (reverse list)
(if (null? list)
list
(list (reverse (cdr list)) (car list))))
so if i enter (reverse '(1 2 3 4)), I want it to come out as (4 3 2 1), but right now it's not giving me that. What am I doing wrong and how can I fix it?
The natural way to recur over a list is not the best way to solve this problem. Using append, as suggested in the accepted answer pointed by #lancery, is not a good idea either - and anyway if you're learning your way in Scheme it's best if you try to implement the solution yourself, I'll show you what to do, but first a tip - don't use list as a parameter name, that's a built-in procedure and you'd be overwriting it. Use other name, say, lst.
It's simpler to reverse a list by means of a helper procedure that accumulates the result of consing each element at the head of the result, this will have the effect of reversing the list - incidentally, the helper procedure is tail-recursive. Here's the general idea, fill-in the blanks:
(define (reverse lst)
(<???> lst '())) ; call the helper procedure
(define (reverse-aux lst acc)
(if <???> ; if the list is empty
<???> ; return the accumulator
(reverse-aux <???> ; advance the recursion over the list
(cons <???> <???>)))) ; cons current element with accumulator
Of course, in real-life you wouldn't implement reverse from scratch, there's a built-in procedure for that.
Here is a recursive procedure that describes an iterative process (tail recursive) of reversing a list in Scheme
(define (reverse lst)
(define (go lst tail)
(if (null? lst) tail
(go (cdr lst) (cons (car lst) tail))))
(go lst ())))
Using substitution model for (reverse (list 1 2 3 4))
;; (reverse (list 1 2 3 4))
;; (go (list 1 2 3 4) ())
;; (go (list 2 3 4) (list 1))
;; (go (list 3 4) (list 2 1))
;; (go (list 4) (list 3 2 1))
;; (go () (list 4 3 2 1))
;; (list 4 3 2 1)
Here is a recursive procedure that describes a recursive process (not tail recursive) of reversing a list in Scheme
(define (reverse2 lst)
(if (null? lst) ()
(append (reverse2 (cdr lst)) (list (car lst)))))
(define (append l1 l2)
(if (null? l1) l2
(cons (car l1) (append (cdr l1) l2))))
Using substitution model for (reverse2 (list 1 2 3 4))
;; (reverse2 (list 1 2 3 4))
;; (append (reverse2 (list 2 3 4)) (list 1))
;; (append (append (reverse2 (list 3 4)) (list 2)) (list 1))
;; (append (append (append (reverse2 (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append (reverse2 ()) (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append () (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (list 4) (list 3)) (list 2)) (list 1))
;; (append (append (list 4 3) (list 2)) (list 1))
;; (append (list 4 3 2) (list 1))
;; (list 4 3 2 1)
Tail recursive approach using a named let:
(define (reverse lst)
(let loop ([lst lst] [lst-reversed '()])
(if (empty? lst)
lst-reversed
(loop (rest lst) (cons (first lst) lst-reversed)))))
This is basically the same approach as having a helper function with an accumulator argument as in Oscar's answer, where the loop binding after let makes the let into an inner function you can call.
Here's a solution using build-list procedure:
(define reverse
(lambda (l)
(let ((len (length l)))
(build-list len
(lambda (i)
(list-ref l (- len i 1)))))))
This one works but it is not a tail recursive procedure:
(define (rev lst)
(if (null? lst)
'()
(append (rev (cdr lst)) (car lst))))
Tail recursive solution:
(define (reverse oldlist)
(define (t-reverse oldlist newlist)
(if (null? oldlist)
newlist
(t-reverse (cdr oldlist) (cons (car oldlist) newest))))
(t-reverse oldlist '()))
Just left fold the list using cons:
(define (reverse list) (foldl cons null list))
This is also efficient because foldl is tail recursive and there is no need for append. This can also be done point-free (using curry from racket):
(define reverse (curry foldl cons null))
(define reverse?
(lambda (l)
(define reverse-aux?
(lambda (l col)
(cond
((null? l) (col ))
(else
(reverse-aux? (cdr l)
(lambda ()
(cons (car l) (col))))))))
(reverse-aux? l (lambda () (quote ())))))
(reverse? '(1 2 3 4) )
One more answer similar to Oscar's. I have just started learning scheme, so excuse me in case you find issues :).
There's actually no need for appending or filling the body with a bunch of lambdas.
(define (reverse items)
(if (null? items)
'()
(cons (reverse (cdr items)) (car items))))
I think it would be better to use append instead of cons
(define (myrev l)
(if (null? l)
'()
(append (myrev (cdr l)) (list (car l)))
)
)
this another version with tail recursion
(define (myrev2 l)
(define (loop l acc)
(if (null? l)
acc
(loop (cdr l) (append (list (car l)) acc ))
)
)
(loop l '())
)

Scheme reverse a list

I am trying to reverse a list in Scheme using DrRacket.
Code:
(define rev
(lambda(l)
(if (null? l)
'()
(append (rev (cdr l)) (list (car l))))))
If I input (rev '(a((b)(c d)(((e)))))), the output is (((b) (c d) (((e)))) a).
I want it to be (((((e)))(d c)(b))a). I looked here: How to Reverse a List? but I get an even worse output. What am I doing wrong? Any help would be appreciated!
This is trickier than it looks, you're trying to do a "deep reverse" on a list of lists, not only the elements are reversed, but also the structure … here, try this:
(define (rev l)
(let loop ((lst l)
(acc '()))
(cond ((null? lst) acc)
((not (pair? lst)) lst)
(else (loop (cdr lst)
(cons (rev (car lst))
acc))))))
It works as expected:
(rev '(a ((b) (c d) (((e))))))
=> '(((((e))) (d c) (b)) a)
This code will do it:
(define (rev-list lst)
(if (null? lst)
null
(if (list? lst)
(append (rev-list (cdr lst)
(list (rev-list (car lst))))
lst)))
And the result is:
>>> (display (rev-list '((1 7) 5 (2 4 (5 9))) ))
(((9 5) 4 2) 5 (7 1))
The idea is simple: Return the arg if it's not a list, return rev-list(arg) otherwise.

Resources