I have
(setq l2 '(1 (2 b (c 1 b))(a (1 2) d)))
(defun drumuri (l3)
(cond ((atom l3) (cons l3 nil))
(t (append
(cons (car l3) nil)
(drumuri (cadr l3))
(cons (car l3) nil)
(drumuri (caddr l3))))))
(drumuri l2)
and it gives me:
Break 2
[4]> DRUMURI
Break 2
[4]> (1 2 B 2 C 1 C B 1 A 1 2 1 NIL A D)
but i need:
((1 2 B)(1 2 C 1)(1 2 C B)(1 A 1 2)(1 A D))
Ok good news i found some of the answers:
(setq l2 '(1 (2 b (c 1 b))(a (1 2) d)))
( defun drumuri (l3)
( cond ( (atom l3) ( cons l3 nil))
(t (append ( cons ( car l3 ) nil)
(drumuri ( cadr l3) )))))
(drumuri l2)
and the answer to that is:
[1]>
(1 (2 B (C 1 B)) (A (1 2) D))
[2]>
DRUMURI
[3]>
(1 2 B)
Next is the second answer:
(defun drumuri (l4)
(cond ((atom l4)(cons l4 nil))
( t ( append (cons ( car l4)nil)
(drumuri ( caddr l4))))))
(drumuri l2)
and the answer to that is:
[1]>
(1 (2 B (C 1 B)) (A (1 2) D))
[2]>
DRUMURI
[3]>
(1 A D)
So all that is left is to find:
(1 2 C 1) (1 2 C B) (1 A 1 2)
A tricky problem. Not particularly complex, but with some finicky edges. Since this is obviously homework, I'm going to try to help you, but at the same time avoid just spoon-feeding you (and possibly fail at one or both of these goals). So I've written it in Python. Hopefully that's far enough away from Lisp that you'll still have to do a good slab of thinking for yourself.
>>> import operator
>>> def drumuri(a):
... if isinstance(a, list):
... return reduce(operator.add,
... [[a[:1] + d for d in drumuri(x)] for x in a[1:]])
... else:
... return [[a]]
...
>>> drumuri( [1, [2, 'b', ['c', 1, 'b']], ['a', [1, 2], 'd']] )
[[1, 2, 'b'], [1, 2, 'c', 1], [1, 2, 'c', 'b'], [1, 'a', 1, 2], [1, 'a', 'd']]
>>>
Here's the key insight lacking from your Lisp version. Because drumuri is recursive, every level must return the same kind of structure to its caller: a list of paths, where each path is a list. In short, drumuri must always return a list of lists. Your leaf case returns a list containing a single atom.
You are also making some mistakes with the use of append, but the leaf issue is probably bending everything else out of shape.
EDIT: Let's see if can help you discover the solution for yourself. Follow these steps:
Write a function called prepend-to-paths that takes a single head and a list of paths, and returns a list of paths with the head added to the front of each original path. It should work as follows:
> (prepend-to-paths 1 '((2 B) (2 C 1) (2 C B) (A 1 2) (A D))) ;'
((1 2 B) (1 2 C 1) (1 2 C B) (1 A 1 2) (1 A D))
Write a function called convert-to-paths that takes a list of unprocessed tail elements and converts them to paths. Rather than doing all the work itself, however, it should only worry about mapping the input to a list of paths (relying on the as-yet unwritten drumuri to map each element) and then concatenating the returned lists of paths into a single list of paths. The output (once drumuri exists) should be like so:
> (convert-to-paths '((2 b (c 1 b)) (a (1 2) d))) ;'
((2 B) (2 C 1) (2 C B) (A 1 2) (A D))
Write the drumuri function. It should use cond as per your original, but replace the leaf case with an expression that returns the atom as a list of paths:
> (drumuri 'b) ;'
((b))
Then replace the (append ...) with code that uses the functions you wrote in the previous steps to transform the head and tail of the input list input a list of paths.
Once the three functions are working together nicely, you could try to figure out how to fold the first two into the body of drumuri. Note that the end-result of this may be structurally different to the Python solution I gave.
If and when you get stuck, just update your question with whatever progress you've made and whatever code you've managed to cobble together.
Related
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".
I wrote a function called 'my-append' which which takes two lists L1,L2
and appends each element of L2 to the end of L1. (in other words it concats L1 with L2)
the function seems to be behaving correctly however I seem to be getting a strange output.
(my-append '(a b '(1 2 3)) (list '(4 5 6) 7 8 9)) ==>
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
I am new to scheme and cannot tell if this is correct or now.
Please note that I am using Advanced student language inside of dr racket.
Here is the code for the function. (it uses two helper functions)
;my-append
;takes two lists L1,L2 and returns concat of L2 to L1
;it first checks if either list is empty if so it returns the non empty one
;if both are empty returns empty
;if both are non empty determine which list has smaller length
;calls my-append-helper with first arg as smaller second larger
;append-element
;takes a list L and element x and adds x
; to the end of L
; I am super limited on which operations i can use
; so i must resort to this O(n) algorithm
;my-append-helper
;takes either two non empty lists L1 L2 then
;builds the concatenation of L1 L2
;by stripping of first element of L2
;and adding it to L1
(define (append-element L x)
(cond ((equal? L '())
(list x) )
(else
(cons (first L)
(append-element (rest L) x)))))
(define my-append-helper
(lambda (L1 L2)
(cond ( (equal? '() L2)
L1)
(else (my-append-helper (append-element L1 (first L2)) (rest L2))))))
(define my-append
(lambda (L1 L2)
(cond ( (and (equal? L1 '()) (equal? L2 '()))
'() )
( (equal? L1 '() )
L2 )
( (equal? L2 '() )
L1)
( else
(my-append-helper L1 L2)))))
Yes the output is correct.
> (my-append '(a b '(1 2 3)) (list '(4 5 6) 7 8 9))
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
It is printed in the style so that when pasted back at the prompt the result is the same:
> (list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9) ; compare below vvvvv
How can we be sure it's OK? By doing the same with the two parts:
> '(a b '(1 2 3))
(list 'a 'b (list 'quote (list 1 2 3)))
; --------------------------------
> (list '(4 5 6) 7 8 9)
(list (list 4 5 6) 7 8 9) ; aligned vertically ^^^
; ------------------
The append just puts the two parts together into one list, turning
(list a b c ... n) (list o p q ... z)
into
(list a b c ... n o p q ... z)
or, symbolically ("in pseudocode"),
[a b c ... n] [o p q ... z] ; is turned into:
[a b c ... n o p q ... z]
About your algorithm. It appends the two lists by repeating the steps
[a b c ... n] [o p q ... z]
[a b c ... n] o [p q ... z]
[a b c ... n o] [q ... z]
until the second list is exhausted. Repeatedly appending an element at a list's end is well suited for languages with such primitive, like Clojure's conj, which is cheap to use. But in Scheme it is algorithmically disadvantageous because the repeated traversal over the first list to append the element to it leads to a quadratic behaviour w.r.t. the time complexity (the execution time will grow four-fold for a two-fold increase in the input data's size).
Another way of doing this is
[a b ... m n] [o p q ... z]
[a b ... m] n [o p q ... z]
[a b ... m] [n o p q ... z]
until the first list is used up:
(define my-append-helper
(lambda (L1 L2)
(cond ( (equal? '() L1)
L2)
(else (my-append-helper (but-last L1) (cons (last L1) L2))))))
; ^^^^ !
cons is cheap in Scheme, so that is good. But repeatedly removing an element from a list's end (with the yet-not-implemented but-last) is algorithmically disadvantageous because the repeated traversal over the first list to remove its last element leads to a quadratic behaviour w.r.t. the time complexity (the execution time will grow four-fold for a two-fold increase in the input data's size).
We're on the right track with the cons though, when we notice that the appending can progress by the steps
[a b ... m n] [o p q ... z]
( [a] [b ... m n] ) [o p q ... z]
[a] ( [b ... m n] [o p q ... z] )
................................
[a] [b ... m n o p q ... z]
[a b ... m n o p q ... z]
when we set aside the first element of the first list, append what's left, and then all that is left for us to do is to cons that first element onto the result!
Does this count?
(define (myappend lst1 lst2)
(cond
((null? lst2) lst1)
(else (myappend (cons lst1 (cons (car lst2) '())) (cdr lst2)))))
This is an iterative procedure (rather than recursive).
Note that if
List 2 is empty, you can simply return list1.
Since your base case requires you to return your list1, just use an invariant based proof where you define list1 to be the invariant.
If that doesn't work, let me know and I'll try helping you debug your code.
(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'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))))
disclaimer: I'm pretty sure I've managed to muck up something really simple, possibly because I've been poking at this in between
"real work" while waiting for some slow C++ builds, so my head's not
in the right place.
In looking at
What's the most efficient way of generating all possible combinations of skyrim (PC Game) potions? I had the naïve notion that it would be a really, really simple recursive filter in Lisp to generate all combinations of size "n." The answer given there, in R, is elegant and shows off the language well, but that combn(list,n) method caught my attention. ( http://stat.ethz.ch/R-manual/R-patched/library/utils/html/combn.html )
(defun combn (list n)
(cond ((= n 0) nil)
((null list) nil)
((= n 1) (mapcar #'list list))
(t (mapcar #'(lambda (subset) (cons (car list) subset))
(combn (cdr list) (1- n))))))
(combn '(1 2 3 4 5 6 7 8 9) 3)
((1 2 3) (1 2 4) (1 2 5) (1 2 6) (1 2 7) (1 2 8) (1 2 9))
Except, this just returns the first set of combinations … I can't wrap my head around what's wrong, precisely. It seems that the (= n 1) case works right, but the t case should be doing something differently, such as stripping (1 2) off the list and repeating?
So, my attempt to fix it, got nastier:
(defun combn (list n)
(cond ((= n 0) nil) ((= n 1) (mapcar #'list list))
((null list) nil)
(t (cons (mapcar #'(lambda (subset) (cons (car list) subset))
(combn (cdr list) (1- n)))
(combn (cdr list) n)))))
which is wrong at the point of (t cons(… I think. But, if cons is the wrong answer, I'm not sure what is right…? (Reduced to using 2 to demonstrate output…)
(combn '(1 2 3 4 5 6 7 8 9) 2)
(((1 2) (1 3) (1 4) (1 5) (1 6) (1 7) (1 8) (1 9))
((2 3) (2 4) (2 5) (2 6) (2 7) (2 8) (2 9))
((3 4) (3 5) (3 6) (3 7) (3 8) (3 9))
((4 5) (4 6) (4 7) (4 8) (4 9))
((5 6) (5 7) (5 8) (5 9))
((6 7) (6 8) (6 9))
((7 8) (7 9))
((8 9))
NIL)
… which appears to be right, except for the extraneous nesting and the bonus NIL at the end. (I had anticipated that ((null list) nil) would have filtered that out?)
What did I do wrong? :-(
(And, also, is there a standard routine for doing this more efficiently?)
Yes, the cons is not the right thing, you need an append. And that's also what gets you the NIL at the end. I can't write Lisp, so I'll give you Haskell:
comb :: Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb k (x:xs) = [x:ys | ys <- comb (k-1) xs] ++ comb k xs
comb _ _ = []
That's short and sweet, but inefficient (and doesn't check for negative k). It will often try to choose more elements than the list has for a long time. To prevent that, one would keep track of how many elements are still available.
comb :: Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb k xs
| k < 0 = []
| k > len = []
| k == len = [xs]
| otherwise = go len k xs
where
len = length xs
go l j ys
| j == 1 = map (:[]) ys
| l == j = [ys]
| otherwise = case ys of
(z:zs) -> [z:ws | ws <- go (l-1) (j-1) zs] ++ go (l-1) j zs
Ugly, but efficient.
A solution using Common Lisp.
Note that this version intentionally uses assert to give you a continuable error if the list passed in isn't evenly divisible by the specified number but it'd be easy enough to have it just place any "leftover" items in a shorter list at the end, or use error to just make it bail completely without possibility of interactive fixing.
Based on scheme's srfi-1, tweaked to CL by me, and improved greatly by Rainer Joswig
(defun split-by (list n &aux length)
"splits a list into multiple lists of length n.
Parameters:
* list - the list to be split
* n - the size of the lists it should be broken into.
Returns:
A list of smaller lists of the specified length (or signals an error).
Examples:
(split-by '(1 2 3 4) 2) ; => ((1 2) (3 4))
(split-by '(1 2 3) 2) ; => not evenly divisible"
(assert (zerop (mod (setf length (length list)) n))
(list)
"list is not evenly divisible by ~A: ~A" n list)
(if (plusp length)
(cons (subseq list 0 n)
(split-by (subseq list n) n))
'()))