How to make a copy of a procedure in Scheme? - list

So, from the SICP we know that the cons car and cdr can be defined as a procedure:
(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))
(define (cdr z)
(z (lambda (p q) q)))
But the pre-defined procedure list, which takes the arguments to build a list, uses the original cons. That means, a list that list built, isn't a procedure as I want.
(car (list 1 2 3))
;The Object (1 2 3) is not applicable
So i write this:
(define (list . l)
(if (null? l)
'()
(cons (original-car l)
(list (original-cdr l)))))
I just wondering how to define the original-car and original-cdr. Are there some way to make a copy of a procedure in Scheme? Or there's some alternate way to solve this problem. thx

If you need to save a reference to the "original" procedures before redefining them, simply create an alias before defining the "new" procedures (I guess that's what you mean by "copying" them). Like this:
(define original-cons cons)
(define original-car car)
(define original-cdr cdr)
(define original-list list)
In this way, the old procedures can still be used, as long as we refer to them by their new names. In other words, the implementation of cons, car, cdr and list as procedures will look like this:
(define (my-cons x y)
(lambda (m) (m x y)))
(define (my-car z)
(z (lambda (p q) p)))
(define (my-cdr z)
(z (lambda (p q) q)))
(define (my-list . els)
(if (null? els)
'()
(my-cons
(original-car els)
(apply my-list (original-cdr els)))))
And sure enough, it works:
(define lst (my-list 1 2 3 4))
lst
=> #<procedure>
(my-car lst)
=> 1
(my-car (my-cdr lst))
=> 2

List in an implementation is defined as
(define (list . l) l)
However, this is using a lot of the underlying implementation. E.g. to work it uses the native cons. cons as defined in SICP is a thought experiment so you're implementation needs a little correction:
(define (my-cons x y)
(lambda (m) (m x y)))
(define (my-car z)
(z (lambda (p q) p)))
(define (my-cdr z)
(z (lambda (p q) q)))
(define (my-list . l)
(define (my-list-aux l)
(if (null? l)
'()
(my-cons (car l)
(my-list-aux (cdr l)))))
(my-list-aux l))
;; optional, update binding
(define car my-car)
(define cdr my-cdr)
(define list my-list)
my-cons my-car, my-cdr and my-list are as defined in your question. Only change is reference to correct procedure (with name not conflicting with Scheme)

Related

Return a list without the last element

I've just started to learn Racket.
I have this code:
#lang racket
(define l1 '(1 2 3 4))
(car l1)
(cdr l1)
(car l1) returns 1.
(cdr l1) returns '(2 3 4)
Is there a function that returns '(1 2 3)?
I've tried this:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l '()))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 ())
And I have also tried:
#lang racket
(define l1 '(1 2 3 4))
(map
(lambda (l i)
(cond ((not (= i (sub1 (length l1)))) l )))
l1 (range 0 (length l1)))
But, it returns: '(1 2 3 #<void>)
The map function always returns a list the same length as its input. You want an output list that is shorter than its input. The function you are looking for is traditionally called but-last:
(define (but-last xs) (reverse (cdr (reverse xs))))
What about something like this ?
(define (myCdr l)
(if (not (pair? (cdr l)))
'()
(cons (car l) (myCdr (cdr l)))
)
)
length is generally an anti-pattern in Scheme because the entire list needs to be read in order to get the result. W. Ness remarks that map does not alter the structure of the list, and the behavior of filter is based on the list's values, neither of which suit your needs.
Instead of making potentially expensive computations first or awkwardly applying the library functions, you can compute the init of a list using direct recursion -
(define (init l)
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
null)
(else
(cons (car l)
(init (cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Or a tail-recursive form that only uses one reverse -
(define (init l)
(let loop ((acc null)
(l l))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(reverse acc))
(else
(loop (cons (car l) acc)
(cdr l))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
And lastly a tail-recursive form that does not use length or reverse. For more intuition on how this works, see "How do collector functions work in Scheme?" -
(define (init l (return identity))
(cond ((null? l)
(error 'init "cannot get init of empty list"))
((null? (cdr l))
(return null))
(else
(init (cdr l)
(lambda (r)
(return (cons (car l) r)))))))
(init '(a b c d e)) ;; '(a b c d)
(init '(a)) ;; '(a)
(init '()) ;; init: cannot get init of empty list
Here's one more, via zipping:
#lang racket
(require srfi/1)
(define (but-last-zip xs)
(if (null xs)
xs ; or error, you choose
(map (lambda (x y) x)
xs
(cdr xs))))
Here's another, emulating filtering via lists with appending, where empty lists disappear by themselves:
(define (but-last-app xs)
(if (null? xs)
xs
(let ((n (length xs)))
(apply append ; the magic
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n))))))
Or we could use the decorate--filter--undecorate directly, it's even more code!
(define (but-last-fil xs)
(if (null? xs)
xs
(let ((n (length xs)))
(map car
(filter (lambda (x) (not (null? x)))
(map (lambda (x i)
(if (= i (- n 1)) '() (list x)))
xs
(range n)))))))
Here's yet another alternative, assuming that the list is non-empty. It's efficient (it performs a single pass over the list), and it doesn't get any simpler than this!
(define (delete-last lst)
(drop-right lst 1))
(delete-last '(1 2 3 4))
=> '(1 2 3)
Here is an equivalent of Will Ness's beautiful but-last-zip which does not rely on srfi/1 in Racket: without srfi/1 Racket's map insists that all its arguments are the same length (as does the R5RS version in fact) but it is common in other Lisps to have the function terminate at the end of the shortest list.
This function uses Racket's for/list and also wires in the assumption that the result for the empty list is the empty list.
#lang racket
(define (but-last-zip xs)
(for/list ([x xs] [y (if (null? xs) xs (rest xs))])
x))
I think Will's version is purer: mapping functions over things is a very Lisp thing to do I think, while for/list feels less Lispy to me. This version's only advantage is that it does not require a module.
My own solution using recursion:
#lang racket
(define but-last
(lambda (l)
(cond ((null? (cdr l)) '())
(else (cons (car l) (but-last (cdr l)))))))
And another solution using filter-not and map:
#lang racket
(define l1 '(1 2 3 4))
(filter-not empty? (map
(lambda (l i)
(if (not (= i (sub1 (length l1)))) l empty))
l1 (range 0 (length l1))))

Reversing a list in Scheme with restrictions

I already have the code to reverse a list:
(define (myreverse lst)
(if (null? lst)
lst
(append (reverse (cdr lst))
(list (car lst)))))
But I want to do this using only lectrec, cons, car and cdr. How can I do that?
The standard way to reverse a list without append is to use the helper function REVAPPEND, like this:
(define (reverse x) (revappend x '()))
(define (revappend x y)
(if (null? x)
y
(revappend (cdr x) (cons (car x) y))))
Now if you want to implement reverse as a single function you can use LETREC to locally define the REVAPPEND helper, like this
(define (reverse x)
(let revappend ((x x) (y '()))
...))
This is just a template to get you started, feel free to ask if you need more help.

Lisp - Get rid of dotted list

I am building a function is Lisp ta reverses the first and last element of a list. I get that a list has a car and a cdr hence why there is a dot in my output. Is there a way to remove the dot?
(defun my-butlast (list)
(loop for l on list
while (cdr l)
collect (car l)))
(defun f-l-swap(list)
(append (last list)(cdr (my-butlast list))(car list))
)
(write(f-l-swap '(A B C D E)))
OUTPUT:
(E B C D . A)
append expects arguments to be lists. In your case (car list) is an atom. You have to change it to list if you want to stick with append. Ie:
(defun f-l-swap (list)
(append (last list)
(cdr (my-butlast list))
(list (car list))))
A list is a chain of cons pairs. eg. (1 2 3) is the visualization of (1 . (2 . (3 . ()))). In the event the last cdr is not () you have what we call a dotted list since then there is no simplified visualization of the last part. It has to be printed with a dot.
You have (E . (B . (C . (D . A)))) and want to have (E . (B . (C . (D . (A . ()))))). Do you see the difference? (car list) is not a list but one elment and that is why you get a dotted list.
Here are more sensible implementations of append and butlast:
(defun my-append (a b)
(if (null a)
b
(cons (car a) (my-append (cdr a) b))))
That only supports 2 arguments, but the idea for more is that it continues until you have consed all the previous lists and only have one left, which verbatim becomes the tail. Here is how that might look:
(defun my-append2 (x &rest xs)
(labels ((helper (x xs)
(cond ((null xs) x)
((null x) (helper (car xs) (cdr xs)))
(t (cons (car x) (helper (cdr x) xs))))))
(helper x xs)))
Here is butlast
(defun my-butlast (xs)
(if (null (cdr xs))
'()
(cons (car xs) (my-butlast (cdr xs)))))
Now, one should really do it with higher order functions or loop, but then you get the facts hidden how lists work. The code above shows you have they work.

Appending reversed list in Scheme

I am learning Scheme and wanted to write a recursive program that reverses a given list.
In one test case however, I noticed that a (b c) e -> e (b c) a.
What I'm trying to get is a (b c) e -> e (c b) a.
This is what I have:
(define (deep-reverse lst)
(if (null? lst)
'()
(begin
(display (car lst))
(display "\n")
(if (null? (cdr lst))
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))
) //End of inner if
))) //End of begin, outer if, define
When I attempt to run the code with
(deep-reverse '(1 (b c) (a b)))
I get:
1
(b c)
(a b)
mcdr: contract violation
expected: mpair?
given: 1
The issue is with (list (reverse (car lst))), although in an isolated test case it works fine. Which leads me to believe that the issue may have to do with append.
Thank you in advance.
Edit: Going from (list (reverse (car lst))) to (reverse (list(car lst))) makes the code run without an error but doesn't reverse (a b) to (b a).
As the error message explains, your problem is that you are trying to reverse a number. Firstly, let's remove some of the unnecessary conditions and debugging stuff in your program, arriving at this simpler program. Let's step through this program to see what's going on:
(define (deep-reverse lst)
(if (null? lst)
'()
(append (deep-reverse (cdr lst)) (list (reverse (car lst))))))
We start with
(deep-reverse '(1 (b c) (a b)))
Substituting the argument we get
(if (null? '(1 (b c) (a b)))
'()
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b)))))))
Because the condition is #f, this simplifies to
(append (deep-reverse (cdr '(1 (b c) (a b))))
(list (reverse (car '(1 (b c) (a b))))))
To evaluate the first argument, first find the cdr, and call deep-reverse on that. I will skip the steps here but you should easily be able to test that it works correctly.
(append '((b a) (c b)) (list (reverse (car '(1 (b c) (a b))))))
Next we evaluate the car:
(append '((b a) (c b)) (list (reverse 1)))
And here we see what the problem is: we can't reverse a single number!
The issue is that your deep-reverse should have two distinct behaviours recursively:
on a number, or symbol, or other non-list entity, don't do anything, because it does not make sense to reverse a number
on a list, deep reverse it
There are two reasons why your current program does not do this properly:
it only does a shallow reverse on the elements of the list; that is, it won't deep reverse '(((a b) (c d)) ((e f) (g h))) correctly
it fails if it ever encounters a number or other non-list, like a symbol
The easy fix is to add a condition to check if it's a pair? first before attempting to reverse it. If it's not pair?, then lst must either be nil (which we may leave as-is) or a non-list object (which we may also leave as-is)
(define (deep-reverse lst)
(if (pair? lst)
(append (deep-reverse (cdr lst)) (list (deep-reverse (car lst))))
lst))
Finally, I should note that the pattern we are using here is really a foldr pattern. We can abstract away this pattern with foldr:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldr (lambda (x y) (append y (list (deep-reverse x)))) '() xs))
(else xs)))
But we note also that this is inefficient, because append is an expensive operation. Modifying the algorithm to a tail recursive one makes it clear that this is actually a foldl:
(define (deep-reverse xs)
(cond ((pair? xs)
(foldl (lambda (x y) (cons (deep-reverse x) y)) '() xs))
(else xs)))
which is how such a function might be written in typical idiomatic Scheme, or as pointed out by Will Ness,
(define (deep-reverse xs)
(cond ((pair? xs) (reverse (map deep-reverse xs)))
(else xs)))

Finding the depth of a list using (constrained) Racket

Another question of logic, the task is to find the depth of a list, for example: given a list of (A B (C D (E))) it should somehow indicate that the depth is 2 (or 3 if you include the base list). I am restricted to a set of common Racket functions of which I will list below. Where I am at I can iterate through the list but end up halting at the first sub-list, i.e: (A (B (C)) (D (E (F)))) comes out as only 2.
Here is the list of functions available:
cons, car, cdr, define, quote, if, cond, else
Basic forms of arithmetic (+, -, *, /)
Very basic tests (null?, list?, eq?, numeric comparisons)
Here is my definition so far, I would really appreciate if someone could just shift me in the right direction.
(define (len l) (if (null? l) 0 (+ 1 (len (cdr l)))))
(define A '(A (B) (C (D))))
(define (depth l) (cond
[(null? l) '()]
[(list? (car l)) (cons (car l) (depth (car l)))]
[else (depth (cdr l))]
))
(depth A)
(len (depth A))
Here is my definition in Common Lisp
(defun list-depth (list &optional (depth 0))
(cond ((null list) depth)
((atom (first list)) (list-depth (rest list) depth))
(t (max (list-depth (first list) (1+ depth))
(list-depth (rest list) depth)))))
I don't have Racket installed on this computer, so here is an untested translation to Scheme/Racket:
(define (list-depth lst depth)
(cond ((null? lst) depth)
((not (list? (car lst)) (list-depth (cdr list) depth))
(else (max (list-depth (car lst) (+ 1 depth))
(list-depth (cdr lst) depth)))))
Logic is as follows:
If the list is empty, return current depth.
If the car of the list is atom (not list), it won't increase the depth, find the depth of the rest (cdr) of the list.
Otherwise, the depth is going to be the maximum between the +1 depth of car (remember, it is the list now) and the depth of the cdr of the list. Notice increase of the depth for car and not for cdr.
Pre-defined procedures used: +, max, null?, list?, car, cdr, not.
In my answer here, lists start with a depth of 0 and increase by 1 for each level of nesting. If you'd like for them to start with a depth of 1, you can change (y 0) to (y 1) in the list-depth procedure
This can be implemented with a straightforward fold
(define (list-depth xs (y 0))
(foldl (λ (x z)
(if (list? x)
(max z (list-depth x (+ 1 y)))
(max z y)))
y
xs))
foldl has a simple implementation of
(define (foldl f y xs)
(if (null? xs)
y
(foldl f (f (car xs) y) (cdr xs))))
Here's some outputs
(list-depth '()) ; ⇒ 0
(list-depth '(A)) ; ⇒ 0
(list-depth '(A (B))) ; ⇒ 1
(list-depth '(A (B (C)))) ; ⇒ 2
(list-depth '(A (B (C (D (E)))) (B (C)) (B))) ; ⇒ 4
If you don't want to use the fold abstraction, you can expand the fold within list-depth to
;; THIS CODE IS BROKEN, DO NOT USE
;; #mobiuseng found bugs
(define (list-depth xs (y 0))
(cond
[(null? xs) y]
[(list? (car xs))
(max y (list-depth (car xs) (+ 1 y)))]
[else
(max y (list-depth (cdr xs) y))]))
Both result in the same output, but in this implementation, the two concepts of folding and max are tangled together. Seeing the guts of the fold makes it much harder to read this answer compared to the first one.
The guts of the fold made it easy for bugs to hide in this last snippet. I can't suggest writing this way in the first place, so I'm not going to bother spending effort to fix it.
Every list is built of a current element, under its car, and the rest of the list, under the cdr.
The depth of the list is the same as depth of the rest of the list, if that's the deepest.
The depth of the list is one more than the depth of its car, if that's the deepest.
So,
(define (depth lst)
(define a-depth (+ 1 (depth (car lst))))
(define d-depth (depth (cdr lst)))
(if (< ..... ) .....
; or else
...... ))
And of course, don't forget to handle the case when the list is empty, or an atom (not a pair — you can't call car or cdr with a non-pair argument, it would cause an error if you did):
The depth of an empty list is zero.
The depth of an atom is zero.