How to Write a Reverse Function in Scheme? - scheme

I have to write a scheme function which does the following:
Define a SCHEME function, named (rev p), which takes a pair as an argument and evaluates to
another pair with the first and second elements in the pair p in reverse order. For instance,
( rev ( cons 1 2))
> (2 . 1)
Here is my code:
(define (rev p)
(cond ((null? p) '())
(not (pair? (car p)) p)
(else (append (rev (cdr p)) (list (rev (car p))))
However, my code returns (1 . 2) when I test it when it should be returning (2 . 1).

(define rev
(lambda (l acc)
(if (null? l)
acc
(rev (cdr l)(cons (car l) acc)))))
(rev '(1 2 3) '())
And here is an apparently obfuscate version, but the ideas may be useful.
(define rev
(lambda (l k)
(if (null? l)
(k (lambda (x) x))
(rev (cdr l)
(lambda (k0)
(k (lambda (r) (k0 (cons (car l) r)))))))))
((rev '(1 2 3) (lambda (x) x)) '())
--
As suggested by Will, here is other variant, non-tail recursive, hence not completely cps'd, it's a combination of classic recursion and cps.
(define rev
(lambda (l k)
(if (null? l)
(k '())
(rev (cdr l)
(lambda (r)
(cons (car l)
(k r)))))))

If it's just a pair that you want to reverse, it's pretty simple, you don't even need to do recursion! And remember to use cons, not append:
(define (rev p)
(cond ((not (pair? p)) p)
(else (cons (cdr p) (car p)))))
For example:
(rev '())
=> '()
(rev 5)
=> 5
(rev (cons 1 2))
=> '(2 . 1)

Or the same expressed as:
(define (rev p)
(if (pair? p)
(cons (cdr p) (car p))
p))

All you need to do for this function is use the car and cdr function for your pair p.
(define (rev p)
(cons (cdr p) (car p))
)

Related

Looking for cleaner way to make association list out of list of numbers

I'm looking to write a procedure that will take a list in the form '(0 7 10 14) and transform it into a list '((0 . 7) (7 . 10) (10 . 14)). The procedure below will do exactly that. I think it's rather messy and can't find a simpler way to write it. Maybe I can use a built-in racket function to do this?
(define (simplify-path path)
(if (null? (cddr path))
(cons (cons (car path) (cadr path)) '())
(begin (cons (cons (car path) (cadr path))
(simplify-path (cdr path))))))
Using Racket, we can do this:
(define (simplify-path path)
(map cons
(drop-right path 1)
(rest path)))
It works as expected:
(simplify-path '(0 7 10 14))
=> '((0 . 7) (7 . 10) (10 . 14))
(define (simplify-path path)
(for/list ([x path] [y (cdr path)]) (cons x y)))
Does it too.
In contrast to map, for/list can take two different length lists - cuts down to length of shortest.
written in mit-scheme.
(define list->assocs
(lambda (l)
(define pair-first-second
(lambda (l)
(cons (car l) (cadr l))))
(define iter
(lambda (l k)
(if (eq? '() (cddr l))
(k (pair-first-second l))
(iter (cdr l)
(lambda (r)
(k (cons (pair-first-second l) r)))))))
(if (or (eq? '() l)
(eq? '() (cdr l)))
l
(iter l
(lambda (x) x)))))
(list->assocs '(0 7 10 14))

Scheme function that returns a function

I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2

Encapsulating Certain Parts of List

I'm trying to write a procedure that "encapsulates" (i.e. puts in a list) elements of a list between a "separator" element.
(my-proc '(1 + 2))
=> ((1) (2))
(my-proc '(x * y + z ^ 2 + 1 + 5))
=> ((x * y) (z ^ 2) (1) (5))
(my-proc '((x + 1) * y + 5))
=> (((x + 1) * y) (5))
In this case the procedure can be hard-coded to define the + symbol as the separator.
Assume that foldr (fold right operation) is defined, I'd prefer that it'd be in terms of it.
I'm not giving a full solution since this looks really homework-y.
(define (split-expr expr)
(foldr (lambda (e es)
(if (eq? e '+)
<???> ; do split
(cons (cons e (car es))
(cdr es))))
<???> ; what should start be?
es))
Just for fun, here's a version in continuation-passing style (no foldr, probably not suitable as a homework answer):
(define split/cps
(λ (sep ls)
(let loop ([ls ls] [k (λ (item acc)
(if item (cons item acc) acc))])
(cond
[(null? ls)
(k #f '())]
[(eq? sep (car ls))
(loop (cdr ls)
(λ (item acc)
(k #f (if item (cons item acc) acc))))]
[else
(loop (cdr ls)
(λ (item acc)
(k (if item
(cons (car ls) item)
(list (car ls)))
acc)))]))))
Here's another way to do it, also without foldr:
(define split/values
(λ (sep ls)
(let loop ([ls ls])
(cond
[(null? ls)
'()]
[else
(let-values ([(a d) (car-to-sep sep ls)])
(if (null? a)
(loop d)
(cons a (loop d))))]))))
(define car-to-sep
(λ (sep ls)
(let loop ([ls ls] [a '()])
(cond
[(null? ls)
(values '() '())]
[(eq? sep (car ls))
(values '() (cdr ls))]
[else
(let-values ([(a d) (loop (cdr ls) a)])
(values (cons (car ls) a) d))]))))

Deep-reverse for trees in Scheme (Lisp)

I have a deep reverse for a basic tree data structure in Scheme
(define (deep-reverse t)
(cond ((null? t) '())
((not (pair? t)) t)
(else (cons (deep-reverse (cdr t)) (deep-reverse (car t))))))
(define stree (cons (list 1 2) (list 3 4)))
1 ]=> (deep-reverse stree)
;Value: (((() . 4) . 3) (() . 2) . 1)
I feel like a cleaner, better result would be:
(4 3 (2 1))
Can anyone provide some guidance as to where I'm going wrong in my deep-reverse function? Thank you.
It's better to split the task into simple operations instead of trying to do all at once. What you want to achieve can be described like this: Reverse the current list itself, then deep-reverse all sublists in it (or the other way round, the order of the two steps doesn't really matter. I choose this order because it results in nicer formatting of the source code).
Now, there already is a function in the standard library for simply reversing a list, reverse. So all you need to do is to combine that with the recursion on those elements that are sublists:
(define (deep-reverse t)
(map (lambda (x)
(if (list? x)
(deep-reverse x)
x))
(reverse t)))
Try this:
(define (deep-reverse t)
(let loop ((t t)
(acc '()))
(cond ((null? t) acc)
((not (pair? t)) t)
(else (loop (cdr t)
(cons (loop (car t) '()) acc))))))
Call it like this:
(define stree (cons (list 1 2) (list 3 4)))
(deep-reverse stree)
> (4 3 (2 1))
For creating a reversed list, one technique is to accumulate the answer in a parameter (I usually call it acc). Since we're operating on a list of lists, the recursion has to be called on both the car and the cdr part of the list. Lastly, I'm using a named let as a shorthand for avoiding the creation of an extra function, but the same result could be obtained by defining a helper function with two parameters, the tree and the accumulator:
(define (deep-reverse t)
(aux t '()))
(define (aux t acc)
(cond ((null? t) acc)
((not (pair? t)) t)
(else (aux (cdr t)
(cons (aux (car t) '()) acc)))))
I think it better to reverse a list based on its element count:
an empty list is reverse, a single element list is also reverted, more than 1 element is concatenation of the reverse of tail and head.
(defun deep-reverse (tree)
(cond ((zerop (length tree)) nil)
((and (= 1 (length tree)) (atom (car tree))) tree)
((consp (car tree)) (append (deep-reverse (cdr tree))
(list (deep-reverse (car tree)))))
(t (append (deep-reverse (cdr tree)) (list (car tree))))))
The following worked for me:
(define (deep-reverse tree)
(define (deep-reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (deep-reverse-iter
(cdr items)
(cons (deep-reverse (car items)) acc)))))
(deep-reverse-iter tree ()))
(define x (list (list 1 2) (list 3 4 (list 5 6))))
(newline)
(display (deep-reverse x))
It prints (((6 5) 4 3) (2 1)) as expected and uses the minimum of standard library functions: pair? to check if the tree is a cons and null? to check for an empty tree/list.
This solution for trees is a generalization of the reverse function for lists:
(define (reverse items)
(define (reverse-iter items acc)
(cond
((null? items) acc)
((not (pair? items)) items)
(else (reverse-iter (cdr items) (cons (car items) acc)))))
(reverse-iter items ()))
the difference being that deep-reverse is also applied to car items

string to decimal number in scheme

What is the most transparent and elegant string to decimal number procedure you can create in Scheme?
It should produce correct results with "+42", "-6", "-.28", and "496.8128", among others.
This is inspired by the previously posted list to integer problem: how to convert a list to num in scheme?
I scragged my first attempt since it went ugly fast and realized others might like to play with it as well.
Much shorter, also makes the result inexact with a decimal point, and deal with any +- prefix. The regexp thing is only used to assume a valid syntax later on.
#lang racket/base
(require racket/match)
(define (str->num s)
;; makes it possible to assume a correct format later
(unless (regexp-match? #rx"^[+-]*[0-9]*([.][0-9]*)?$" s)
(error 'str->num "bad input ~e" s))
(define (num l a)
(match l
['() a]
[(cons #\. l) (+ a (/ (num l 0.0) (expt 10 (length l))))]
[(cons c l) (num l (+ (* 10 a) (- (char->integer c) 48)))]))
(define (sign l)
(match l
[(cons #\- l) (- (sign l))]
[(cons #\+ l) (sign l)]
[_ (num l 0)]))
(sign (string->list s)))
Here is a first shot. Not ugly, not beautiful, just longer than I'd like. Tuning another day. I will gladly pass the solution to someone's better creation.
((define (string->number S)
(define (split L c)
(let f ((left '()) (right L))
(cond ((or (not (list? L)) (empty? right)) (values L #f))
((eq? c (car right)) (values (reverse left) (cdr right)))
(else (f (cons (car right) left) (cdr right))))))
(define (mkint L)
(let f ((sum 0) (L (map (lambda (c) (- (char->integer c) (char->integer #\0))) L)))
(if (empty? L) sum (f (+ (car L) (* 10 sum)) (cdr L)))))
(define list->num
(case-lambda
((L) (cond ((empty? L) 0)
((eq? (car L) #\+) (list->num 1 (cdr L)))
((eq? (car L) #\-) (list->num -1 (cdr L)))
(else (list->num 1 L))))
((S L) (let*-values (((num E) (split L #\E)) ((W F) (split num #\.)))
(cond (E (* (list->num S num) (expt 10 (list->num E))))
(F (* S (+ (mkint W) (/ (mkint F) (expt 10 (length F))))))
(else (* S (mkint W))))))))
(list->num (string->list S)))

Resources