I want to generate the length of the longest sublist. For example, for the list (1 (2 (3 (4 5)) (6 7) 8) 9) , the result would be 4, because of the sublist (2 (3 (4 5)) (6 7) 8), which has 4 as the length.
I have tried to do this:
(defun len(l)
(cond
((null l) 0)
((atom l) 1)
(t (+ (len(cdr l)) 1))
)
)
(defun lun(l)
(cond
((atom l) 1)
(t(apply #'max (mapcar #' len l)))
)
)
For the example above, it returns 4, but the problem is that it analyses just the first level of the sublist. If i try to resolve it for the list (1 (2 (3 (4 5 a a a a)) (6 7) 8) 9) it also returns 4, even though it should be 6 because of the list (4 5 a a a a), it still only takes the list (2 (3 (4 5 a a a a)) (6 7) 8).
Thank you in advance.
Your inputs are list of lists of lists (etc.), also known as trees.
You want to compute the longest length of one of the lists that makes a tree. Roughly speaking, you need to iterate over subtrees, compute their respective longest length, and combine those length into a new, maximal length.
A first sketch of the function is as follows, based on the LOOP macro (you still need a bit of work to convert it to a fully recursive solution):
(defun longest-length (tree)
(loop for subtree in tree maximize (longest-length subtree)))
Just as explained above, you divide your problems into subproblems, solve them recursively by finding
for each subtree their longest length, and combine them by returning the
maximum of each local maximum.
But the above is missing a couple of things. First, you need to take into account that the tree's length itself should be computed:
(defun longest-length (tree)
(max (length tree)
(loop for subtree in tree maximize (longest-length subtree))))
Also, the code fails when it reaches items that are not cons-cells.
You now have to add code for the base case where trees are not cons-cells. In particular, nil is treated as an empty lists and not as a symbol:
(defun longest-length (tree)
(typecase tree
(cons (max (length tree)
(loop
for subtree in tree
maximize (longest-length subtree))))
(null 0)
(t 1)))
Here is a test:
CL-USER> (longest-length '(1 (2 (3 (4 5 a a a a)) (6 7) 8) 9))
6
Consider also using reduce, which unlike apply introduces no restrictions on the number of elements in the list (call-argument-limit):
(reduce #'max (mapcar ... tree) :initial-value (length tree))
Related
So im extremely new to Scheme, and i've been trying to do a multiplying table, if you put
(multiplying-table 10 3) should give a list (3 6 9 12 15 18 21 24 27 30)
Here is my code
(define (multiplying-table n value)
(cond ((= n 0) '())
(else (* n value)(Multiplying-table(- n 1)))))
You need to use cons to combine the first number 3 with the list of the rest.
Eg. (3 6 ...) is (cons 3 (cons 6 ...)). You are instead having two expressions where the (* n value) is only for effect since the result is never used. Because of that every call should return the empty list.
Usually there are 2 ways to do it. With recursion inside cons or with an accumulator. Since lists are created from end to beginning you could count n downwards and build the list from end to beginning. The base case would just return the accumulator which by default is the empty list. Here is an example:
(define (sequence from to)
(let loop ((n to) (acc '()))
(if (< n from)
acc
(loop (- n 1) (cons n acc)))))
(sequence 5 10) ; ==> (5 6 7 8 9 10)
I have the problem about writing a set cover problem code by using Common Lisp.
(setcover N S), N is a nonnegative integer, and S is a set of subsets of the numbers U = (1 2 ... N). The set cover problem asks to find a (small) number of subsets in S such that their union covers U. This means that every number in U is contained in at least one of the subsets in the solution. And the final solution has to be greedy
ex:
(let ((S '((1 2 3) (2 4) (3 4) (2 5) (4 5))))
(setcover 5 S))
output :
((1 2 3) (4 5))
I tried to write this code, and I did write the algorithm for it.
(round means recursion)
first round:
use number function to create a list (1 ,2 ....U)
then use common function to compare the sublist of S and list U and check how many numbers are in common. then take that sublist for construction(in this ex, it is (1 2 3)), finally remove (1 2 3) from list U.
second round:
check again, and there is only (4 5) left in list U, so sublist (4 5) will be used.
third round:
nothing left, so a new list will be formed ((1 2 3) (4 5))
My problems are how to find the largest number from common function in each round? how to remove those matched numbers from list U (since it has to be created first) ? and how to create a new list at the end?
;create a list U
(defun numbers (N)
(if (<= N 0)
nil
(append (numbers (- N 1)) (list n))))
;check if this atom exist in the list
(defun check (Atom List)
(cond
((null List) nil)
((equal Atom (car List)))
(t (check Atom (cdr List)))))
;numbers of common numbers that both two lists have
(defun common (L1 L2)
(cond
((null L1) 0)
((check (car L1) L2) (+ 1 (common (cdr L1) L2)))
(t (common (cdr L1) L2))))
;final setcover function but I have no idea what to do next...
(defun setcover (N S)
(cond
((if (null S) nil))
((listp (car S))
(common (car S) (numbers N))
(setcover N (cdr S)))))
Hope someone could help me. Thank you !
2019/01/24 (more question descriptions)
Write a Lisp function:
(setcover N S)
This function should implement the greedy algorithm for the set cover problem. This problem and the algorithm are described below. The Wikipedia article on set cover also explains the problem (in much more detail than we need).
In (setcover N S), N is a nonnegative integer, and S is a set of subsets of the numbers U = (1 2 ... N). The set cover problem asks to find a (small) number of subsets in S such that their union covers U. This means that every number in U is contained in at least one of the subsets in the solution.
Example:
(let
((S '((1 2 3) (2 4) (3 4) (2 5) (4 5))))
(setcover 5 S)
)
A solution:
((1 2 3) (4 5))
Explanations: N = 5, so U = (1 2 3 4 5). S consists of some subsets of (1 2 3 4 5). We are looking for some small number of those subsets that together cover all the five numbers.
The best solution uses only two subsets, (1 2 3) and (4 5). Another solution, with three subsets, is ((1 2 3) (2 4) (2 5)). Yet another solution is ((1 2 3) (2 4) (3 4) (2 5)). However, in this solution you could remove either (2 4) or (3 4) and get a smaller solution that still covers all of U.
Solving the set cover problem optimally means to find the smallest number of subsets of S that cover U. (Number of sets, not size of sets.) Unfortunately, this problem is NP-hard, and therefore no efficient algorithm is known.
Instead of the optimal solution, your program should compute and return the greedy solution - a small set of subsets that covers U and is computed by the so-called greedy algorithm below. This algorithm is also described on the wikipedia page.
The basic idea is to solve the problem in several rounds. In each round, we select one more subset from S until we have a complete cover. We pick a subset that contains as many of the still missing numbers as possible.
Assume that we still have some of the numbers in (1 2 ... N) left to cover. We consider each subset Si in S, and count how many of these numbers would be covered by Si. Then we greedily pick a subset that covers the most.
DETAILED EXAMPLE
S = ((1 2 3) (2 4) (3 4) (2 5) (4 5))
Subsets in S: S1 = (1 2 3), S2 = (2 4), S3 = (3 4), S4 = (2 5), S5 = (4 5)
N = 5
U = (1 2 3 4 5)
Start of algorithm:
Solution so far = ()
Still to cover = (1 2 3 4 5)
Round 1:
Covered by S1: 3 numbers (1 2 3)
Covered by S2: 2 numbers (2 4)
Covered by S3: 2 numbers
Covered by S4: 2
Covered by S5: 2
Best subset: S1, covers 3 numbers (1 2 3)
Solution so far = (S1)
Still to cover = (4 5)
Round 2:
Covered by S2: 1 number (4)
Covered by S3: 1 number (4)
Covered by S4: 1 number (5)
Covered by S5: 2 numbers (4 5)
Best: S5, covers (4 5)
Solution so far = (S1 S5)
Still to cover = ()
Round 3:
Nothing left to cover, so stop.
Return solution (S1 S5) = ((1 2 3) (4 5))
More example :
(setcover 2 '((1) (2) (1 2)))
((1 2))
(let
((S '((1 2 3 4 5))))
(setcover 5 S)
)
((1 2 3 4 5))
Here is a possible greedy solution, with the hypothesis that all sets are sorted and without using the primitive functions of Common Lisp, like set-difference, and using only recursion (and not iteration or high-order functions).
(defun my-difference (s1 s2)
"Compute the difference between set s1 and set s2"
(cond ((null s1) nil)
((check (car s1) s2) (my-difference (cdr s1) s2))
(t (cons (car s1) (my-difference (cdr s1) s2)))))
(defun cover-sets (s1 s2)
"Compute the greedy cover of set s1 by elements of list of sets s2"
(cond ((null s1) nil)
((null s2) (error "no cover possible"))
(t (let ((diff (my-difference s1 (car s2))))
(if (equal diff s1)
(cover-sets s1 (cdr s2))
(cons (car s2) (cover-sets diff (cdr s2))))))))
(defun setcover (n s)
"Solve the problem"
(cover-sets (numbers n) s))
Here is an alternative solution with primitive functions and iteration:
(defun cover (n s)
(let ((u (loop for i from 1 to n collect i)))
(loop for x in s
for w = (intersection u x)
when w
do (setf u (set-difference u x))
and collect x
end
while u)))
Addition
After the update of the post with the specification of the algorithm, here is a possible solution (without using recursion):
(defun count-common-elements (s1 s2)
"return the number of common elements with s1 of each set of s2"
(mapcar (lambda (x) (length (intersection s1 x))) s2))
(defun index-of-maximum (l)
"return the index of the maximum element in list l"
(position (reduce #'max l) l))
(defun setcover (n s)
(let ((working-set (numbers n))
(solution nil))
(loop while working-set
for i = (index-of-maximum (count-common-elements working-set s))
for set = (elt s i)
do (setf working-set (set-difference working-set set)
s (remove set s))
do (push set solution))
(reverse solution)))
and here is a recursive solution:
(defun most-elements (s1 s2 m)
"find the set with the higher number of elements in common
with s1 between m and all the elements of s2"
(if (null s2)
m
(let ((l1 (length (my-difference s1 m)))
(l2 (length (my-difference s1 (car s2)))))
(if (< l1 l2)
(most-elements s1 (cdr s2) m)
(most-elements s1 (cdr s2) (car s2))))))
(defun greedy-cover-set (s1 s2)
"find the greedy cover set of s1 by using the sets elements of s2"
(cond ((null s1) nil)
((null s2) (error "no cover possible"))
(t (let ((candidate (most-elements s1 s2 nil)))
(cons
candidate
(greedy-cover-set (my-difference s1 candidate)
(remove candidate s2)))))))
(defun setcover (n s)
(greedy-cover-set (numbers n) s))
Note that remove is the predefined function of Common Lisp (see the manual). It is not difficult to give a recursive definition of it.
I am trying to figure out how to access the elements in a nested list in LISP. For example:
((3 (1 7) (((5)))) 4)
If I use dolist, i run into the brackets. Is there any method to just get the elements from the list?
This is actually a surprisingly subtle question! It's in some ways the equivalent of asking: how do I get the nested elements of an HTML DOM, by specifying a pattern. (more on that aspect later)
If you just want to get the non-list elements as a sequence, e.g.
((3 (1 7) (((5)))) 4) -->
(nth 3 (3 1 7 5 4)) -->
5
You can use the 'cheat' way: the flatten function in the CL alexandria library. (via quicklisp)
(ql:quicklisp :alexandria)
(nth 3 (alexandria:flatten '((3 (1 7) (((5)))) 4)))
Which gives us the sought after,
5
But, the alexandrian function is simple enough that we can take a look at the source code itself:
(defun flatten (list)
(cond
((null list)
nil)
((consp (car list))
(nconc (flatten (car list)) (flatten (cdr list))))
((null (cdr list))
(cons (car list) nil))
(t
(cons (car list) (flatten (cdr list))))))
As you can see, it's a recursive function -- at each level of recursion it asks the question: what is the object that I'm flattening? If it's the empty list, return nil. I'm done!
Otherwise it has to be a non empty list. If the first element of the list is also a list then flatten that and also flatten the cdr of the function argument list and concatenate the results.
If the first element is not a list and the second element is '(), that must mean we have a list with one element: return it.
The final case case, which exhausts our possibilities is that the first element in the list is an atom while the rest of the list is a list with at least one element. In that case concatenate the first element with the results of a flatten performed on the rest of the list.
The fact that the description in English is so ponderous shows the power of recursion, (and also my own lack of fluency when describing it).
But there's actually another way your question could interpreted: if I have a list that looks something like: ((n1 (n2 n3) (((n4)))) n5) How do I get at n2, even if n2 is itself a list? Our previous recursive algorithm won't work -- it depends on n2 not being a list to know when to stop. But, we can still use recursion and the very list we're searching as the basis for a pattern:
;; For each element in our pattern list look for a corresponding
;; element in the target, recursing on lists and skipping atoms that
;; don't match.
(defun extract-from-list (pattern target to-find)
(dotimes (i (length pattern))
(let ((ith-pattern (nth i pattern)))
(cond
((consp ith-pattern)
(let ((results
(extract-from-list (nth i pattern)
(nth i target)
to-find)))
(when results
(return results))))
(t
(if (eq to-find ith-pattern)
(return (nth i target))))))))
Note that,
(extract-from-list
'((n1 (n2 n3) (((n4)))) n5) ;; The pattern describing the list.
'((3 (1 7) (((5)))) 4) ;; The list itself.
'n4) ;; which of the elements we want.
still returns the old answer:
5
But,
(extract-from-list
'((n1 (n2 n3) (n4)) n5) ;; The pattern describing the list, note (n4) rather than (((n4)))
'((3 (1 7) (((5)))) 4) ;; The list itself.
'n4) ;; The element we want to pull from the list
Returns
((5))
Magic! One of the aspects of Lisp that makes it so extraordinarily powerful.
I want to reverse only the continuous sequences, not all the elements of my original list.
Ex:
(reverseC '( 1 2 ( 4 5 ) 5 ) ) => ( 2 1 ( 5 4 ) 5 )
(reverseC '(1 4 2 (3 4) 9 6 (7 8)))) => (2 4 1 (4 3) 6 9 (8 7))
I was thinking of splitting it into 2 functions: one to reverse a simple list ( 1 2 3 ) -> ( 3 2 1 ) and one function
(main) to determine the continuous sequences, make a list out of them, apply reverse on that list and the remake the whole reversed list.
(defun reverse-list ( lista )
(if (eql lista () )
()
(append (reverse-list (cdr lista )) (list ( car lista)))
)
)
This is the reverse function but I have no idea how to do the other one. I'm new to Lisp and I come from Prolog so it's a pretty big change of scenery. Any idea is welcome.
(defun reverse-more (L)
(if (eql L nil)
nil
(let ( el (car L)) (aux (cdr L)))
(if (eql (listp el) nil)
...No idea on the rest of the code ...
There's already an accepted answer, but this seems like a fun challenge. I've tried to abstract some of the details away a bit, and produced a map-contig function that calls a function with each contiguous sublist of the input list, and determines what's a contiguous list via a predicate that's passed in.
(defun map-contig (function predicate list)
"Returns a new list obtained by calling FUNCTION on each sublist of
LIST consisting of monotonically non-decreasing elements, as determined
by PREDICATE. FUNCTION should return a list."
;; Initialize an empty RESULT, loop until LIST is empty (we'll be
;; popping elements off of it), and finally return the reversed RESULT
;; (since we'll build it in reverse order).
(do ((result '())) ((endp list) (nreverse result))
(if (listp (first list))
;; If the first element is a list, then call MAP-CONTIG on it
;; and push the result into RESULTS.
(push (map-contig function predicate (pop list)) result)
;; Otherwise, build up sublist (in reverse order) of contiguous
;; elements. The sublist is finished when either: (i) LIST is
;; empty; (ii) another list is encountered; or (iii) the next
;; element in LIST is non-contiguous. Once the sublist is
;; complete, reverse it (since it's in reverse order), call
;; FUNCTION on it, and add the resulting elements, in reverse
;; order, to RESULTS.
(do ((sub (list (pop list)) (list* (pop list) sub)))
((or (endp list)
(listp (first list))
(not (funcall predicate (first sub) (first list))))
(setf result (nreconc (funcall function (nreverse sub)) result)))))))
Here's your original example:
(map-contig 'reverse '< '(1 2 (4 5) 5))
;=> (2 1 (5 4) 5)
It's worth noting that this will detect discontinuities within a single sublist. For instance, if we only want continuous sequences of integers (e.g., where each successive difference is one), we can do that with a special predicate:
(map-contig 'reverse (lambda (x y) (eql y (1+ x))) '(1 2 3 5 6 8 9 10))
;=> (3 2 1 6 5 10 9 8)
If you only want to break when a sublist occurs, you can just use a predicate that always returns true:
(map-contig 'reverse (constantly t) '(1 2 5 (4 5) 6 8 9 10))
;=> (5 2 1 (5 4) 10 9 8 6)
Here's another example where "contiguous" means "has the same sign", and instead of reversing the contiguous sequences, we sort them:
;; Contiguous elements are those with the same sign (-1, 0, 1),
;; and the function to apply is SORT (with predicate <).
(map-contig (lambda (l) (sort l '<))
(lambda (x y)
(eql (signum x)
(signum y)))
'(-1 -4 -2 5 7 2 (-6 7) -2 -5))
;=> (-4 -2 -1 2 5 7 (-6 7) -5 -2)
A more Prolog-ish approach
(defun reverse-contig (list)
(labels ((reverse-until (list accumulator)
"Returns a list of two elements. The first element is the reversed
portion of the first section of the list. The second element is the
tail of the list after the initial portion of the list. For example:
(reverse-until '(1 2 3 (4 5) 6 7 8))
;=> ((3 2 1) ((4 5) 6 7 8))"
(if (or (endp list) (listp (first list)))
(list accumulator list)
(reverse-until (rest list) (list* (first list) accumulator)))))
(cond
;; If LIST is empty, return the empty list.
((endp list) '())
;; If the first element of LIST is a list, then REVERSE-CONTIG it,
;; REVERSE-CONTIG the rest of LIST, and put them back together.
((listp (first list))
(list* (reverse-contig (first list))
(reverse-contig (rest list))))
;; Otherwise, call REVERSE-UNTIL on LIST to get the reversed
;; initial portion and the tail after it. Combine the initial
;; portion with the REVERSE-CONTIG of the tail.
(t (let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
(nconc head (reverse-contig tail)))))))
(reverse-contig '(1 2 3 (4 5) 6 7 8))
;=> (3 2 1 (5 4) 8 7 6)
(reverse-contig '(1 3 (4) 6 7 nil 8 9))
;=> (3 1 (4) 7 6 nil 9 8)
Just two notes about this. First, list* is very much like cons, in that (list* 'a '(b c d)) returns (a b c d). list** can take more arguments though (e.g., **(list* 'a 'b '(c d e)) returns (a b c d e)), and, in my opinion, it makes the intent of lists (as opposed to arbitrary cons-cells) a bit clearer. Second, the other answer explained the use of destructuring-bind; this approach could be a little bit shorter if
(let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
were replaced with
(destructuring-bind (head tail) (reverse-until list '())
You can perform all at once with a single recursive function, with the usual warning that you should favor looping constructs over recursive approaches (see below):
(defun reverse-consecutive (list &optional acc)
(etypecase list
;; BASE CASE
;; return accumulated list
(null acc)
;; GENERAL CASE
(cons (destructuring-bind (head . tail) list
(typecase head
(list
;; HEAD is a list:
;;
;; - stop accumulating values
;; - reverse HEAD recursively (LH)
;; - reverse TAIL recursively (LT)
;;
;; Result is `(,#ACC ,LH ,#LT)
;;
(nconc acc
(list (reverse-consecutive head))
(reverse-consecutive tail)))
;; HEAD is not a list
;;
;; - recurse for the result on TAIL with HEAD
;; in front of ACC
;;
(t (reverse-consecutive tail (cons head acc))))))))
Exemples
(reverse-consecutive '(1 2 (3 4) 5 6 (7 8)))
=> (2 1 (4 3) 6 5 (8 7))
(mapcar #'reverse-consecutive
'((1 3 (8 3) 2 )
(1 4 2 (3 4) 9 6 (7 8))
(1 2 (4 5) 5)))
=> ((3 1 (3 8) 2)
(2 4 1 (4 3) 6 9 (8 7))
(2 1 (5 4) 5))
Remarks
#Melye77 The destructuring-bind expression does the same thing as [Head|Tail] = List in Prolog. I could have written this instead
(let ((head (first list))
(tail (rest list)))
...)
Likewise, I prefer to use (e)typecase over the generic cond expression whenever possible, because I think it is more precise.
I could have written:
(if acc
(if (listp (first list))
(nconc ...)
(reverse-consecutive ...))
acc)
... but I think it is less clear and not a good thing to teach beginners.
On the contrary, I think it is useful, even (especially) for beginners, to introduce the full range of available constructs.
For example, overusing recursive functions is actually not recommended: there are plenty of existing iteration constructs for sequences that do not depend on the availability of tail-call optimizations (which are not guaranteed to be implemented, though it is generally available with appropriate declarations).
Iterative version
Here is an iterative version which uses of the standard reverse and nreverse functions. Contrary to the above method, inner lists are simply reversed (contiguous chunks are only detected at the first level of depth):
(defun reverse-consecutive (list)
(let (stack result)
(dolist (e list (nreverse result))
(typecase e
(list
(dolist (s stack)
(push s result))
(push (reverse e) result)
(setf stack nil))
(t (push e stack))))))
I'm a couple of weeks in my study of Lisp (mostly recursion). So far, I've mostly been dealing with simple enough functions that test the basic knowledge of recursion (car, cdr, cond, remove, nth etc.). I stumbled upon a simple problem that I just can't get right. The problem goes:
Write a function remove-nth that takes two arguments:
(defun remove-nth (n l)
)
Where n is a non-negative integer and list is a list/atom/null. The function removes the n-th element (one-based indexing) of the original list and any-level sub-lists that it contains. The operation can be either destructive or non-destructive.
So, for example:
(remove-nth 3 '((1 2 3 4) ((1 3 5) 3 1) (1 2 2 1))) --> ((1 2 4) ((1 3) 3))
What I've tried:
(defun remove-nth (n L)
(cond
((null L) nil)
((listp L)
(cons (remove-nth n (car (r n L))) (remove-nth n (cdr (r n L)))))
(t L)
)
)
(defun r (n L)
(remove (nth (- n 1) L) L)
)
This code doesn't work because it sometimes removes an element twice from the same list, e.g. calling:
(remove-nth 2 '((1 2 3 4) ((1 3 5) 3 1) (1 2 2 1)))
ought to output
((1 3 4) (1 2 1))
but in my case, it outputs:
((1 3) (1 1))
i.e. the sub-list (1 2 2 1) has two elements removed instead of just one. I reckon there is an oversight in the way I'm trying to handle the recursive calls, but I've tried many different approaches and I can't get any to work. So, I've turned to you guys for help.
I am not asking for the code per se, but rather an explanation, or a hint on how to better my approach.
Thanks in advance!
Look at this code, it should work as you wanted:
(defun remove-nth (n L)
(cond
((null L) nil)
((listp L)
(map 'list (lambda (l) (remove-nth n l)) (r n L)))
(t L)))
(defun r (n L)
(if (or (= n 1) (null L))
(cdr L)
(cons (car L) (r (1- n) (cdr L)))))
There are 2 problems with your approach:
In function r you're not removing the nth element - you're removing every element that's equal to the nth element of the list. Because of that the list '(1 2 2 1) is transformed to '(1 1) - the 2nd element is 2, so every 2 is removed.
In function remove-nth you're recursing down into the first element and right into the tail of the list - because of the second recursion you're removing more elements that you should. That's apparent in the case of the list '(1 2 3 4). It becomes '(1 3 4) after the call to r, then you decompose it into car (equal to 1) and cdr (equal to '(3 4)). After recursing into the second one, you once again remove the 2nd element and you get '(3). This, after cons, gives you the list '(1 3).