I was trying to implement a function that deletes all common elements in two lists using Scheme.
Here is the function I wrote.
#| delete elem from lis|#
(define (delete ele lis)
(cond
((null? ele) lis)
((null? lis) '())
((equal? ele (car lis)) (cdr lis))
(else (cons (car lis) (delete ele (cdr lis))))
)
)
#|delete element from l1 which is in l2 |#
(define (remove l1 l2)
(if(null? l2) l1
(if(null? l1) '()
(remove (delete (car l2) l1) (cdr l2)) )))
(define (remove-common l1 l2)
(list (remove l1 l2) (remove l2 l1)))
The function works well for some inputs, but some didn't work well. How can I fix my code to remove all the common elements in two lists?
(remove-common '(1 2) '(2 4)) #| output : ((1) (4))|#
(remove-common '(1 3) '(2 4)) #| output :((1 3) (2 4)) |#
I expected
(remove-common '(1 2 3) '(1 2 2 3 4))
to yield (() 4), removing the 1s, 2s, and 3s from each list because those are common to both. But the actual result is (() (2 4)).
I'm using R5RS for Scheme.
You're almost there. As #Shawn says, the problem is with the function delete. What you're trying to write here is a filter function.
For this there are two cases:
Keep value. For (filter x xs), cons x onto the front of (filter xs)
Lose value. Just move to (filter xs)
Your delete function correctly handles case 1, but not case 2.
The delete function should be:
#| delete elem from lis|#
(define (delete ele lis)
(cond
((null? ele) lis)
((null? lis) '())
((equal? ele (car lis)) (delete ele (cdr lis))) ; amendment
(else (cons (car lis) (delete ele (cdr lis))))
)
)
> (remove-common '(1 2 3) '(1 2 2 3 4))
(() (4))
Related
i need to create a list such that the min is always at the outside in a list.
Example
input (1 2 3)
output (1 (2 3))
Here is my code, assuming that the numbers are in descending order, which i wish to extent later to a general case.
I am getting an unexpected output of (3 2 1 0 -1 -2 -3 ()).
How do I achieve this in scheme any ideas?'
(define (find-min-rest L)
(if (null? (cdr L)) (let ( (x (car L))) (cons x '( ())))
(let* ((ret-ans (find-min-rest (cdr L))) (cur-elem (car L)) (mini (car ret-ans)) (rem-list (cdr ret-ans)))
(cond ((> cur-elem mini) (cons cur-elem (cons mini rem-list)))))))
It'll be simpler if you use built-in procedures, and split the problem in parts. Notice that the following assumes that there's a single minimum, adjust as necessary:
(define (find-min-rest L)
(let* ((the-min (apply min L))
(the-rest (remove the-min L)))
(list the-min the-rest)))
(find-min-rest '(1 2 3))
=> '(1 (2 3))
The code
(define (find-min-rest L)
(if (null? (cdr L)) (let ( (x (car L))) (cons x '( ())))
(let* ((ret-ans (find-min-rest (cdr L))) (cur-elem (car L)) (mini (car ret-ans)) (rem-list (cdr ret-ans)))
(cond ((> cur-elem mini) (cons cur-elem (cons mini rem-list)))))))
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 '())
)
Using LISP, i need to create a function that splits a list into two lists. The first list consists of 1st, 3rd, 5th, 7th, etc elements and the second list consists of 2nd, 4th, 6th, etc elements.
Output Examples:
(SPLIT-LIST ( )) => (NIL NIL)
(SPLIT-LIST '(A B C D 1 2 3 4 5)) => ((A C 1 3 5) (B D 2 4))
(SPLIT-LIST '(B C D 1 2 3 4 5)) => ((B D 2 4) (C 1 3 5))
(SPLIT-LIST '(A)) => ((A) NIL)
The function need to be recursive.
This is my code so far.
(defun SPLIT-LIST (L)
(cond
((null L) NIL)
((= 1 (length L)) (list (car L)))
(t (cons (cons (car L) (SPLIT-LIST (cddr L))) (cadr L)))))
);cond
);defun
i'm going to try to use flatten later on so that i end up w/ two lists, but for now, i just can't seem to get the sequence correctly.
MY CODE:
> (SPLIT-LIST '(1 2 3 4))
((1 (3) . 4) . 2)
I just can't seem to make the code print 1 3 2 4 instead of 1 3 4 2.
> (SPLIT-LIST '(1 2 3 4 5 6))
((1 (3 (5) . 6) . 4) . 2)
I can't make the second half of the expected output to print in the correct sequence.
Your code
We typically read Lisp code by indentation, and don't write in all-caps. Since we read by indentation, we don't need to put closing parens (or any parens, really) on their own line. Your code, properly formatted, then, is:
(defun split-list (l)
(cond
((null l) '())
((= 1 (length l)) (list (car l)))
(t (cons (cons (car l)
(split-list (cddr l)))
(cadr l)))))
Getting the base cases right
Split-list is always supposed to return a list of two lists. We should cover those base cases first. When l is empty, then there's nothing in the left list or the right, so we can simply return '(() ()). Then first condition then becomes:
((null l) '(() ())) ; or ((endp l) '(() ()))
Judging by your second case, I gather that you want the second and third cases to be: (i) if there's only one element left, it must be an odd-numbered one, and belongs in the left result; (ii) otherwise, there are at least two elements left, and we can add one to each. Then the second condition should be
((= 1 (length l)) (list (car l) '()))
It's actually kind of expensive to check the length of l at each step. You only care whether there is only one element left. You already know that l isn't empty (from the first case), so you can just check whether the rest oflis the empty list. I find it more readable to usefirstandrest` when working with cons cells as lists, so I'd write the second clause as:
((endp (rest l)) (list (list (first l)) '()))
Handling the recursive case
Now, your final case is where there are at least two elements. That means that l looks like (x y . zs). What you need to do is call split-list on zs to get some result of the form (odd-zs even-zs), and then take it apart and construct ((x . odd-zs) (y . even-zs)). That would look something like this:
(t (let ((split-rest (split-list (rest (rest l)))))
(list (list* (first l) (first split-rest))
(list* (second l) (second split-rest)))))
There are actually some ways you can clean that up. We can use destructuring-bind to pull odd-zs and even-zs out at the same time. Since this is the last clause of the cond, and a clause returns the value of the test if there are no body forms, we don't need the initial t. The last clause can be:
((destructuring-bind (odd-zs even-zs) ; *
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
*I omitted the t test because if a cond clause has no body forms, then the value of the test is returned. That works just fine here.
Putting that all together, we've reworked your code into
(defun split-list (l)
(cond
((endp l) '(() ()))
((endp (rest l)) (list (list (first l)) '()))
((destructuring-bind (odd-zs even-zs)
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
Other approaches
I think it's worth exploring some approaches that are tail recursive, as an implementation that supports tail call optimization can convert them to loops. Tail recursive functions in Common Lisp are also typically easy to translate into do loops, which are much more likely to be implemented as iteration. In these solutions, we'll build up the result lists in reverse, and then reverse them when it's time to return them.
Recursing one element at a time
If the left and right slices are interchangeable
If it doesn't matter which of the two lists is first, you can use something like this:
(defun split-list (list &optional (odds '()) (evens '()))
(if (endp list)
(list (nreverse odds)
(nreverse evens))
(split-list (rest list)
evens
(list* (first list) odds))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((B D 2) (A C 1 3))
This can actually be written very concisely using a do loop, but that's typically seen as iterative, not recursive:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds)))
((endp list) (list (nreverse odds) (nreverse evens)))))
If they're not interchangable
If you always need the list containing the first element of the original list to be first, you'll need a little bit more logic. One possibility is:
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(if (endp list)
(if swap
(list (nreverse evens)
(nreverse odds))
(list (nreverse odds)
(nreverse evens)))
(split-list (rest list)
evens
(list* (first list) odds)
(not swap))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
I think that (if swap … …) is actually a bit ugly. We can use cond so that we can get multiple forms (or if and progn), and swap the values of odds and evens before returning. I think this is actually a bit easier to read, but if you're aiming for a pure recursive solution (academic assignment?), then you might be avoiding mutation, too, so rotatef wouldn't be available, and using a when just to get some side effects would probably be frowned upon.
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(cond
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))
((split-list (rest list)
evens
(list* (first list) odds)
(not swap)))))
This lends itself to do as well:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds))
(swap nil (not swap)))
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))))
Recursing two elements at a time
Another more direct approach would recurse down the list by cddr (i.e., (rest (rest …))) and add elements to the left and right sublists on each recursion. We need to be a little careful that we don't accidentally add an extra nil to the right list when there are an odd number of elements in the input, though.
(defun split-list (list &optional (left '()) (right '()))
(if (endp list)
(list (nreverse left)
(nreverse right))
(split-list (rest (rest list))
(list* (first list) left)
(if (endp (rest list))
right
(list* (second list) right)))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
And again, a do version:
(defun split-list (list)
(do ((list list (rest (rest list)))
(left '() (list* (first list) left))
(right '() (if (endp (rest list)) right (list* (second list) right))))
((endp list) (list (nreverse left) (nreverse right)))))
Here's what I've got:
(defun split-list (lst)
(if lst
(if (cddr lst)
(let ((l (split-list (cddr lst))))
(list
(cons (car lst) (car l))
(cons (cadr lst) (cadr l))))
`((,(car lst)) ,(cdr lst)))
'(nil nil)))
After reading SICP I'm rarely confused about recursion.
I highly recommend it.
Here's my take, using an inner function:
(defun split-list (lst)
(labels ((sub (lst lst1 lst2 flip)
(if lst
(if flip
(sub (cdr lst) (cons (car lst) lst1) lst2 (not flip))
(sub (cdr lst) lst1 (cons (car lst) lst2) (not flip)))
(list (reverse lst1) (reverse lst2)))))
(sub lst nil nil t)))
As a Common Lisp LOOP:
(defun split-list (list)
"splits a list into ((0th, 2nd, ...) (1st, 3rd, ...))"
(loop for l = list then (rest (rest l))
until (null l) ; nothing to split
collect (first l) into l1 ; first split result
unless (null (rest l))
collect (second l) into l2 ; second split result
finally (return (list l1 l2))))
With internal tail-recursive function building the lists in top-down manner (no reverses, loop code probably compiles to something equivalent), with a head-sentinel trick (for simplicity).
(defun split-list (lst &aux (lst1 (list 1)) (lst2 (list 2)))
(labels ((sub (lst p1 p2)
(if lst
(progn (rplacd p1 (list (car lst)))
(sub (cdr lst) p2 (cdr p1)))
(list (cdr lst1) (cdr lst2)))))
(sub lst lst1 lst2)))
Flatten is fun to define in Lisp. But I've never had a use for it.
So if you think "I could use flatten to solve this problem" it's probably because you're trying to solve the wrong problem.
(defun split-list (L)
(if (endp L)
'(nil nil)
(let ((X (split-list (cdr L))))
(list (cons (car L) (cadr X)) (car X))
)))
I have tried many times but I still stuck in this problem, here is my input:
(define *graph*
'((a . 2) (b . 2) (c . 1) (e . 1) (f . 1)))
and I want the output to be like this: ((2 a b) (1 c e f))
Here is my code:
(define group-by-degree
(lambda (out-degree)
(if (null? (car (cdr out-degree)))
'done
(if (equal? (cdr (car out-degree)) (cdr (car (cdr out-degree))))
(list (cdr (car out-degree)) (append (car (car out-degree))))
(group-by-degree (cdr out-degree))))))
Can you please show me what I have done wrong cos the output of my code is (2 a). Then I think the idea of my code is correct.
Please help!!!
A very nice and elegant way to solve this problem, would be to use hash tables to keep track of the pairs found in the list. In this way we only need a single pass over the input list:
(define (group-by-degree lst)
(hash->list
(foldl (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst)))
The result will appear in a different order than the one shown in the question, but nevertheless it's correct:
(group-by-degree *graph*)
=> '((1 f e c) (2 b a))
If the order in the output list is a problem try this instead, it's less efficient than the previous answer, but the output will be identical to the one in the question:
(define (group-by-degree lst)
(reverse
(hash->list
(foldr (lambda (key ht)
(hash-update
ht
(cdr key)
(lambda (x) (cons (car key) x))
'()))
'#hash()
lst))))
(group-by-degree *graph*)
=> '((2 a b) (1 c e f))
I don't know why the lambda is necessary; you can directly define a function with (define (function arg1 arg2 ...) ...)
That aside, however, to put it briefly, the problen is that the cars and cdrs are messed up. I couldn't find a way to tweak your solution to work, but here is a working implementation:
; appends first element of pair into a sublist whose first element
; matches the second of the pair
(define (my-append new lst) ; new is a pair
(if (null? lst)
(list (list (cdr new) (car new)))
(if (equal? (car (car lst)) (cdr new))
(list (append (car lst) (list (car new))))
(append (list (car lst)) (my-append new (cdr lst)))
)
)
)
; parses through a list of pairs and appends them into the list
; according to my-append
(define (my-combine ind)
(if (null? ind)
'()
(my-append (car ind) (my-combine (cdr ind))))
)
; just a wrapper for my-combine, which evaluates the list backwards
; this sets the order right
(define (group-by-degree out-degree)
(my-combine (reverse out-degree)))
If my input is a list of lists, then I want to output a list with elements from the input so that they are shuffled like a deck of playing cards.
For example, if input is '((1 2 3) (4 5)) then I want output to show up as '(1 4 2 5 3).
My idea is to first remove an element from the first list inside of a list, and then move that list of a list to the back of the list. This way, the first element of the next list of a list can then be appended.
Here is my code so far:
(define (shuffle ls)
(if (null? ls) '()
(cond ((null? car (ls)) (append (cdr (ls)) (list (cdr(car(ls)))))))
(else (car (car (ls)))
(append (cdr (ls)) (list (cdr (car (ls))))
(shuffle (cdr (ls)))))))
[All the code snippets here require SRFI 1 to be loaded first.]
What you seem to be wanting is to zip the lists:
> (zip '(1 2 3) '(4 5))
((1 4) (2 5))
However, as you can see, this stops when it gets to the end of the shortest list. Maybe you can write a custom zip that will stop after all elements are exhausted:
(define (my-zip l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (cons (car l2) (my-zip l1 (cdr l2))))
((null? l2) (cons (car l1) (my-zip (cdr l1) l2)))
(else (cons* (car l1) (car l2) (my-zip (cdr l1) (cdr l2))))))
Let's try it out!
> (my-zip '(1 2 3) '(4 5))
(1 4 2 5 3)
> (my-zip '(1 2 3) '(4 5 6 7))
(1 4 2 5 3 6 7)
this would work too... i use chicken scheme so i have to "import" filter from srfi-1.
(use srfi-1)
(define *deck* '((1 2 3 4) (5 6 7) (9 10 11 12)))
(define nullcar?
(lambda (x)
(if (not (null? x))
(null? (car x)))))
(define nullcdr?
(lambda (x)
(if (not (null? x))
(null? (cdr x)))))
(define notnulls
(lambda (x)
(filter (lambda (e)
(not (null? e)))
x)))
(define firsts
(lambda (l)
(if (not (null? l))
(map (lambda (x)
(if (not (null? x))
(car x)
'()))
l))))
(define shuf
(lambda (d)
(notnulls
(append (firsts d)
(if (not (nullcar? d))
(if (not (nullcdr? d))
(shuf (map cdr (notnulls d)))
'())
'())))))
cheers!