Sorting list of lists by their first element in scheme - sorting

I'm working on sorting a list of lists by their first element for example
(sort (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 1))))
expected output => ('(1 1) '(2 1 6 7) '(4 3 1 2 4 5))
The algorithm I used is bubble sort. And I modified it to deal with lists. However, the code doesn't compile. The error is
mcar: contract violation
expected: mpair?
given: 4
Can someone correct my code and explain it. Thank you
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(list (car L)
(bubble (car (cdr L))))
(list (cadr L)
(bubble (cons (car (car L)) (car (cddr L))))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(bubble-set-up t3)

How about (sort (lambda (x y)(< (car x)(car y))) <YOUR_LIST>)?

I have fixed a few mistakes. There is at least one mistake left.
Consider the case where L only contains one element.
#lang r5rs
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(cons (car L)
(bubble (cdr L)))
(cons (cadr L)
(bubble (cons (car L) (cddr L)))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(display (bubble-set-up t3))
(newline)

Related

Create palindrom function without append function in output in scheme

i am trying to create palyndrom function which is doing palyndrom from input string. Something like this: (palindrome '(1 2 3 4)) ==> (1 2 3 4 3 2 1).
I have created this code below but it is returning me (palindrome '(1 2 3 4)) ==> (1 (2 (3 (4) 3) 2) 1)
My code is below. Task is to NOT use append or reverse.
(define (palindrome l)
(cond
((null? (cdr l)) (list (car l)))
((list (car l) (palindrome (cdr l)) (car l)))))
Thanks for help.
As in the comment of Sylwester, you can do your own version of append or reverse. Here is an example in which only the append function (called concatenate) is defined.
(define (palindrome l)
(define (concatenate l1 l2)
(if (null? l1)
l2
(cons (car l1) (concatenate (cdr l1) l2))))
(define (p l)
(cond ((null? l) '())
((null? (cdr l)) l)
(else (cons (car l) (concatenate (p (cdr l)) (list (car l)))))))
(p l))
(palindrome '(1 2 3 4))
'(1 2 3 4 3 2 1)
Here instead is a tail recursive version:
(define (palindrome l)
(define (concatenate l1 l2)
(if (null? l1)
l2
(cons (car l1) (concatenate (cdr l1) l2))))
(define (p l prefix suffix)
(cond ((null? l) (concatenate prefix suffix))
((null? (cdr l)) (concatenate prefix (cons (car l) suffix)))
(else (p (cdr l) (concatenate prefix (list (car l))) (cons (car l) suffix)))))
(p l '() '()))

Show last appearance of element in list

I want to show the last appearance of an element from a given list. For example: For the list '(1 1 2 1 3 3 4 3 5 6), the result will be '(2 1 4 3 5 6)
This is the code I have:
(define (func L res)
(if (not (null? L))
(foldl (lambda (e)
(if (not (member e (cdr L)))
(cons e (remove-duplicates-right (cdr L)))
(remove-duplicates-right (cdr L))))
res L)
res))
(define (show-last-app L)
(func L '()))
The next error occurs: "foldl: given procedure does not accept 2 arguments"
This is how I solved it only with recursion but I want to use only foldl or filter and don't use functions with side effects:
(define (show-last-app L)
(cond
((null? L)
'())
((not (member (car L) (cdr L)))
(append (list (car L)) (show-last-app (cdr L))))
(else (show-last-app (cdr L)))))
I think you misunderstand how folds work in Scheme. This is closer to what you were aiming for:
(define (show-last-app L)
(foldr (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
L))
If you really, really have to use foldl:
(define (show-last-app L)
(foldl (lambda (e acc)
(if (not (member e acc))
(cons e acc)
acc))
'()
(reverse L)))
Either way, it works as expected:
(show-last-app '(1 2 4 1 5 3 1 6 2))
=> (4 5 3 1 6 2)

(Scheme) How do I add 2 lists together that are different sizes

I'm completely new to scheme and I'm having trouble trying to add 2 lists of different sizes. I was wondering how do I add 2 lists of different sizes together correctly. In my code I compared the values and append '(0) to the shorter list so that they can get equal sizes, but even after doing that I can not use map to add the 2 lists. I get an error code after running the program. The results I should be getting is '(2 4 5 4). Could anyone help me out? Thanks.
#lang racket
(define (add lst1 lst2)
(cond [(< (length lst1) (length lst2)) (cons (append lst1 '(0)))]
[else lst1])
(cond
((and (null? lst1)(null? lst2)) null)
(else
(map + lst1 lst2))))
;;Result should be '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
ERROR:
cons: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
'(1 2 3 0)
The problem with your code is that there are two cond expressions one after the other - both will execute, but only the result of the second one will be returned - in other words, the code is not doing what you think it's doing. Now, to solve this problem it'll be easier if we split the solution in two parts (in general, that's a good strategy!). Try this:
(define (fill-zeroes lst n)
(append lst (make-list (abs n) 0)))
(define (add lst1 lst2)
(let ((diff (- (length lst1) (length lst2))))
(cond [(< diff 0)
(map + (fill-zeroes lst1 diff) lst2)]
[(> diff 0)
(map + lst1 (fill-zeroes lst2 diff))]
[else (map + lst1 lst2)])))
Explanation:
The fill-zeroes procedure takes care of filling the tail of a list with a given number of zeroes
The add procedure is in charge of determining which list needs to be filled, and when both lists have the right size performs the actual addition
It works as expected for any combination of list lengths:
(add '(1 2 3 4) '(1 2 3))
=> '(2 4 6 4)
(add '(1 2 3) '(1 2 3 4))
=> '(2 4 6 4)
(add '(1 2 3 0) '(1 2 3 4))
=> '(2 4 6 4)
Similar to Oscar's, slighty shorter:
(define (fill0 lst len)
(append lst (make-list (- len (length lst)) 0)))
(define (add lst1 lst2)
(let ((maxlen (max (length lst1) (length lst2))))
(map + (fill0 lst1 maxlen) (fill0 lst2 maxlen))))
or, for fun, the other way round:
(define (add lst1 lst2)
(let ((minlen (min (length lst1) (length lst2))))
(append
(map + (take lst1 minlen) (take lst2 minlen))
(drop lst1 minlen)
(drop lst2 minlen))))
There's no need to pre-compute the lengths of the lists and add zeroes to the end of one or the other of the lists. Here we solve the problem with a simple recursion:
(define (add xs ys)
(cond ((and (pair? xs) (pair? ys))
(cons (+ (car xs) (car ys)) (add (cdr xs) (cdr ys))))
((pair? xs) (cons (car xs) (add (cdr xs) ys)))
((pair? ys) (cons (car ys) (add xs (cdr ys))))
(else '())))
That works for all of Oscar's tests:
> (add '(1 2 3 4) '(1 2 3))
(2 4 6 4)
> (add '(1 2 3) '(1 2 3 4))
(2 4 6 4)
> (add '(1 2 3 0) '(1 2 3 4))
(2 4 6 4)
If you like, you can write that using a named-let and get the same results:
(define (add xs ys)
(let loop ((xs xs) (ys ys) (zs '()))
(cond ((and (pair? xs) (pair? ys))
(loop (cdr xs) (cdr ys) (cons (+ (car xs) (car ys)) zs)))
((pair? xs) (loop (cdr xs) ys (cons (car xs) zs)))
((pair? ys) (loop xs (cdr ys) (cons (car ys) zs)))
(else (reverse zs)))))
Have fun!
A yet simpler version.
(define (add x y)
(cond ((and (pair? x) (pair? y))
(cons (+ (car x) (car y))
(add (cdr x) (cdr y))))
((pair? x) x)
(else y)))

List order after duplicate filtering

I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)

Bubble Sorting with Scheme

I'm working on implementing a bubble sorting algorithm in Scheme, and I must say that the functional way of programming is a strange concept and I am struggling a bit to grasp it.
I've successfully created a function that will bubble up the first largest value we come across, but that's about all it does.
(bubbleH '(5 10 9 8 7))
(5 9 8 7 10)
I am struggling with the helper function that is required to completely loop through the list until no swaps have been made.
Here's where I am at so far, obviously it is not correct but I think I am on the right track. I know that I could pass in the number of elements in the list myself, but I am looking for a solution different from that.
(define bubbaS
(lambda (lst)
(cond (( = (length lst) 1) (bubba-help lst))
(else (bubbaS (bubba-help lst))))))
Using the bubble-up and bubble-sort-aux implementations in the possible-duplicate SO question I referenced...
(define (bubble-up L)
(if (null? (cdr L))
L
(if (< (car L) (cadr L))
(cons (car L) (bubble-up (cdr L)))
(cons (cadr L) (bubble-up (cons (car L) (cddr L)))))))
(define (bubble-sort-aux N L)
(cond ((= N 1) (bubble-up L))
(else (bubble-sort-aux (- N 1) (bubble-up L)))))
..., this is simple syntactic sugar:
(define (bubbleH L)
(bubble-sort-aux (length L) L))
With the final bit of syntactic sugar added, you should get exactly what you specified in your question:
(bubbleH '(5 10 9 8 7))
=> (5 7 8 9 10)
You can tinker with everything above in a repl.it session I saved & shared.
Here's my own tail-recursive version.
The inner function will bubble up the largest number just like your bubbleH procedure. But instead of returning a complete list, it will return 2 values:
the unsorted 'rest' list
the largest value that has bubbled up
such as:
> (bsort-inner '(5 1 4 2 8))
'(5 2 4 1)
8
> (bsort-inner '(1 5 4 2 8))
'(5 2 4 1)
8
> (bsort-inner '(4 8 2 5))
'(5 2 4)
8
Now the outer loop just has to cons the second value returned, and iterate on the remaining list.
Code:
(define (bsort-inner lst)
(let loop ((lst lst) (res null))
(let ((ca1 (car lst)) (cd1 (cdr lst)))
(if (null? cd1)
(values res ca1)
(let ((ca2 (car cd1)) (cd2 (cdr cd1)))
(if (<= ca1 ca2)
(loop cd1 (cons ca1 res))
(loop (cons ca1 cd2) (cons ca2 res))))))))
(define (bsort lst)
(let loop ((lst lst) (res null))
(if (null? lst)
res
(let-values (((ls mx) (bsort-inner lst)))
(loop ls (cons mx res))))))
For a recursive version, I prefer one where the smallest value bubbles in front:
(define (bsort-inner lst)
; after one pass, smallest element is in front
(let ((ca1 (car lst)) (cd1 (cdr lst)))
(if (null? cd1)
lst ; just one element => sorted
(let ((cd (bsort-inner cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(define (bsort lst)
(if (null? lst)
null
(let ((s (bsort-inner lst)))
(cons (car s) (bsort (cdr s))))))

Resources