Power set in Scheme with ordered output - sorting

So I am familiar with the algorithm for creating a power set using Scheme that looks something like this:
(define (power-set set)
(if (null? set) '(())
(let ((power-set-of-rest (power-set (cdr set))))
(append power-set-of-rest
(map (lambda (subset) (cons (car set) subset))
power-set-of-rest)))))
So this, for (1, 2, 3, 4), would output:
(() (4) (3) (3 4) (2) (2 4) (2 3) (2 3 4) (1) (1 4) (1 3) (1 3 4) (1 2) (1 2 4)
(1 2 3) (1 2 3 4))
I need to figure out how to output the power set "in order", for example:
(() (1) (2) (3) (4) (1 2) (1 3) (1 4) (2 3) (2 4) (3 4) (1 2 3) (1 2 4) (1 3 4)
(2 3 4) (1 2 3 4))
Doing a little research, it seems as if the best option would be for me to run a sort before outputting. I am NOT allowed to use built in sorts, so I have found some example sorts for sorting a list:
(define (qsort e)
(if (or (null? e) (<= (length e) 1))
e
(let loop ((left null) (right null)
(pivot (car e)) (rest (cdr e)))
(if (null? rest)
(append (append (qsort left) (list pivot)) (qsort right))
(if (<= (car rest) pivot)
(loop (append left (list (car rest))) right pivot (cdr rest))
(loop left (append right (list (car rest))) pivot (cdr rest)))))))
I cannot figure out how I would go about sorting it based off of the second, or third element in one of the power sets though. Can anyone provide an example?

Here's a powerset function that returns the items in the correct order, without sorting. It requires Racket and uses its queues to implement breadth-first processing:
(require srfi/1 data/queue)
(define (powerset items)
(define fifo (make-queue))
(enqueue! fifo (cons '() items))
(let loop ((result '()))
(if (queue-empty? fifo)
(reverse result)
(let* ((head-entry (dequeue! fifo))
(subset (car head-entry))
(rest-items (cdr head-entry)))
(pair-for-each (lambda (next-items)
(enqueue! fifo (cons (cons (car next-items) subset)
(cdr next-items))))
rest-items)
(loop (cons (reverse subset) result))))))
We maintain a FIFO queue of pairs, each consisting of a subset (in reversed order) and a list of items not included in it, starting with an empty subset so all the original items are still not included in it.
For each such pair, we collect the subset into the result list, and also extend the queue by extending this subset by each item from the not-included items. Processing stops when the queue is empty.
Because we extend subsets each time by one element only, and in order, the result is ordered too.

Here's a compare function that should work for your needs. It assumes that the numbers in the two input arguments are sorted already.
(define (list-less? lst1 lst2)
;; Compare the contents of the lists.
(define (helper l1 l2)
;; If two lists are identical, the answer is false.
;; This scenario won't be exercised in the problem.
;; It's here only for the sake of completeness.
(if (null? l1)
#f
;; If the first item of the second list is greater than
;; the first item, return true.
(if (> (car l2) (car l1))
#t
(or (< (car l1) (car l2)) (helper (cdr l1) (cdr l2))))))
;; First compare the lengths of the input arguments.
;; A list of smaller length are assumed to be "less"
;; than list of greater length.
;; Only when the lists are of equal length, do we
;; compare the contents of the lists.
(let ((len1 (length lst1)) (len2 (length lst2)))
(if (> len1 len2)
#f
(or (< len1 len2) (helper lst1 lst2)))))

Related

Scheme function that returns shortest of its list arguments

I am trying to create a scheme function that will return the shortest of its list of arguments.
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8)) should compile (4).
This is what I have so far...
(define (shortest lst) (foldl (lambda (e r) (if (or (not r) (< e r)) e r))
#f
lst))
It gives error arity mismatch.
Your answer is close to be correct, but you need to actually compare the lengths of the sublists, and make sure that your procedure accepts a variable number of arguments. This should work, with minimum changes:
; the . is for accepting multiple args
(define (shortest . lst)
(foldl (lambda (e r)
; notice how we compare the lengths
(if (or (not r) (< (length e) (length r))) e r))
#f
lst))
It works as expected:
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8))
=> '(4)
(shortest '())
=> '()
(shortest)
=> #f
Your function has only one argument named lst, but you call it on variable number of lists. So, you should decide which input do you expect:
List of lists
(define (shortest lst)
(if (null? lst) lst
(car (sort lst
(lambda (l1 l2)
(< (length l1) (length l2)))))))
(shortest '((1 2) (2 3 4) (4) (5 6 7 8)))
(shortest '())
Variable number of lists
(define (shortest . args)
(if (null? args) args
(car (sort args
(lambda (l1 l2)
(< (length l1) (length l2)))))))
(shortest '(1 2) '(2 3 4) '(4) '(5 6 7 8))
(shortest '())
One interesting thing to ask is: can you solve this problem without taking the length of all the lists? If you have a list with a million elements and one with four, do you really need to compute the length of the huge list to know the answer?
Well, the answer is no, you don't. Here's one approach to doing this:
(define (shortest . args)
(define (step tail-pairs new-tail-pairs)
;; step has a list of pairs of tail & original-list pairs it is looking at,
;; and another list of pairs of (cdr tail) & original-list which it will
;; look at on the next cycle.
(if (null? tail-pairs)
;; Run out of things to look at, start on the next cycle
(step new-tail-pairs '())
(let ((this-tail-pair (first tail-pairs))
(more-tail-pairs (rest tail-pairs)))
(if (null? (car this-tail-pair))
;; found it: nothing left in this list so return the original
;; list
(cdr this-tail-pair)
;; Not empty: add this tail pair with its first element removed to
;; the next cycle list, and loop on the remains of this cycle
(step more-tail-pairs (cons (cons (cdr (car this-tail-pair))
(cdr this-tail-pair))
new-tail-pairs))))))
;; build the initial list of tail pairs and start stepping down it.
(step (map cons args args) '()))

Scheme - returning first n-elements of an array

I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.

Nested List Issue in Lisp

So I have to write a method that takes in a list like (nested '(4 5 2 8)) and returns (4 (5 () 2) 8).
I figured I needed to write 3 supporting methods to accomplish this. The first gets the size of the list:
(define (sizeList L)
(if (null? L) 0
(+ 1 (sizeList (cdr L)))))
input : (sizeList '(1 2 3 4 5 6 7))
output: 7
The second drops elements from the list:
(define (drop n L)
(if (= (- n 1) 0) L
(drop (- n 1) (cdr L))))
input : (drop 5 '(1 2 3 4 5 6 7))
output: (5 6 7)
The third removes the last element of a list:
(define (remLast E)
(if (null? (cdr E)) '()
(cons (car E) (remLast (cdr E)))))
input : (remLast '(1 2 3 4 5 6 7))
output: (1 2 3 4 5 6)
For the nested method I think I need to do the car of the first element, then recurse with the drop, and then remove the last element but for the life of me I can't figure out how to do it or maybe Im just continually messing up the parenthesis? Any ideas?
Various recursive solutions are possible, but the problem is that the more intuitive ones have a very bad performance, since they have a cost that depends on the square of the size of the input list.
Consider for instance this simple solution:
; return a copy of list l without the last element
(define (butlast l)
(cond ((null? l) '())
((null? (cdr l)) '())
(else (cons (car l) (butlast (cdr l))))))
; return the last element of list l
(define (last l)
(cond ((null? l) '())
((null? (cdr l)) (car l))
(else (last (cdr l)))))
; nest a linear list
(define (nested l)
(cond ((null? l) '())
((null? (cdr l)) l)
(else (list (car l) (nested (butlast (cdr l))) (last l)))))
At each recursive call of nested, there is a call to butlast and a call to last: this means that for each element in the first half of the list we must scan twice the list, and this requires a number of operations of order O(n2).
Is it possible to find a recursive solution with a number of operations that grows only linearly with the size of the list? The answer is yes, and the key to this solution is to reverse the list, and work in parallel on both the list and its reverse, through an auxiliary function that gets one element from both the lists and recurs on their cdr, and using at the same time a counter to stop the processing when the first halves of both lists have been considered. Here is a possible implementation of this algorithm:
(define (nested l)
(define (aux l lr n)
(cond ((= n 0) '())
((= n 1) (list (car l)))
(else (list (car l) (aux (cdr l) (cdr lr) (- n 2)) (car lr)))))
(aux l (reverse l) (length l)))
Note that the parameter n starts from (length l) and is decreased by 2 at each recursion: this allows to manage both the cases of a list with an even or odd number of elements. reverse is the primitive function that reverses a list, but if you cannot use this primitive function you can implement it with a recursive algorithm in the following way:
(define (reverse l)
(define (aux first-list second-list)
(if (null? first-list)
second-list
(aux (cdr first-list) (cons (car first-list) second-list))))
(aux l '()))

how to delete third element in a list using scheme

This is what I want:
(delete-third1 '(3 7 5)) ==> (3 7)
(delete-third1 '(a b c d)) ==> (a b d)
so I did something like:
(define (delete-third1 LS ) (list(cdr LS)))
which returns
(delete-third1 '(3 7 5))
((7 5))
when it should be (3 7). What am I doing wrong?
Think about what cdr is doing. cdr says that "given a list, chop off the first value and return the rest of the list". So it's removing only the first value, then returning you the rest of that list (which is exactly what you are seeing). Since it returns a list, you don't need a list (cdr LS) there either.
What you want is something like this:
(define (delete-n l n)
(if (= n 0)
(cdr l)
(append (list (car l)) (delete-n (cdr l) (- n 1)))))
(define (delete-third l)
(delete-n l 2))
So how does this work? delete-n will delete the nth element of a list by keeping a running count of what element we are up to. If we're not up to the nth element, then add that element to the list. If we are, then skip that element and add the rest of the elements to our list.
Then we simply define delete-third as delete-n where it removes the 3rd element (which is element 2 when we start counting at 0).
The simplest way would be: cons the first element, the second element and the rest of the list starting from the fourth position. Because this looks like homework I'll only give you the general idea, so you can fill-in the blanks:
(define (delete-third1 lst)
(cons <???> ; first element of the list
(cons <???> ; second element of the list
<???>))) ; rest of the list starting from the fourth element
The above assumes that the list has at least three elements. If that's not always the case, validate first the size of the list and return an appropriate value for that case.
A couple more of hints: in Racket there's a direct procedure for accessing the first element of a list. And another for accessing the second element. Finally, you can always use a sequence of cdrs to reach the rest of the rest of the ... list (but even that can be written more compactly)
From a practical standpoint, and if this weren't a homework, you could implement this functionality easily in terms of other existing procedures, and even make it general enough to remove elements at any given position. For example, for removing the third element (and again assuming there are enough elements in the list):
(append (take lst 2) (drop lst 3))
Or as a general procedure for removing an element from a given 0-based index:
(define (remove-ref lst idx)
(append (take lst idx) (drop lst (add1 idx))))
Here's how we would remove the third element:
(remove-ref '(3 7 5) 2)
=> '(3 7)
This works:
(define (delete-third! l)
(unless (or (null? l)
(null? (cdr l))
(null? (cddr l)))
(set-cdr! (cdr l) (cdddr l)))
l)
if you want a version that does not modify the list:
(define (delete-third l)
(if (not (or (null? l)
(null? (cdr l))
(null? (cddr l))))
(cons (car l) (cons (cadr l) (cdddr l)))
l))
and if you want to do it for any nth element:
(define (list-take list k)
(assert (not (negative? k)))
(let taking ((l list) (n k) (r '()))
(if (or (zero? n) (null? l))
(reverse r)
(taking (cdr l) (- n 1) (cons (car l) r)))))
(define (delete-nth l n)
(assert (positive? n))
(append (list-take l (- n 1))
(if (> n (length l))
'()
(list-tail l n))))
(define (nth-deleter n)
(lambda (l) (delete-nth l n)))
(define delete-3rd (nth-deleter 3))

Scheme looping through list

I am trying to write some code that will loop through a list and add like terms. I'm trying to cons the cdr of the input list to a null list and then just compare the car of the list to the car of the new list and traverse down the list but my code just isn't working. What am I doing wrong here?
(define loop-add
(lambda (l temp outputList)
(if (or (equal? (cdr l) '()) (equal? (pair? (car l)) #f))
outputList
(if (equal? l '())
outputList
(let ((temp (cdr l)))
(if (equal? temp '())
(loop-add (cdr l) outputList)
(if (equal? (cdr (car l)) (cdr (car temp)))
(loop-add l (cdr temp) (cons (append (cdr (car l)) (cdr (car (cdr l)))) outputList))
(loop-add l temp outputList))))))))
but the problem now is at the end line its just going to be an infinite loop. I need a way to recur with the input list but with temp being the cdr of the previous temp list.
Start by writing a procedure that can transform your input list into a new list of the unique terms in the original list, so
(get-unique-terms '((2 1) (3 4) (5 3) (2 4)))
(1 4 3) ; or something like that
Call this new list TERMS. Now for each element in TERMS you can search the original list for matching elements, and get a sum of the coefficients:
(define (collect-like-terms l)
(let ((terms (get-unique-terms l)))
;; For each element of TERMS,
;; Find all elements of L which have a matching term,
;; Sum the coefficients of those elements,
;; Make a record of the sum and the term a la L.
;; Collect the results into a list and return.
Here's a simple solution in Racket:
(define (loop-add l)
(define table
(for/fold ([h (hash)]) ([i l])
(dict-update h (cadr i) (lambda (v) (+ v (car i))) 0)))
(dict-map table (lambda (key val) (list val key))))
(loop-add '((2 1) (3 4) (5 3) (2 4)))

Resources