I have written a function called "show-list" which passes all the tests below
(defun show-list (l)
(cond ((atom l)
(format t "~s" l))
(t (format t "[")
(do ((lst l (cdr lst)))
((null lst) (format t"]"))
(cond ((atom lst)
(format t ". ")
(format t "~s" lst)
(format t "]")
(return-from show-list))
(t (show-list (car lst))
(when (cdr lst)
(format t " "))))))))
(define-test show-list
(assert-prints "[A B C]" (show-list '(a b c)))
(assert-prints "[[[A B] C] D]" (show-list '(((a b) c) d)))
(assert-prints "[A [B C]]" (show-list '(a (b c))))
(assert-prints "[A . B]" (show-list '(a . b)))
(assert-prints "[A B C . D]" (show-list '(a b c . d)))
(assert-prints "A" (show-list 'a))
(assert-prints "12" (show-list 12))
(assert-prints "NIL" (show-list nil))
(assert-prints "[NIL]" (show-list '(nil)))
(assert-prints "[[[A]]]" (show-list '(((a)))))
(assert-prints "[[A] . B]" (show-list '((a) . b)))
)
but I've gotten a feedback saying
(defun show-list (l)
(cond ((or (null l) (atom l))
;;; "You don't need an `or` here"*
(format t "~s" l))
(t (format t "[")
(do ((lst l (cdr lst)))
((null lst) (format t"]"))
;;; Though `null` is the usual test for end of lists, it's not the right one
;;; here, because the lists might not end with `NIL`. Use a different equally
;;; simple test, that applies to all valid lists you want to handle. Then
;;; check in the exit branch what needs to happen before finishing.
(cond ((atom lst)
(format t ". ")
(format t "~s" lst)
(format t "]")
(return-from show-list))
;;; You don't need to bury a `return` inside the `do` body. Use the exit test
;;; of the `do`. That's what it's for.
(t (show-list (car lst))
(when (cdr lst)
(format t " "))))))))
;;; You won't need a conditional in the loop to handle spaces between
;;; elements, if you do the first element before the loop.
I've been trying to refactor it for hours but I feel like I'm wasting time and not making any progress...
Since you are walking a tree it seems awkward to have loops in your code. It should basically only be (1) test if we have an atom, else (2) recurse on car and cdr.
Here's an example that uses only recursion, no return-from:
(defun show-list (l &optional (is-car t))
(cond
((atom l)
(unless is-car (format t ". "))
(format t "~s" l))
(t
(when is-car (format t "["))
(show-list (car l) t)
(let ((cd (cdr l)))
(unless (null cd)
(format t " ")
(show-list cd nil)))
(when is-car (format t "]")))))
The only piece of "magic" is the additional parameter which helps remembering whether we're currently processing the car or the cdr of a cons cell.
Related
I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo
I have the following recursive function in Lisp
(defun f (item tree)
(when tree
(if (equal item (car tree)) tree
(if (and (listp (car tree))
(equal item (caar tree)))
(car tree)
(if (cdr tree)
(f item (cdr tree)))))))
This function receives a tree and an item to look for in its immediate leaves. If item is the car of any sublist, then it will return that sublist. That is,
(f 'c '(a b c)) => (c)
(f 'b '(a b c)) => (b c)
(f 'a '((a 1 2) b c)) => (a 1 2)
I've recently been informed that (Emacs Lisp) doesn't do tail recursion optimization, so I've been advised to turn this into a while loop. All of my training in Lisp has been in avoidance of loops like this. (I maintain that they are un-functional, but that's borderline pedantic.) I've made the following attempt for more conformative style:
(defun f (item tree)
(let ((p tree))
(while p
(cond
((equal item (car p)) p)
((and (listp (car p))
(equal item (caar p)))
(car tree))
(t (f item (cdr p))))
(setq p (cdr p)))))
I've shortened the function name for brevity/clarity, but do have a look at where it is being used if you are a power-user of emacs.
Your "iterative" solution is still recursing. It's also not returning the values found in the cond expression.
The following version sets a variable to the found result. Then the loop ends if a result has been found, so it can be returned.
(defun f (item tree)
(let ((p tree)
(result nil))
(while (and p (null result))
(cond ((equal item (car p)) (setq result p))
((and (listp (car p))
(equal item (caar p)))
(setq result (car tree)))
(t (setq p (cdr p)))))
result))
Hi I got the error mcar: contract violationexpected: mpair? given: () while running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? list) (newline))
(#t (helpy (car listy) (cdr listy))
(print (cdr listy))))))
My code is trying to return pairs in a list. For example, when I call
(print '(a b c)) it should return ((a b) (a c) (b c)).
I just fix and update my code, now it don't return error but I can only get pair ( (a b) (a c), when running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(#t (helpy (car listy) (cdr listy)))
(print (cdr listy)))))
I think that I got something wrong with the recursion
There are a couple of problems with the code. First, by convention the "else" clause of a cond should start with an else, not a #t. Second, the null? test in print should receive listy, not list. And third, you're not doing anything with the result returned by helpy in print, you're just advancing print over the cdr of the current list without doing anything with the value returned by the recursive call. Try this instead:
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(else
(displayln (helpy (car listy) (cdr listy)))
(print (cdr listy))))))
displayln is just an example, do something else with the returned result if necessary.
I try to implement like this:
#lang racket
(define data '(a b c d))
(define (one-list head line-list)
(if (null? line-list)
null
(cons
(cons head (car line-list))
(one-list head (rest line-list)))))
(letrec ([deal-data
(lambda (data)
(if (null? data)
'()
(append
(one-list (car data) (rest data))
(deal-data (rest data)))))])
(deal-data data))
run result:
'((a . b) (a . c) (a . d) (b . c) (b . d) (c . d))
(define *graph* (read (open-input-file "test.sxml")))
(define get
(lambda (l)
(cond ((null? l) '())
((equal? 'opm:artifacts (car l)) l)
(else (get (cdr l))))))
(get *graph*)
I have this recursive function that goes through the list and returns the rest of a list that starts with "opm:artifacts".
It works on other lists.
For example, it works for the list (1 2 3 4); when I call the function,
(get 2) returns (2 3 4).
test.sxml is a list. I checked it with list?.
(define (get l)
(match l
[(? null?) '()]
[(list 'opm:artifacts _ ...) l]
[(list _ rs ...) (get rs)]))
(define (get mat ls*)
(define (get* ls)
(cond ((null? ls) '())
((and (list? (car ls)) (not (null? (car ls))))
(if (equal? mat (caar ls))
(car ls)
(let ((sub-result (get* (car ls))))
(if (null? sub-result)
(get* (cdr ls))
sub-result))))
(else (get* (cdr ls)))))
(let ((result (get* ls*)))
(if (null? result)
'()
(cdr result))))
(get 'b '(a (b c d) e)) ;-> '(c d)
(get 'b '((a (b c d) e))) ;-> '(c d)
(get '() '( 4 6 () (2 ()) (() () ()))) ;-> '(() ())
I've also generalized it so you can hand in what you want it to match against.
I want to write a function that removes trailing nil's from a list. I first tried to write it elegantly with recursion, but ended up like this:
(defun strip-tail (lst)
(let ((last-item-pos (position-if-not #'null lst :from-end t)))
(if last-item-pos
(subseq lst 0 (1+ last-item-pos)))))
; Test cases.
(assert (eq nil (strip-tail nil)))
(assert (eq nil (strip-tail '(nil))))
(assert (equal '(a b) (strip-tail '(a b nil nil))))
(assert (equal '(a nil b) (strip-tail '(a nil b nil))))
(assert (equal '(a b) (strip-tail '(a b))))
It's arguably clear, but I'm not convinced. Is there a more lispy way to do it?
Well, a version would be:
reverse the list
remove leading nils
reverse the list
The code:
(defun list-right-trim (list &optional item)
(setf list (reverse list))
(loop for e in list while (eq item e) do (pop list))
(reverse list))
Here is another variant:
iterate over the list and note the position of the first nil which is only followed by nils
return the sub-sequence
the code:
(defun list-right-trim (list &aux (p nil))
(loop for i from 0 and e in list
when (and (null p) (null e))
do (setf p i)
else when (and p e) do (setf p nil))
(if p (subseq list 0 p) list))
(defun strip-tail (ls)
(labels ((strip-car (l)
(cond ((null l) nil)
((null (car l)) (strip-car (cdr l)))
(t l))))
(reverse (strip-car (reverse ls)))))
Sample run (against your test cases):
[1]> (assert (eq nil (strip-tail nil)))
NIL
[2]> (assert (eq nil (strip-tail '(nil)))) ;'
NIL
[3]> (assert (equal '(a b) (strip-tail '(a b nil nil))))
NIL
[4]> (assert (equal '(a nil b) (strip-tail '(a nil b nil))))
NIL
[5]> (assert (equal '(a b) (strip-tail '(a b))))
NIL
[6]>
How about this?
(defun strip-tail (lst)
(if lst
(let ((lst (cons (car lst) (strip-tail (cdr lst)))))
(if (not (equal '(nil) lst)) lst))))
...wonder how to make it tail-recursive though, this version would exhaust the stack for large lists.
Here's what I came up with, assuming you don't mind this being destructive:
(defvar foo (list 'a 'b 'c nil 'd 'e 'nil 'nil 'f nil nil))
(defun get-last-non-nil (list &optional last-seen)
(if list
(if (car list)
(get-last-non-nil (cdr list) list)
(get-last-non-nil (cdr list) last-seen))
last-seen))
(defun strip-tail (list)
(let ((end (get-last-non-nil list)))
(if (consp end)
(when (car end) (setf (cdr end) nil) list))))
(strip-tail foo) -> (A B C NIL D E NIL NIL F)
I tried using recursion but it doesn't work on GNU CL:
(defun strip(lst)
(if (null (last lst))
(strip (butlast lst))
lst))
the idea is:
test if the last list element is nil, if so make a recursive call with
the last element removed (butlast)
then return the list itself
Well, this is not really an answer, but I thought I'd put this here as well so it has better visibility.
In your original implementation, do you think non-list items should be handled?
* (strip-tail "abcde")
"abcde"
* (strip-tail 42)
debugger invoked on a TYPE-ERROR in thread #<THREAD "initial thread" {A69E781}>:
The value 42 is not of type SEQUENCE.