Hi i'm trying to define a function which should make a set from the parts of that set.
Should be defined like: P(A) = P(A-{x}) U { {x} U B} for all B that belongs to P(A-{X}) where X belongs to A.
A test would be:
(parts '(a b c))
=> ((a b c) (a b) (a c) (a) (b c) (b) (c)())
I've been trying with this one:
(define (mapc f x l)
(if (null? l)
l
(cons (f x (car l)) (mapc f x (cdr l)))))
Maybe something like this? (untested)
(define (power-set A)
(cond
[(null? A) '()] ; the power set of an empty set it empty
[else (append (map (lambda (S) (cons x S)) ; sets with x
(power-set (cdr A)))
(power-set (cdr A)) ; sets without x
]))
This is essentially 'combinations' function (https://docs.racket-lang.org/reference/pairs.html?q=combinations#%28def._%28%28lib._racket%2Flist..rkt%29._combinations%29%29).
Following short code in Racket (a Scheme derivative) gets all combinations or parts:
(define (myCombinations L)
(define ol (list L)) ; Define outlist and add full list as one combination;
(let loop ((L L)) ; Recursive loop where elements are removed one by one..
(for ((i L)) ; ..to create progressively smaller combinations;
(define K (remove i L))
(set! ol (cons K ol)) ; Add new combination to outlist;
(loop K)))
(remove-duplicates ol))
Testing:
(myCombinations '(a b c))
Output:
'(() (a) (b) (a b) (c) (a c) (b c) (a b c))
Related
I am trying to reverse a general list using Scheme. How can I reverse a complex list?
I can make a single list like (A B C D) works using my function, but for some complex list inside another list like (F ((E D) C B) A), the result is just (A ((E D) C B) F). How can I improve it?
(define (reverse lst)
(if (null? lst)
lst
(append (reverse (cdr lst)) (list (car lst)))))
Any comments will be much appreciated!
Here is another way that uses a default parameter (r null) instead of the expensive append operation -
(define (reverse-rec a (r null))
(if (null? a)
r
(reverse-rec (cdr a)
(cons (if (list? (car a))
(reverse-rec (car a))
(car a))
r))))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
Using a higher-order procedure foldl allows us to encode the same thing without the extra parameter -
(define (reverse-rec a)
(foldl (lambda (x r)
(cons (if (list? x) (reverse-rec x) x)
r))
null
a))
(reverse-rec '(F ((E D) C B) A))
; '(A (B C (D E)) F)
There are several ways of obtaining the expected result. One is to call reverse recursively also on the car of the list that we are reversing, of course taking care of the cases in which we must terminate the recursion:
(define (reverse x)
(cond ((null? x) '())
((not (list? x)) x)
(else (append (reverse (cdr x)) (list (reverse (car x)))))))
(reverse '(F ((E D) C B) A))
'(A (B C (D E)) F)
(A ((E D) C B) F) is the correct result, if your goal is to reverse the input list. There were three elements in the input list, and now the same three elements are present, in reverse order. Since it is correct, I don't suggest you improve its behavior!
If you have some other goal in mind, some sort of deep reversal, you would do well to specify more clearly what result you want, and perhaps a solution will be easier to find then.
As the title said, I'm trying to write a function that takes a list, a variable, and an element, then replaces all instances of the variable in the list with that element.
For example:
(substitute '(C or (D or D)) 'D #f) would return
'(C or (#f or #f))
Right now what I've got is:
(define (substitute lst rep new)
(cond ((or (null? lst))
lst)
((eq? (car lst) rep)
(cons new (substitute (cdr lst) rep new)))
(else
(cons (car lst) (substitute (cdr lst) rep new)))))
Which doesn't check nested lists like my example, though it works fine when they aren't a part of the input.
And I'm having trouble with where to place recursion in order to do so - or would it be easier to flatten it all and then rebuild it after everything's been replaced in some way?
Here's another solution using pattern matching via match -
(define (sub l rep new)
(match l
((list (list a ...) b ...) ; nested list
(cons (sub a rep new)
(sub b rep new)))
((list a b ...) ; flat list
(cons (if (eq? a rep) new a)
(sub b rep new)))
(_ ; otherwise
null)))
It works like this -
(sub '(a b c a b c a b c) 'a 'z)
;; '(z b c z b c z b c)
(sub '(a b c (a b c (a b c))) 'a 'z)
;; '(z b c (z b c (z b c)))
(sub '() 'a 'z)
; '()
At first sight, your question looks similar to How to replace an item by another in a list in DrScheme when given paramters are two items and a list?. From my understanding, your question is slightly different because you also want to replace occurrences within nested lists.
In order to deal with nested lists, you must add a clause to check for the existence of a nested list, and replace all occurrences in that nested list by recursing down the nested list:
(define (subst l rep new)
(cond ((null? l)
'())
((list? (car l)) ; Check if it is a nested list.
(cons (subst (car l) rep new) ; Replace occurrences in the nested list.
(subst (cdr l) rep new))) ; Replace occurrences in the rest of the list.
((eq? (car l) rep)
(cons new
(subst (cdr l) rep new)))
(else
(cons (car l)
(subst (cdr l) rep new)))))
Example use (borrowed from the answer given by user633183):
(subst '(a b c a b c a b c) 'a 'z)
;; '(z b c z b c z b c)
(subst '(a b c (a b c (a b c))) 'a 'z)
;; '(z b c (z b c (z b c)))
(subst '() 'a 'z)
; '()
This can be done using map and recursion:
(define (subst lst rep new)
(map (lambda (x)
(if (list? x)
(subst x rep new)
(if (eq? rep x) new x))) lst))
the output:
(subst '(a b c (a b c (a b c))) 'a 'z)
; '(z b c (z b c (z b c)))
I have created a function that takes a list as input and returns either a list or a atom. I want to apply this function to a deep list, starting with the inner lists, then finish once the function has been run on the outer list.
Can somebody give me some direction on this?
A sample input would be (a b (c (d e))) z) the function should compute on (d e) first with a result of say f. then the function should compute on (c f) with a result of say g then similarly on (a b g z) to produce an output of h.
An example function could be:
(define sum
(lambda (l)
(if (not (pair? l))
0
(+ (car l) (sum (cdr l))))))
Where input would be (1 2 (3 4) 5) > 15
Assuming your example transformation, expressed as a Scheme procedure:
(define (transform lst)
(case lst
(((d e)) 'f)
(((c f)) 'g)
(((a b g z)) 'h)
(else (error (~a "wot? " lst)))))
then what you are looking for seems to be
(define (f lst)
(transform
(map (lambda (e)
(if (list? e) (f e) e))
lst)))
Testing:
> (f '(a b (c (d e)) z))
'h
Here is an example:
(define product
(lambda (l)
(cond
[(number? l) l]
[(pair? l) (* (product (car l)) (product (cdr l)))]
[else 1])))
> (product '(1 2 (3 4) 5))
120
The program is suppose to pick out every third atom in a list.
Notice that the last atom 'p' should be picked up, but its not.
Any suggestions as to why the last atom is not being selected.
(define (every3rd lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (car lst)
(every3rd (cdr(cdr(cdr lst)))))))
(every3rd '(a b c d e f g h i j k l m n o p))
Value 1: (a d g j m)
Thanks
You're missing a couple of base cases:
(define (every3rd lst)
(cond ((or (null? lst) (null? (cdr lst))) lst)
((null? (cdr (cdr lst))) (list (car lst)))
(else (cons (car lst)
(every3rd (cdr (cdr (cdr lst))))))))
See how the following cases should be handled:
(every3rd '())
=> '()
(every3rd '(a))
=> '(a)
(every3rd '(a b))
=> '(a)
(every3rd '(a b c))
=> '(a)
(every3rd '(a b c d))
=> '(a d)
(every3rd '(a b c d e f g h i j k l m n o p))
=> '(a d g j m p)
Fixing your code (covering the base cases)
It's worth noting that Scheme defines a number of c[ad]+r functions, so you can use (cdddr list) instead of (cdr (cdr (cdr list))):
(cdddr '(a b c d e f g h i))
;=> (d e f g h i)
Your code, as others have already pointed out, has the problem that it doesn't consider all of the base cases. As I see it, you have two base cases, and the second has two sub-cases:
if the list is empty, there are no elements to take at all, so you can only return the empty list.
if the list is non-empty, then there's at least one element to take, and you need to take it. However, when you recurse, there are two possibilies:
there are enough elements (three or more) and you can take the cdddr of the list; or
there are not enough elements, and the element that you took should be the last.
If you assume that <???> can somehow handle both of the subcases, then you can have this general structure:
(define (every3rd list)
(if (null? list)
'()
(cons (car list) <???>)))
Since you already know how to handle the empty list case, I think that a useful approach here is to blur the distinction between the two subcases, and simply say: "recurse on x where x is the cdddr of the list if it has one, and the empty list if it doesn't." It's easy enough to write a function maybe-cdddr that returns "the cdddr of a list if it has one, and the empty list if it doesn't":
(define (maybe-cdddr list)
(if (or (null? list)
(null? (cdr list))
(null? (cddr list)))
'()
(cdddr list)))
> (maybe-cdddr '(a b c d))
(d)
> (maybe-cdddr '(a b c))
()
> (maybe-cdddr '(a b))
()
> (maybe-cdddr '(a))
()
> (maybe-cdddr '())
()
Now you can combine these to get:
(define (every3rd list)
(if (null? list)
'()
(cons (car list) (every3rd (maybe-cdddr list)))))
> (every3rd '(a b c d e f g h i j k l m n o p))
(a d g j m)
A more modular approach
It's often easier to solve the more general problem first. In this case, that's taking each nth element from a list:
(define (take-each-nth list n)
;; Iterate down the list, accumulating elements
;; anytime that i=0. In general, each
;; step decrements i by 1, but when i=0, i
;; is reset to n-1.
(let recur ((list list) (i 0))
(cond ((null? list) '())
((zero? i) (cons (car list) (recur (cdr list) (- n 1))))
(else (recur (cdr list) (- i 1))))))
> (take-each-nth '(a b c d e f g h i j k l m n o p) 2)
(a c e g i k m o)
> (take-each-nth '(a b c d e f g h i j k l m n o p) 5)
(a f k p)
Once you've done that, it's easy to define the more particular case:
(define (every3rd list)
(take-each-nth list 3))
> (every3rd '(a b c d e f g h i j k l m n o p))
(a d g j m)
This has the advantage that you can now more easily improve the general case and maintain the same interface every3rd without having to make any changes. For instance, the implementation of take-each-nth uses some stack space in the recursive, but non-tail call in the second case. By using an accumulator, we can built the result list in reverse order, and return it when we reach the end of the list:
(define (take-each-nth list n)
;; This loop is like the one above, but uses an accumulator
;; to make all the recursive calls in tail position. When
;; i=0, a new element is added to results, and i is reset to
;; n-1. If i≠0, then i is decremented and nothing is added
;; to the results. When the list is finally empty, the
;; results are returned in reverse order.
(let recur ((list list) (i 0) (results '()))
(cond ((null? list) (reverse results))
((zero? i) (recur (cdr list) (- n 1) (cons (car list) results)))
(else (recur (cdr list) (- i 1) results)))))
It is because (null? '()) is true. you can debug what's happening with following code
(define (every3rd lst)
(if (begin
(display lst)
(newline)
(or (null? lst)
(null? (cdr lst))))
'()
(cons (car lst)
(every3rd (cdr(cdr(cdr lst)))))))
(every3rd '(a b c d e f g h i j k l m n o p))
(newline)
(display (cdr '(p)))
(newline)
(display (null? '()))
(newline)
(display (null? (cdr '(p))))
(newline)
this gives following result.
(a b c d e f g h i j k l m n o p)
(d e f g h i j k l m n o p)
(g h i j k l m n o p)
(j k l m n o p)
(m n o p)
(p)
()
#t
#t
A little help, guys.
How do you sort a list according to a certain pattern
An example would be sorting a list of R,W,B where R comes first then W then B.
Something like (sortf '(W R W B R W B B)) to (R R W W W B B B)
Any answer is greatly appreciated.
This is a functional version of the Dutch national flag problem. Here are my two cents - using the sort procedure with O(n log n) complexity:
(define sortf
(let ((map '#hash((R . 0) (W . 1) (B . 2))))
(lambda (lst)
(sort lst
(lambda (x y) (<= (hash-ref map x) (hash-ref map y)))))))
Using filter with O(4n) complexity:
(define (sortf lst)
(append (filter (lambda (x) (eq? x 'R)) lst)
(filter (lambda (x) (eq? x 'W)) lst)
(filter (lambda (x) (eq? x 'B)) lst)))
Using partition with O(3n) complexity::
(define (sortf lst)
(let-values (((reds others)
(partition (lambda (x) (eq? x 'R)) lst)))
(let-values (((whites blues)
(partition (lambda (x) (eq? x 'W)) others)))
(append reds whites blues))))
The above solutions are written in a functional programming style, creating a new list with the answer. An optimal O(n), single-pass imperative solution can be constructed if we represent the input as a vector, which allows referencing elements by index. In fact, this is how the original formulation of the problem was intended to be solved:
(define (swap! vec i j)
(let ((tmp (vector-ref vec i)))
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j tmp)))
(define (sortf vec)
(let loop ([i 0]
[p 0]
[k (sub1 (vector-length vec))])
(cond [(> i k) vec]
[(eq? (vector-ref vec i) 'R)
(swap! vec i p)
(loop (add1 i) (add1 p) k)]
[(eq? (vector-ref vec i) 'B)
(swap! vec i k)
(loop i p (sub1 k))]
[else (loop (add1 i) p k)])))
Be aware that the previous solution mutates the input vector in-place. It's quite elegant, and works as expected:
(sortf (vector 'W 'R 'W 'B 'R 'W 'B 'B 'R))
=> '#(R R R W W W B B B)
This is a solution without using sort or higher order functions. (I.e. no fun at all)
This doesn't really sort but it solves your problem without using sort. named let and case are the most exotic forms in this solution.
I wouldn't have done it like this unless it's required not to use sort. I think lepple's answer is both elegant and easy to understand.
This solution is O(n) so it's probably faster than the others with very large number of balls.
#!r6rs
(import (rnrs base))
(define (sort-flag lst)
;; count iterates over lst and counts Rs, Ws, and Bs
(let count ((lst lst) (rs 0) (ws 0) (bs 0))
(if (null? lst)
;; When counting is done build makes a list of
;; Rs, Ws, and Bs using the frequency of the elements
;; The building is done in reverse making the loop a tail call
(let build ((symbols '(B W R))
(cnts (list bs ws rs))
(tail '()))
(if (null? symbols)
tail ;; result is done
(let ((element (car symbols)))
(let build-element ((cnt (car cnts))
(tail tail))
(if (= cnt 0)
(build (cdr symbols)
(cdr cnts)
tail)
(build-element (- cnt 1)
(cons element tail)))))))
(case (car lst)
((R) (count (cdr lst) (+ 1 rs) ws bs))
((W) (count (cdr lst) rs (+ 1 ws) bs))
((B) (count (cdr lst) rs ws (+ 1 bs)))))))
Make a lookup eg
(define sort-lookup '((R . 1)(W . 2)(B . 3)))
(define (sort-proc a b)
(< (cdr (assq a sort-lookup))
(cdr (assq b sort-lookup))))
(list-sort sort-proc '(W R W B R W B B))
Runnable R6RS (IronScheme) solution here: http://eval.ironscheme.net/?id=110
You just use the built-in sort or the sort you already have and use a custom predicate.
(define (follow-order lst)
(lambda (x y)
(let loop ((inner lst))
(cond ((null? inner) #f)
((equal? x (car inner)) #t)
((equal? y (car inner)) #f)
(else (loop (cdr inner)))))))
(sort '(W R W B R W B) (follow-order '(R W B)))
;Value 50: (r r w w w b b)