I'm trying to get the common elements of two lists.
I've tried both the available intersection function and one I implemented myself, both giving the same weird result when trying to test them on lists like (a a ... a) and (a b c d ... z).
Whenever the first list contains only the same element several times and the second list begins with that element the result is the first list.
For example: (intersection '(2 2 2 2) '(2 2 2 3)) returns (2 2 2 2)
The intersection I implemented:
(defun presentp (a l)
(cond ((null l) nil)
((and (atom (car l)) (equal a (car l))) t)
((not (atom (car l))) (presentp a (car l)))
(t (presentp a (cdr l)))))
(defun intersectionp (a b)
(cond ((not (and a b)) nil)
((presentp (car a) b) (append (list (car a)) (intersection (cdr a) b)))
(t (intersection (cdr a) b))))
How can I get a good result on lists of that type? For example I want (2 2 2) from (intersection '(2 2 2 2) '(2 2 2 3)).
You need to remove matches from the b list.. When you found an 2 in (2 2 2 3) you should continue with (2 2 3) as b.
Also.. (append (list x) result-list) is the same as (cons x result-list) just with the same or fewer CPU cylces.
(defun intersection (a b)
(cond ((not (and a b)) nil)
((presentp (car a) b)
(cons (car a)
(intersection (cdr a)
(remove (car a) b :count 1))))
(t (intersection (cdr a) b))))
There's already an accepted answer, but I want to point out that the answer the implementation provides, where
(cl:intersection '(2 2 2 2) '(2 2 2 3))
;=> (2 2 2 2)
is correct. It's important to recognize that the intersection, nintersection, etc., are intended for use with lists that are being treated as sets. Conceptually, a set has no duplicate elements (for that you'd need a multiset), so the lists (2), (2 2), (2 2 2), etc., all represent the same set, {2}.
14.1.2.2 Lists as Sets
Lists are sometimes viewed as sets by considering their elements
unordered and by assuming there is no duplication of elements.
adjoin nset-difference set-difference union
intersection nset-exclusive-or set-exclusive-or
nintersection nunion subsetp
Figure 14-5. Some defined names related to sets.
Now, that bit about "assuming there is no duplication of elements" actually means that you probably shouldn't be using the set functions with a list like (2 2 2 2), since there's obvious duplication of elements. Even so, if you posit that lists like (2 2 2) and (2 2 2 2) represent the same set, you can see that intersection is actually giving you the correct set back. I think that the specification actually mandates that the result will have three or four elements. From the HyperSpec entry on intersection:
The intersection operation is described as follows. For all possible
ordered pairs consisting of one element from list-1 and one element
from list-2, :test or :test-not are used to determine whether they
satisfy the test. The first argument to the :test or :test-not
function is an element of list-1; the second argument is an element of
list-2. If :test or :test-not is not supplied, eql is used. It is an
error if :test and :test-not are supplied in the same function call. …
For every pair that satifies the test, exactly one of the two elements
of the pair will be put in the result. No element from either list
appears in the result that does not satisfy the test for an element
from the other list. If one of the lists contains duplicate elements,
there may be duplication in the result.
So, in the case of (2 2 2 2) and (2 2 2 3), there are 16 pairs to consider:
(2 2) (2 2) (2 2) (2 3) ; first element is first 2 from list-1, second elements are from list-2
(2 2) (2 2) (2 2) (2 3) ; first element is second 2 from list-1, second elements are from list-2
(2 2) (2 2) (2 2) (2 3) ; first element is third 2 from list-1, second elements are from list-2
(2 2) (2 2) (2 2) (2 3) ; first element is fourth 2 from list-1, second elements are from list-2
Since "For every pair that satifies the test, exactly one of the two elements of the pair will be put in the result," it seems to me that you're going to end up with between 3 and 4 2's in the result, because you've got 12 pairs that satisfy the test, and you need to cover each row and column of those 12 pairs. This hinges, I suppose, on the interpretation of "exactly one of the two elements of the pair will be put in the result". In general though, if you have, e.g., lists-as-sets (a1 a2) and (b1 b2 b3) then you have the pairs:
(a1 b1) (a1 b2) (a1 b3)
(a2 b1) (a2 b2) (a2 b3)
I think that the spec should be read as saying that each ai and bi will be included at most once, and that you never include a given ai and bi based on the particular pair (ai bi). So, if from row one you were to select (a1 b2) and include b2 in the result, then the remaining pairs that could contribute elements to the result are
(a1 b1) (a1 b3)
(a2 b1) (a2 b3)
if you had taken a1 from (a1 b2), then the remaining pairs would be
(a2 b1) (a2 b2) (a2 b3)
That is, when you include an element from one of the pairs, you've either removed a row or a column from the table of pairs that determine the possible results. In the first case, you could still add two more elements to the result, but in the second, there could be three.
In fact, in LispWorks, if you reverse the order of the arguments, you'll get the 3 element version:
CL-USER 5 > (intersection '(2 2 2 3) '(2 2 2 2))
(2 2 2)
There is no guarantee that the order of elements in the result will
reflect the ordering of the arguments in any particular way. The
result list may share cells with, or be eq to, either list-1 or list-2
if appropriate.
You didn't mention whether you're just getting an equivalent list back, or if you're actually getting list-1 back. In Lispworks, it seems that you're actually getting the same list back, although that's not required:
CL-USER 2 > (let ((l1 '(2 2 2 2))
(l2 '(2 2 2 3)))
(eq l1 (intersection l1 l2)))
T
Here is mine that works well. I used remove to remove duplicating symbols.
(defun my-intersection (x y)
(cond ((or (null x) (null y)) nil)
((find (first x) y) (cons (first x)
(my-intersection (remove (first x) x) y)))
(t (my-intersection (rest x) y))))
Related
I am trying to answer a scheme question, for a part of this question I have to make a list of lists:
(define (join a b (result '()))
(cons (list a b) result))
So I am taking in two characters, and placing them in a list, then I need to place each sublist into a list of lists, this function is being called recursively with two characters each time, so it is supposed to work like this:
join 1 4
=> ((1 4))
join 2 5
=> ((1 4) (2 5))
join 3 6
=> ((1 4) (2 5) (3 6))
However, I am getting ((3 6) (2 5) (1 4)), so the elements need to be reversed, I tried reversing my cons function to (cons result (list a b)) but then I get (((() 1 4) 2 5) 3 6), how can I get the list the right way around, or is there an easier way to do what I'm doing?
If you need to add elements at the end of a list use append; cons is for adding elements at the head. Try this:
(define (join a b (result '()))
(append result (list (list a b))))
Notice that append combines two lists, that's why we have to surround the new element inside its own list. Also, it's not a good idea to add elements at the end, using append is more expensive than using cons - if possible, rethink your algorithm to add elements at the head, and reverse the result at the end.
This can easily be done like this:
(define (group-by-2 lst)
(let loop ((lst lst) (rlst '()))
(if (or (null? lst) (null? (cdr lst)))
(rcons->cons rlst)
(loop (cdr lst)
(rcons (list (car lst)
(cadr lst))
rlst)))))
(group-by-2 '(1 2 3 4 5 6 7 8))
; ==> ((1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8))
Now rcons is like cons but it makes a reverse list. (rcons 1 (rcons 2 (rcons 3))) ; ==> {3 2 1} however it is not a list so you have to convert it to a list (rcons->list (rcons 1 (rcons 2 (rcons 3))) ; ==> (3 2 1)
The magic functions are really not that magical:
(define rcons cons)
(define rcons->cons reverse)
So in fact I didn't really have to make that abstraction, but hopefully I made my point. It doesn't matter how you organize the intermediate data structure in your programs so why not make the best for the job you are doing. For lists it's always best to iterate from beginning to end and make from end to beginning. Every insert O(1) per element and you do a O(n) reverse in the end. It beats doing append n times that would make it O(n²)
I have found the following piece of code that it makes permutation in Scheme. I mean if I enter like arguments '(1 2 3) it will give me:
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
The code is the following:
(define (remove x lst)
(cond
((null? lst) '())
((= x (car lst))(remove x (cdr lst)))
(else (cons (car lst) (remove x (cdr lst))))))
(define (permute lst)
(cond
((= (length lst) 1)(list lst))
(else (apply append(map(lambda (i) (map (lambda (j)(cons i j))
(permute (remove i lst))))lst)))))
The first function remove, it seems straightforward that only gets rid of the caracter denoted by x, even if its repeated or not, by comparing it with the beginning of the list and calling recursively with the rest of it.
The part that I quite do not get it, is the permute function. For what I know map appies a function to every element of an argument (in this case a list), and apply just applies one function one time completely to all the arguments. So what is exactly doing this line:
(apply append(map(lambda (i) (map (lambda (j)(cons i j))
(permute (remove i lst))))lst)))))
For me it seems that it just wants to create a pair with two elements: i and j, which they will become a list with the elements permuted (if we take the assumption that a list is just a bunch of concatenated pairs). But the part that calls again to permute and remove with i, what is that part doing? It is just removing the head of the list to generate subsets of the list having the head of the pair, element i, fixed until it runs out of elements?
Any help?
Thanks
Let's pick this apart, going from the inside out. Fix lst and apply the inner expression to one of its elements.
> (define lst '(1 2 3))
> (define i 1)
> (permute (remove i lst))
((2 3) (3 2))
Looks good: the inner expression removes an element and generates permutations of the remainder of the list, recursively. Now map the lambda over these permutations:
> (map (lambda (j) (cons i j)) (permute (remove i lst)))
((1 2 3) (1 3 2))
So the inner map produces all permutations that start with some i, which we've set to 1 here.
The outer map makes sure all permutations are generated by considering all elements of lst as the first element.
> (map (lambda (i) (map (lambda (j) (cons i j))
> (permute (remove i lst))))
> lst)
(((1 2 3) (1 3 2)) ((2 1 3) (2 3 1)) ((3 1 2) (3 2 1)))
But this generates lists with too much nesting. Applying append flattens a list of lists,
> (append '(1 2) '(3 4) '(5 6))
(1 2 3 4 5 6)
> (apply append '((1 2) (3 4) (5 6)))
(1 2 3 4 5 6)
so we get a flat list of permutations out.
I've always found it easier to understand the algorithm on a higher
level before diving into an implementation and trying to understand
what's happening there. So the question is: what are the permutations
of a list, and how would you find them?
The permutations of a single element list are evidently just the list
itself.
The permutations of (a b) are the set [(a b) (b a)].
The permutations of (a b c) are the set
[(a b c) (a c b) (b c a) (b a c) (c a b) (c b a)]
In general there are n! permutations of a list of length n - we have n
choices for the first element, and once we've picked that, (n-1) choices
for the second element, (n-2) for the third element, and so on. This
decrease in the degrees of freedom as we fix more and more of the first
elements of the list is very suggestive: maybe we can represent the
finding the permutations of a list of length n in terms of the
permutations of a list of length (n - 1), and so on until we reach the
permutations of a single-element list.
It turns out that the permutations of a list a precisely the set
[element prepended to the permutations of list \ element, for every
element in list].
Looking at the (a b c) case confirms that this is
true - we have a preceding (b c) and (c b), which are the
permutations of (b c), b preceding (a c) and (c a) and so on. This
operation of prepending the element to the sublist could be defined as
(define (prepend j)
(cons element j))
and the operation of doing it for all the
permutations of the sublist would then be (map prepend (permute
sublist)). Now, defining a new prepend function for each element is
maybe overkill - especially since they all have the same form. So a
better approach is just to use a lambda, which captures the value of
the element under consideration. The desired operation is
then (map (lambda (j) (cons element j)) (permute sublist)). Now, we
want to apply this operation to each element of the list, and the way to
do that is using another map, giving:
(map (lambda (element)
(lambda (j) (cons element j) (permute sublist)))
list)
Now, this looks good, but there is a problem: each stage of the recursion takes single
elements and turns them into a list. That's fine for lists of length 1,
but for longer lists it repeats for every recursive call, and we get
very deeply nested lists. What we really want to do is to put all
these lists on the same footing, which is exactly what the (apply append ...) takes care of. And that's almost all of that line. The only
thing missing is how the sublist is generated in the first place. But
that's easy as well - we'll just use remove, so that sublist = (remove element list). Putting everything together, and we have
(apply append (map (lambda (i)
(lambda (j) (cons i j))
(permute (remove i lst)))
lst))
The base case takes care of the length = 1 case, and all of the others can be found from there
(rearrange-this '(4 (4 2) 1) '(a b c d)) -> (d (d b) a)
So I need this to recurse into the sub-lists and rearrange those.
(define (rearrange-this list1 list2) ;Initial function
(rearrange-r list1 list2 (count list1) '() list1))
;list 1 holds numbers, list2 hold letters
(rearrange-this '(4 3 2 1) '( a b c d )) ;-> outputs (d c b a)
(rearrange-this '(2 3 4 1 3 2 1 4) '(a b c d)) ;-> outputs (b c d a c b a d)
You want to use higher order functions whenever possible. The most important ones for list operations are: map, fold, filter, and list-tabulate. Learning these will save so much time.
map is incredibly useful in this situation. I used it to write a deep-map function which delves into sublists and applies an operation to the objects within, although it will not work if you want to map lists to something else since deep-map will delve into those lists. You would have to wrap such lists in something to make the list? check fail.
After writing deep-map, I use it with list-ref to select the appropriate element from value-list and replace the number in arrangement.
(define (deep-map operator deep-list)
(map
(lambda (element)
(if (list? element)
(deep-map operator element)
(operator element)))
deep-list))
(define (rearrange-this arrangement value-list)
(deep-map
(lambda (element)
(list-ref value-list element))
arrangement))
Here is a quick test of the code. Note that unlike your code, the list positions start at 0. You could map the input arrangement list if you want to have input references starting at 1. I will leave that as an exercise to you.
> (rearrange-this '(3 2 (1 0)) '(a b c d))
;Value 16: (d c (b a))
I have just started using LispWorks and I am working on the 4x4 Queen problem. What I am trying to do is with the help of 4 for-loops state all the possible Queen-combinations, and then checking whether they are possible solutions or not. A possible state (1 3 4 2) for example means that in row 1 queen is in column 1, in row 2 queen is in column 3 and so on.
I think I am doing something wrong though because the compiler don't like my loops. The error I'm getting is something like: Loop keyword expected in...
Here is the code:
(loop for i in '(1 2 3 4)
nconc (loop for j in '(1 2 3 4)
nconc (loop for k in '(1 2 3 4)
nconc (loop for l in '(1 2 3 4)
(defvar first 0)
(defvar second 0)
(defvar third 0)
(defvar fourth 0)
(setq first (abs (- 1 i)))
(setq second (abs (- 2 j)))
(setq third (abs (- 3 k)))
(setq fourth (abs (- 4 l)))
(if (and (not (eq first second)) (not (eq first third)) (not (eq first fourth)) (not (eq second third))
(not (eq second fourth)) (not (eq first second)) (not (eq third fourth)))
(if (and (or (eq i j) (eq i k) (eq i l) (eq j k) (eq j l)) (or (eq k l)))
(print i j k l)))))))
Please help me out with the nested loops and feel free to comment on my code and possibly suggest better ways of solving this problem. Please keep it fairly basic, I am a complete beginner to LispWorks and I have only done some ADA 95 and Java before.
Thank you in advance
The reason you get the error message is that your code is lacking the keyword do after '(1 2 3 4) in the inner loop. As you are not collecting results from the loops, just printing the final result, you should use do instead of nconc in the outer loops as well.
Fixing this, another error shows up: print only print one object, so in order to print all four numbers you can use e.g. (print (list i j k l))
The program then prints
(1 1 1 1)
(1 3 1 1)
(2 2 1 1)
(4 2 2 2)
(4 4 3 3)
(4 4 4 4)
so something is wrong with the logic as well.
However, there are also lots of improvements that can be done to the code:
Do not use defvar to introduce new variables inside the loop. defvar creates dynamic ("global") variables. Instead, use let, or introduce them as loop variables, like you have done with i , j etc.
Instead of first creating the variables, and then updating them once using setq, give them the correct value when they are created (using let or a loop keyvword).
As you are comparing pairs of numbers: Instead of using eq (which is for symbols) or eql (which is the correct one for comparing two numbers of the same type), use = or /= which can compare many numbers to check if they are all equal/different.
Together with a small fix of the logic, this results in the following code (which for illustration introduces some variables using loop keywords, and some using let):
(loop for i in '(1 2 3 4)
for first = (abs (- 1 i))
do (loop for j in '(1 2 3 4)
for second = (abs (- 2 j))
do (loop for k in '(1 2 3 4)
do (loop for l in '(1 2 3 4)
do (let ((third (abs (- 3 k)))
(fourth (abs (- 4 l))))
(if (and (/= first second third fourth)
(/= i j k l))
(print (list i j k l))))))))
Which result in
(2 4 3 1)
(3 2 4 1)
(4 1 3 2)
(4 2 1 3)
meaning that there are still logic errors present.
Hopefully the simplified code makes it easy to spot the error, which probably has something to do with not comparing (+ i 1), (+ j 2) etc.
Finally: If you want to extend the code to handle more queens, creating a recursive solution will be better than a solution using even more nested loops.
Are these 2 expressions using quotation and list the same when evaluating the expression such as a derivative?
The intrepreter outputs the same values for both:
(define a '(+ 3 4))
(define b (list '+ 3 4))
a
b
(car a)
(car b)
Output:
=> (+ 3 4)
=> (+ 3 4)
+
+
For these expressions:
(define a '(+ 3 4))
(define b (list '+ 3 4))
Do they have the same value? yes:
(equal? a b)
=> #t
Do they refer to the same object? no:
(eq? a b)
=> #f
I guess that you want to somehow process the lists (say, for calculating a derivative). It doesn't matter how you created the lists as long as you're only interested in treating them as lists of symbols, and you can safely switch back and forth between either representation. It'd be different if you were to treat the operators as actual procedures, these are different things:
(define a '(+ 3 4))
(define b (list + 3 4)) ; quote was removed
(equal? a b)
=> #f
Consider this example:
(define a '(+ 3 4))
(define b (list '+ 3 4))
(define c '(+ 3 4))
Here a will point to an immutable* list (+ 3 4). b will point to a list whose elements are the same as a but it's produced when that statement is evaluated (a can exist before the program runs since it's a constant and for a compiled program the order and how it gets produced is not important). In b you are guaranteed that all the cons cells are newly created and unique. Thus (equal? a b) ; ==>#t while (eq? a b) ; ==> #f.
The output of (eq? a c) is undefined. Some Scheme implementations will create a new immutable list while others will point to the same list created earlier because they are both immutable according to the spec.
*Immutable by the specifications in the Scheme standard but this is seldom enforced so many implementations lets you alter immutable data with undefined behavior as consequence.