This is an exercise from EOPL.
Procedure (invert lst) takes lst which is a list of 2-lists and returns a list with each 2-list reversed.
(define invert
(lambda (lst)
(cond((null? lst )
'())
((= 2 (rtn-len (car lst)))
( cons(swap-elem (car lst))
(invert (cdr lst))))
("List is not a 2-List"))))
;; Auxiliry Procedure swap-elements of 2 element list
(define swap-elem
(lambda (lst)
(cons (car (cdr lst))
(car lst))))
;; returns lengh of the list by calling
(define rtn-len
(lambda (lst)
(calc-len lst 0)))
;; calculate length of the list
(define calc-len
(lambda (lst n)
(if (null? lst)
n
(calc-len (cdr lst) (+ n 1)))))
This seems to work however looks very verbose. Can this be shortened or written in more elegant way ?
How I can halt the processing in any of the individual element is not a 2-list?
At the moment execution proceed to next member and replacing current member with "List is not a 2-List" if current member is not a 2-list.
The EOPL language provides the eopl:error procedure to exit early with an error message. It is introduced on page 15 of the book (3rd ed.).
The EOPL language does also include the map procedure from standard Scheme. Though it may not be used in the book, you can still use it to get a much shorter solution than one with explicit recursion. Also you can use Scheme's standard length procedure.
#lang eopl
(define invert
(lambda (lst)
(map swap-elem lst)))
;; Auxiliary Procedure swap-elements of 2 element list
(define swap-elem
(lambda (lst)
(if (= 2 (length lst))
(list (cadr lst)
(car lst))
(eopl:error 'swap-elem
"List ~s is not a 2-List~%" lst))))
So it seems that your version of invert actually returns a list of different topology. If you execute (invert ...) on '((1 2) (3 4)), you'll get back '((2 . 1) (4 . 3)), which is a list of conses, not of lists.
I wrote a version of invert that maintains list topology, but it is not tail-recursive so it will end up maintaining a call stack while it's recursing.
(define (invert lst)
(if (null? lst)
lst
(cons (list (cadar lst) (caar lst))
(invert (cdr lst)))))
If you want a version that mimics your invert behavior, replace list with cons in second to last line.
If you want it to exit early on failure, try call/cc.
(call-with-current-continuation
(lambda (exit)
(for-each (lambda (x)
(if (negative? x)
(exit x)))
'(54 0 37 -3 245 19))
#t))
===> -3
(Taken from http://www.schemers.org/Documents/Standards/R5RS/HTML/r5rs-Z-H-9.html#%_idx_566)
What call-with-current-continuation (or call/cc, for short) does is pass the point where the function was called in into the function, which provides a way to have something analogous to a return statement in C. It can also do much more, as you can store continuations, or pass more than one into a function, with a different one being called for success and for failure.
Reverse list containing any number or order of sub-lists inside.
(define (reverse! lst)
(if (null? lst) lst
(if (list? (car lst))
(append (reverse! (cdr lst)) (cons (reverse! (car lst)) '()))
(append (reverse! (cdr lst)) (list (car lst))))))
Related
So I am new to Scheme and have encountered a problem. What I am trying to do is the following. It's a rather simple problem nevertheless I am receiving several errors:
I try to sum up the elements of lists (which only consists of numbers). If the total amount is even, the procedure should return <'divisible_by_2>.
If the total amount is odd, it should return <'not_divisible_by_2>.
The initial sstep was to build a procedure that sums up the lists. This one works. The second step was to build an if function which takes the sum of lists and returns <'divisible_by_2> if the sum is even and <'not_divisible_by_2> if it is odd.
What I wrote so far:
(define (divisible_or_not list-sum lst)
(if (odd? list-sum lst)
(lambda (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst)))
(else
(+ (car lst) (list-sum (cdr lst)))
)
)
)
('divisible_by_2)
('not_divisible_by_2)
)
)
)
Version 2.0 (lst=tree; tree-count=sum-lst):
(define (divisible-or-not tree)
(define (tree-count tree)
(cond
((null? tree)
0)
((pair? (car tree))
(+(tree-count (car tree)) (tree-count (cdr tree)))
(else
(+ (car tree) (tree-count (cdr tree))))))
(if (odd? tree-count tree)
('divisible-by-2)
('not-divisible-by-2))))
Your code, properly indented, looks like so:
(define (divisible_or_not list-sum lst)
(if (odd? list-sum lst)
(lambda (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst)))
(else
(+ (car lst) (list-sum (cdr lst))))))
('divisible_by_2)
('not_divisible_by_2))))
The structure of your program looks like this:
(if ...
(lambda (...) ...))
In other words, if your test succeeds, you return an anonymous function, and if the test fails, you return nothing (in Scheme, the value is undefined in that case).
Inside your lambda, the code is a list of three expressions, a cond, the form ('divisible_by_2) and the form ('not_divisible_by_2).
First of all, do not use underscores for separating words in Lisp/Scheme, use dashes, like so: divisible-by-2.
Secondly, only the last expression's value is returned from the lambda, so the intermediate cond, since it has no side-effect, is basically doing work for nothing. The second form, ('divisible_by_2), looks like a function call but is going to give you an error. If you want to return a symbol, just quote it, without parentheses: 'divisible-by-2.
Since you already have an intermediate function, you can associate it to a name:
(define tree-count (sum tree)
(cond ...))
I named it tree-count because you also recurse into the car of your lists.
Once you have this function, you only need to apply it:
(if (even? (tree-count tree))
'divisible-by-2
'not-divisible-by-2)
Here is my big list with sublists:
(define family
(list
(list 'Daddy 't-shirt 'raincoat 'sunglasses 'pants 'coat 'sneakers)
(list 'Mamma 'high-heels 'dress 'pants 'sunglasses 'scarf)
(list 'son 'pants 'sunglasses 'sneakers 't-shirt 'jacket)
(list 'daughter 'bikini 'Leggings 'sneakers 'blouse 'top)))
And i want to compare family with this simple list:
(list 'sneakers 'dress 'pants 'sunglasses 'scarf)
each matching should give 1 point and i want that the point to be calculated separately for each sublist.
Here is the code:
;checking if an element exists in a list
(define occurs?
(lambda (element lst)
(cond
[(and (null? element) (null? lst))]
[(null? lst) #f]
[(pair? lst)
(if
(occurs? element (car lst)) #t
(occurs? element (cdr lst)))]
[else (eqv? element lst)])))
;--------------------------------------
; a list of just names are created.
(define (name-list lst)
(list (map car lst)))
; Each sublist has a name (car of the sublist). The name-list turn to point-list for each sublist. All of my code except the code below is functioning as i want. The problem lies within point-list code.
(define (point lst db)
(let ((no-point (name-list db)))
(cond ((or (null? lst) (null? db)) '())
(set! (first no-point) (comp lst (rest db)))
(else (point lst (cdr db))))))
Daddy-sublist has 3 elements in common. Mamma-sublist has 4 elements in common, son-sublist 3 elements and daugther-sublist 1 element.
I want the outdata to be like this:
> (comparison (list 'sneakers 'dress 'pants 'sunglasses 'scarf) family)
'(3 4 3 1)
My code is not functioning as I want it. I get this Eror :
set!: bad syntax in: set!
Can someone guide explain me what to do?
You have bad syntax with set!:
(set! (first no-point-lst) (comparison lst (rest db)))
This is an invalid use of set!, attempting to "mutate the structure" of the list no-point-lst, changing what's actually held in its first position.
set! can't do that. It can be used to change a binding, i.e. the value of a variable: (let ((a 1)) (set! a 2)).
In Common Lisp they can write (setf (first list) newval), but not in Scheme / Racket.
If this is essential to your algorithm, you can use set-car! in R5RS Scheme, or set-mcar! in Racket. Or you could do this with vectors.
But you could also restructure your code as
(set! no-points-list
(cons
(comparison lst (rest db))
(cdr no-points-list)))
Here is my Racket problem:
Define a function that takes a list as an argument. It should return a boolean (i.e. #t or #f) indicating whether the list is sorted in ascending order. You may not use the built-in sorted? function. Your implementation must be recursive.
Input: A list of elements of homogenous data type, either numbers or strings.
Output: A boolean value that indicates whether the elements of the list are sorted in strictly increasing order. If the list contains heterogenous data types, then throw an error (using the error function) with the message “ERROR: List contains heterogenous data types”.
So when I type this function have to gave me this ERROR
(my-sorted? '(7 "spam" 9))
! ERROR: List contains heterogenous data types
BUT for mine its gave me this
(my-sorted? '(7 "spam" 9))
: contract violation
expected: real?
given: "spam"
argument position: 2nd
other arguments...:
Here what I have
(define (my-sorted-int? lst)
(define size (length lst))
(if (< size 2)
#t
(if (null? lst)
#t
(if (> (car lst) (car (rest lst))) <======= Gave me Error
#f
(my-sorted-int? (rest lst) )))))
(define (my-sorted-string? lst)
(define size (length lst))
(if (< size 2)
#t
(if (null? lst)
#t
(if (string>? (car lst) (car (rest lst)))
#f
(my-sorted-string? (rest lst) )))))
(define (my-sorted? lst)
(if (string? (car lst))
(my-sorted-string? lst)
(my-sorted-int? lst)))
So you know the left side is a number since it was the value you initially checked, but the right side also needs to be a number to be able to do > on it. Thus you need something like:
(if (number? (cadr lst))
(if (> (car lst) (cadr lst)) ...)
(error "ERROR: List contains heterogenous data types"))
You might want to use cond to get a flatter structure. Also you have made two identical procedures to deal with integers and strings when you could just made one and pass the things that are different to make your code more DRY:
(define (my-sorted? lst)
(define (my-helper? correct-type? greater-than?)
(let loop ((e (car lst))
(lst (cdr lst)))
(cond ((null? lst) #t)
((not (correct-type? (car lst)))
(error "ERROR: List contains heterogenous data types"))
((greater-than? e (car lst)) #f)
(else (loop (car lst) (cdr lst))))))
(cond ((null? lst) #t)
((string? (car lst)) (my-helper? string? string>?))
(else (my-helper? number? >))))
I have to make a recursive function in lisp which takes a list and makes another list with only the elements on odd position in the given list.
If I have (1 2 3 4 5) I have to output (1 3 5)
I have a code here:
(defun pozpar(lst) (do(
(l lst (cddr l))
(x '() (cons x (car l))))
((null l) x)))
This outputs:
(5 3 1)
I know cons adds the elements at the beginning and I tried with append or list but nothing worked.
I think this is a way easier solution:
(defun popzar (lst)
(cond ((null lst) nil)
(t (cons (car lst)
(popzar (cdr (cdr lst)))))))
It first checks if the list is empty and if not it creates a new list with the first element and the result of calling itself again with the rest of the list except for the second element.
The easiest way is to reverse the result:
(defun pozpar (lst)
(do ((l lst (cddr l))
(x '() (cons (car l) x)))
((null l)
(nreverse x))))
(pozpar '(1 2 3 4 5))
==> (1 3 5)
Notes
This returns, not outputs the value you want.
Prepending values and reverting the result is a common Lisp coding pattern.
Since append is linear in the length of its argument, using it in a loop produces quadratic code.
I formatted the code in the standard Lisp way. If you use this style, lispers will have an easier time reading your code, and, consequently, more willing to help you.
With using loop it's very easy to get the elements in the order you processed them. It is also the most effective and the only one guaranteed to work with all length arguments:
(defun pozpar1 (lst)
(loop :for e :in lst :by #'cddr
:collect e)))
If you really want recursion I would have done it with an accumulator with a linear update reverse in the end:
(defun pozpar2 (lst)
(labels ((helper (lst acc)
(if (endp lst)
(nreverse acc)
(helper (cddr lst) (cons (car lst) acc)))))
(helper lst '())))
However a classical not tail recursive version would look like this:
(defun pozpar3 (lst)
(if (endp lst)
'()
(cons (car lst) (pozpar3 (cddr lst)))))
i've seen several examples of implementing append an element to a list, but all are not using tail recursion. how to implement such a function in a functional style?
(define (append-list lst elem)
expr)
The following is an implementation of tail recursion modulo cons optimization, resulting in a fully tail recursive code. It copies the input structure and then appends the new element to it, by mutation, in the top-down manner. Since this mutation is done to its internal freshly-created data, it is still functional on the outside (does not alter any data passed into it and has no observable effects except for producing its result):
(define (add-elt lst elt)
(let ((result (list 1)))
(let loop ((p result) (lst lst))
(cond
((null? lst)
(set-cdr! p (list elt))
(cdr result))
(else
(set-cdr! p (list (car lst)))
(loop (cdr p) (cdr lst)))))))
I like using a "head-sentinel" trick, it greatly simplifies the code at a cost of allocating just one extra cons cell.
This code uses low-level mutation primitives to accomplish what in some languages (e.g. Prolog) is done automatically by a compiler. In TRMC-optimizing hypothetical Scheme, we would be able to write the following tail-recursive modulo cons code, and have a compiler automatically translate it into some equivalent of the code above:
(define (append-elt lst elt) ;; %% in Prolog:
(if (null lst) ;; app1( [], E,R) :- Z=[X].
(list elt) ;; app1( [A|D],E,R) :-
(cons (car lst) ;; R = [A|T], % cons _before_
(append-elt (cdr lst) elt)))) ;; app1( D,E,T). % tail call
If not for the cons operation, append-elt would be tail-recursive. This is where the TRMC optimization comes into play.
2021 update: of course the whole point of having a tail-recursive function is to express a loop (in a functional style, yes), and so as an example, in e.g. Common Lisp (in the CLISP implementation), the loop expression
(loop for x in '(1 2) appending (list x))
(which is kind of high-level specification-y if not even functional in its own very specific way) is translated into the same tail-cons-cell tracking and altering style:
[20]> (macroexpand '(loop for x in '(1 2) appending (list x)))
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
(BLOCK NIL
(LET ((#:G3047 '(1 2)))
(PROGN
(LET ((X NIL))
(LET ((#:ACCULIST-VAR-30483049 NIL) (#:ACCULIST-VAR-3048 NIL))
(MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
(TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G3047) (LOOP-FINISH))
(SETQ X (CAR #:G3047))
(PROGN
(LET ((#:G3050 (COPY-LIST (LIST X))))
(IF #:ACCULIST-VAR-3048
(SETF #:ACCULIST-VAR-30483049
(LAST (RPLACD #:ACCULIST-VAR-30483049 #:G3050)))
(SETF #:ACCULIST-VAR-30483049
(LAST (SETF #:ACCULIST-VAR-3048 #:G3050))))))
(PSETQ #:G3047 (CDR #:G3047)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
(MACROLET
((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
(RETURN-FROM NIL #:ACCULIST-VAR-3048)))))))))) ;
T
[21]>
(with the mother of all structure-mutating primitives spelled R.P.L.A.C.D.) so that's one example of a Lisp system (not just Prolog) which actually does something similar.
Well it is possible to write a tail-recursive append-element procedure...
(define (append-element lst ele)
(let loop ((lst (reverse lst))
(acc (list ele)))
(if (null? lst)
acc
(loop (cdr lst) (cons (car lst) acc)))))
... but it's more inefficient with that reverse thrown in (for good measure). I can't think of another functional (e.g., without modifying the input list) way to write this procedure as a tail-recursion without reversing the list first.
For a non-functional answer to the question, #WillNess provided a nice Scheme solution mutating an internal list.
This is a functional, tail recursive append-elt using continuations:
(define (cont-append-elt lst elt)
(let cont-loop ((lst lst)
(cont values))
(if (null? lst)
(cont (cons elt '()))
(cont-loop (cdr lst)
(lambda (x) (cont (cons (car lst) x)))))))
Performance-wise it's close to Will's mutating one in Racket and Gambit but in Ikarus and Chicken Óscar's reverse did better. Mutation was always the best performer though. I wouldn't have used this however, but a slight version of Óscar's entry, purely because it is easier to read.
(define (reverse-append-elt lst elt)
(reverse (cons elt (reverse lst))))
And if you want mutating performance I would have done:
(define (reverse!-append-elt lst elt)
(let ((lst (cons elt (reverse lst))))
(reverse! lst)
lst))
You can't naively, but see also implementations that provide TCMC - Tail Call Modulo Cons. That allows
(cons head TAIL-EXPR)
to tail-call TAIL-EXPR if the cons itself is a tail-call.
This is Lisp, not Scheme, but I am sure you can translate:
(defun append-tail-recursive (list tail)
(labels ((atr (rest ret last)
(if rest
(atr (cdr rest) ret
(setf (cdr last) (list (car rest))))
(progn
(setf (cdr last) tail)
ret))))
(if list
(let ((new (list (car list))))
(atr (cdr list) new new))
tail)))
I keep the head and the tail of the return list and modify the tail as I traverse the list argument.