While reading a certain book about functional programming and scheme (and Racket) in particular, I happened upon an exercise which states the following:
`
"Write a function 'rp' which takes, as an argument, a list 'lp' of pairs '(a . n)',
where 'a' is either a symbol or a number and 'n' is a natural number,
and which returns the list of all the lists, whose elements are the 'a's defined by
the pairs in 'lp', each one appearing exactly 'n' times."
For some reason this is really cryptic, but what it basically asks for is the list of all distinct permutations of a list containing n times the number/symbol a.
E.g : [[(rp '((a . 2) (b . 1))]] = '((a a b) (a b a) (b a a))
Generating the permutations, ignoring the distinct part, is fairly easy since there is a, relatively, straight forward recursive definition:
The list of permutations of an empty list, is a list containing an empty list.
The list of permutations of 3 elements a b c is a list containing the lists of all permutations of
a and b where, for each one, c has been inserted in all possible positions.
Which I translated in the following racket code:
(define permut
(lambda(ls)
(if(null? ls) '(())
(apply append
(map (lambda(l) (insert_perm (car ls) l))
(permut (cdr ls)))))))
(define insert_perm
(lambda(x ls)
(if(null? ls) (list (list x))
(cons (cons x ls)
(map (lambda(l) (cons (car ls) l))
(insert_perm x (cdr ls)))))))
This works, but does not return distinct permutations. Taking into account the duplicates seems to me much more complicated. Is there a simple modification of the simple permutation case that I cannot see? Is the solution completely different? Any help would be appreciated.
The change is pretty simple. When you have no duplicate, the following works:
The list of permutations of 3 elements a b c is a list containing the lists of all permutations of a and b where, for each one, c has been inserted in all possible positions.
With duplicates, the above doesn't work anymore. A permutation of 2 elements a = "a", b = "b" is:
"a" "b"
"b" "a"
Now, consider c = "a". If you insert it in all possible positions, then you would get:
c "a" "b" = "a" "a" "b"
"a" c "b" = "a" "a" "b"
"a" "b" c = "a" "b" "a"
c "b" "a" = "a" "b" "a"
"b" c "a" = "b" "a" "a"
"b" "a" c = "b" "a" "a"
So instead, make a restriction that when you are inserting, you will only do it before the first occurrence of the same element that exists in the list that you are inserting to:
c "a" "b" = "a" "a" "b" -- this is OK. c comes before the first occurrence of "a"
"a" c "b" = "a" "a" "b" -- this is not OK. c comes after the first occurrence of "a"
"a" "b" c = "a" "b" "a" -- this is not OK
c "b" "a" = "a" "b" "a" -- this is OK
"b" c "a" = "b" "a" "a" -- this is OK
"b" "a" c = "b" "a" "a" -- this is not OK
This gives:
"a" "a" "b"
"a" "b" "a"
"b" "a" "a"
as desired.
Moreover, you can see that this algorithm is a generalization of the algorithm that doesn't work with duplicates. When there's no duplicate, there's no "first occurrence", so you are allowed to insert everywhere.
By the way, here's how I would format your code in Racket/Scheme style:
(define (permut ls)
(if (null? ls)
'(())
(apply append
(map (lambda (l) (insert-perm (car ls) l))
(permut (cdr ls))))))
(define (insert-perm x ls)
(if (null? ls)
(list (list x))
(cons (cons x ls)
(map (lambda (l) (cons (car ls) l))
(insert-perm x (cdr ls))))))
After some thought I came up with my own recursive definition that seems to work. This solution is an alternative to the one proposed in the answer by #Sorawee Porncharoenwase and can be defined as follows:
The distinct permutations of a list containing only one kind of element
(e.g '(a a a)) is the list itself.
if (f l) gives the list of distinct permutations (lists) of l,
where l contains x times each distinct element el_i, 0<=i<=n
and if ll is the list l plus one element el_i, 0<=i<=n+1 (distinct or not)
Then the distinct permutations of ll is a list containing
all the following possible concatenations:
el_i + (f l/{el_i}), where l/{el_i} is the list l excluding its ith distinct element.
To illustrate this definition, consider the following examples:
The list of all distinct permutations of (a b c) is the list containing
a + {(b c) (c b)} = (a b c) (a c b)
b + {(a c) (c a)} = (b a c) (b c a)
c + {(a b) (b a)} = (c a b) (c b a)
The list of all distinct permutations of (a a b) is the list containing:
a + {(a b) (b a)} = (a a b) (a b a)
b + {(a a)} = (b a a)
etc...
Similarly, the list of all distinct permutations of (a a b c) is:
a + {(a b c) ...} = (a a b c) (a a c b) (a b a c) (a b c a) (a c a b) (a c b a)
b + {(a a c) ...} = (a a c) (a c a) (c a a)
c + {(a a b) ...} = (a a b) (a b a) (b a a)
This leads to the following implementation:
(define unique_perm
(lambda(ls)
(if (= (length ls) 1)
(list (build-list (cdar ls) (const (caar ls))))
(apply append (map (lambda(p) (map (lambda(l) (cons (car p) l)) (unique_perm (update_ls ls p)))) ls)))))
(define update_ls
(lambda(ls p)
(cond ((null? ls) ls)
((equal? (caar ls) (car p))
(if (= (- (cdar ls) 1) 0)
(cdr ls)
(cons (cons (caar ls) (- (cdar ls) 1)) (cdr ls))))
(else (cons (car ls) (update_ls (cdr ls) p))))))
Example:
> (unique_perm_2 '((a . 3) (b . 2)))
'((a a a b b) (a a b a b) (a a b b a) (a b a a b) (a b a b a) (a b b a a) (b a a a b) (b a a b a) (b a b a a) (b b a a a))
Related
I would like to return the nth cdr of a list. For example, I say
(nth-cdr 3 '(a b c d e)) and i would get (c d e) as output. I am not sure where I am going wrong with my code.
My approach is this. I will check if (= num 0) if it is, I will return the list. If not, I will recursively call nth-cdr and subtract 1 from num and cdr list
The code is this
(define arbitrary-cdr (lambda (num list)
(if (= num 0)
'()
(arbitrary-cdr (- num 1) (cdr list))
)))
However, I get this error when i try doing (arbitrary-cdr 3 ‘(a b c d e))
‘: undefined;
cannot reference an identifier before its definition
I am not sure what this means. When I say that, it means I hit the base case and would just like to return the list. I think my logic is correct though.
The first code that you posted was:
(define arbitrary-cdr
(lambda (num list)
(if (= num 0)
(list)
(arbitrary-cdr (- num 1) (cdr list)))))
The error that you received was:
scratch.rkt> (arbitrary-cdr 3 '(a b d c e))
; application: not a procedure;
; expected a procedure that can be applied to arguments
; given: '(c e)
The problem was that you used list as an argument to the arbitrary-cdr procedure; since Racket is a lisp-1, procedures do not have their own namespace, so this redefined list. With (list), and with list redefined the code attempted to call ((c e)), but (c e) is not a procedure.
This is a great example for why you should not use list or other built-in procedure identifiers as parameters in your own procedure definitions in Scheme or Racket. You can get away with this in Common Lisp, because Common Lisp is a lisp-2, i.e., has a separate namespace for functions.
With your updated code:
(define arbitrary-cdr
(lambda (num list)
(if (= num 0)
'()
(arbitrary-cdr (- num 1) (cdr list)))))
I don't get the error you report; maybe your code is not quite what you have posted. But, there is a mistake in the logic of your code. As it is, an empty list will always be returned:
scratch.rkt> (arbitrary-cdr 3 '(a b c d e f))
'()
The problem is that when the base case is reached you should return the input list, not an empty list. That is, given (arbitrary-cdr 0 '(a b c)), you want the result to be (a b c). This also means that your test case is wrong; (arbitrary-cdr 0 '(a b c d e)) --> '(a b c d e), and (arbitrary-cdr 3 '(a b c d e)) --> '(d e).
Here is your code rewritten, using xs instead of list to avoid the redefinition, and returning xs instead of an empty list when the base case is reached:
(define arbitrary-cdr
(lambda (num xs)
(if (= num 0)
xs
(arbitrary-cdr (- num 1) (cdr xs)))))
Sample interactions:
scratch.rkt> (arbitrary-cdr 0 '(a b c d e))
'(a b c d e)
scratch.rkt> (arbitrary-cdr 1 '(a b c d e))
'(b c d e)
scratch.rkt> (arbitrary-cdr 3 '(a b c d e))
'(d e)
I want to find all possible consecutive partitions of a lists:
(a b c d) => (((a) (b c d)) ((a b) (c d)) ((a b c) (d)) ((a) (b c) (d)) ((a b c d)) ((a) (b) (c) (d)))
What would be the easiest way to go about this? ideally without using counters.
Edit:
Here is an example of what I have been trying, but it doesn't quite work (it is supposed to give the answers in reverse, but that'd be ok):
(define split-list-help
(lambda (l h a)
(begin
(display a)
(if
(null? (cdr l))
(list (cons (cons (car l) a) h))
(let
[(a-nosplit (cons (car l) a))
(h-split (if (null? a)
(cons (list (car l)) h)
(cons (list (car l)) (cons a h))))]
(append (split-list-help (cdr l) h-split '())
(split-list-help (cdr l) h a-nosplit)))))))
(split-list-help '(a b c) '() '())
The idea is that we traverse the list item by item, at each step we can either split it or not, then we branch into two new iterations, one with splitting and one without splitting. This produces a result close to what I want but not quite.
The goal is to find a natural way of describing the problem using recursion.
In order to find the sublists of (a b c d) we can focus on the element a.
There are four different consecutive sublists containing a:
(a) (a b) (a b c) (a b c d)
In each case we need to find the sublists of the remaining elements.
All in all the result must be the collection of list that result from
combining (a) with (sublists '(b c d))
combining (a b) with (sublists '(c d))
combining (a b c) with (sublists '(d))
combining (a b c d) with (sublists ' ())
That is we have:
(sublists '(a b c d)) = (append (combine '(a) (sublists '(b c d)))
(combine '(a b) (sublists '(c d)))
(combine '(a b c) (sublists '(d)))
(combine '(a b c d) (sublists '())))
We note that we have described the sublists of a list four elements
using a recursive call of sublists of only three elements.
The base case (sublists '()) must return the empty list '().
The only remaining question is what combine does.
Let's examine the relation between the input and ouput in the case
(combine '(a) (sublists '(b c d)))
The sublists of '(b c d) are:
( ((b) (c) (d))
((b) (c d) )
((b c) (d) )
((b c d) ) )
So (combine '(a) (sublists '(b c d))) must return
( ((a) (b) (c) (d))
((a) (b) (c d) )
((a) (b c) (d) )
((a) (b c d) ) )
The operation that preprends an element (the list '(a)) in front
of a list is cons, so we can use map and cons in concert:
(define (combine x xss)
(map (lambda (xs) (cons x xs)) ; function that prepends x to a list xs
xss))
Now we have all pieces of the puzzle. I'll leave the final definition
of sublists to you.
Since you mentioned miniKanren, here's a Prolog solution for this problem:
splits(L, LS):- % conde ...
( L = [] % L is empty list:
-> LS = []
; % OR
A = [_ | _], % A is non-empty,
append(A, B, L), % for each A, B such that A + B = L,
splits( B, BS), % for every splits BS of B,
LS = [ A | BS] % prepend A to BS to get the splits of L
).
%%% in SWI Prolog:
?- splits([1,2,3,4], R).
R = [[1], [2], [3], [4]] ;
R = [[1], [2], [3, 4]] ;
R = [[1], [2, 3], [4]] ;
R = [[1], [2, 3, 4]] ;
R = [[1, 2], [3], [4]] ;
R = [[1, 2], [3, 4]] ;
R = [[1, 2, 3], [4]] ;
R = [[1, 2, 3, 4]] ;
false.
Translated into miniKanren this would define splitso as a conde with an appendo and a recursive call to splitso:
#lang racket
(require minikanren)
(define (splitso L LS)
(conde
[(== L '()) (== LS '())]
[(fresh (A B BS _H _T)
(== A `(,_H . ,_T))
(appendo A B L)
(== LS `(,A . ,BS))
(splitso B BS))]))
;;;
> (run* (R) (splitso '(1 2 3 4) R))
'(((1 2 3 4))
((1) (2 3 4))
((1 2) (3 4))
((1) (2) (3 4))
((1 2 3) (4))
((1) (2 3) (4))
((1 2) (3) (4))
((1) (2) (3) (4)))
I copied appendo from here.
The order of solutions in miniKanren does not follow the order of goals in the predicate definition (as it does in Prolog), because miniKanren interleaves the results produced by sub-goals in order to achieve what it calls "fair scheduling".
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))
I am trying to write a program that will check the structural equivalence of some list input, whether it includes just atoms or nested sub lists.
I am having trouble with using AND, I don't even know if its possible and I cant seem to understand documentation I am looking at.
My code:
(define (structEqual a b)
(cond
(((null? car a) AND (null? car b)) (structEqual (cdr a) (cdr b)))
(((null? car a) OR (null? car b)) #f)
(((pair? car a) AND (pair? car b))
(if (= (length car a) (length car b))
(structEqual (cdr a) (cdr b))
#f))
(((pair? car a) OR (pair? car b)) #f)
(else (structEqual (cdr a) (cdr b)))))
The idea is (i think): (when I say both, i mean the current cdr of a or b)
Check if both a and b are null, then they are structurally equal
Check if only either a or b is null, then they are not structually equal
Check if both of them are pairs
If they are both pairs, then see if the length of the pair is equal, if not they are not structurally equal.
If they are not both pairs, then if one of them is a pair and the other isnt then they are not structurally equivalent.
If neither of them are pairs, then they both must be atoms, so they are structurally equivalent.
So as you can see I am trying to recursively do this by checking the equivalence of the car of a or b, and then either returning #f if they fail or moving on to the cdr of each if they are equivalent at each step.
Any help?
There is no infix operators in Scheme (or any LISP) only prefix. Every time the operator comes first. (or x (and y z q) (and y w e)) where each letter can be a complex expression. Everything that is not #f is a true value. Thus (if 4 'a 'b) evaluates to a because 4 is a true value. car needs its parentheses.
When evaluating another predicate in cond you should make use of the fact that everything up to that has been false. eg.
(define (structure-equal? a b)
(cond
((null? a) (null? b)) ; if a is null the result is if b is null
((not (pair? a)) (not (pair? b))) ; if a is not pair the result is if b is not also
((pair? b) (and (structure-equal? (car a) (car b)) ; if b is pair (both a and b is pair then) both
(structure-equal? (cdr a) (cdr b)))) ; car and cdr needs to be structurally equal
(else #f))) ; one pair the other not makes it #f
(structure-equal '(a (b (c d e) f) g . h) '(h (g (f e d) c) b . a)) ; ==> #t
How would i go about making a partition function that would take a number and a list to partition the list into smaller lists of lists whose size is given by the number
so that
Partition 3 '(a b c d e f g h) -> '((a b c) (d e f) (g h)) and etc. using take and drop?
I'll give you some hints so you can find the answer by yourself. Fill-in the blanks:
(define (partition n lst)
(cond (<???> ; if the list is empty
<???>) ; then return the empty list
((< <???> n) ; if the lists' length is less than n
<???>) ; return a list with lst as its only element
(else ; otherwise
(cons ; cons a list with the result of
(<???> lst n) ; grabbing the first n elements of lst with
(<???> n ; the result of advancing the recursion and
(<???> lst n)))))) ; removing the first n elements of lst
Clearly, you'll have to use take and drop somewhere in the solution, as requested in the problem description. Test your solution like this:
(partition 3 '(a b c d e f g h))
=> '((a b c) (d e f) (g h))
(partition 3 '(a b c d e f g h i))
=>'((a b c) (d e f) (g h i))