I have the list in LISP:
((1 b) (1 a) (2 D) (1 z) (1 t) (2 a) (3 n))
I have to order it first on the number and if equal on the lexichographic order of the char, the output should be:
((1 a) (1 b) (1 t) (1 z) (2 a) (2 d) (3 n))
I have tried to sort on one parameter and then the other, how can I compose the two function ?
;;(sort '((1 b) (1 a) (2 D) (1 z) (1 t) (2 a) (3 n)) #'< :key #'car )
;;(sort '((1 b) (1 a) (2 D) (1 z) (1 t) (2 a) (3 n)) #'string< :key #'second )
Are there easier ways to do it?
Thanks
As coredump says, since you really need a list comparison function, a nice approach is do the meta thing: don't write one, but write a function which makes functions which compare lists. Here is such a function:
(defun make-list-comparator (&rest predicates)
(labels ((tails< (l1t l2t pt)
(let ((< (first pt))
(e1 (first l1t))
(e2 (first l2t)))
(cond
((funcall < e1 e2) t)
((funcall < e2 e1) nil)
((and (null l1t) (null l2t) (null pt)) nil)
((or (null l1t) (null l2t) (null pt))
(error "crashed into the end"))
(t (tails< (rest l1t) (rest l2t) (rest pt)))))))
(lambda (l1 l2)
(tails< l1 l2 predicates))))
And now
> (sort (copy-list '((1 b) (1 a) (2 D) (1 z) (1 t) (2 a) (1)))
(make-list-comparator
#'<
(lambda (s1 s2)
(string< (string s1) (string s2)))))
((1 a) (1 b) (1 t) (1 z) (2 a) (2 d) (3 n))
You have basically two options:
define a comparison function of two elements (x0 y0) and (x1 y1) that returns T if:
x0 < x1, or
x0 and x1 are equivalent [*] and y0 <' y1.
You could also generalize this solution by defining a higher-order functions that accepts a list of test and key parameters and combines them to create a comparison function that applies them all on two values.
[*] equivalence being defined as neither a < b or b < a in the general case when < is a user-provided comparison function.
sort the list once to compare the respective second fields of entries, then call stable-sort on the result to sort according to the first field: you have to start from least significant field (changing the order of application of sorts changes the results). For example:
((1 c) (2 b) (0 a) (1 b))
sort by second field #'string<
((0 a) (1 b) (2 b) (1 c))
then stable-sort by first field #'<
((0 a) (1 b) (1 c) (2 b)) #### RES 1
The result would be as follows by sorting by the first field first:
((0 a) (1 c) (1 b) (2 b))
Then (stably) by the second:
((0 a) (1 b) (2 b) (1 c)) #### RES 2
By calling stable-sort, when the first field of two elements are equal, the stability of the sort guarantees they will keep being sorted by their second field. You can apply stable-sort multiple times if you have more fields to compare.
Be careful, in Common Lisp sort mutates the input.
Related
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'm trying to sort a list of polynomials written in this format:
(M [coefficient] [total degree] [Variable List]).
example:
((M 1 1 ((V 1 A))) (M 1 2 ((V 1 A) (V 1 C))) (M 1 2 ((V 2 A))) (M 1 2 ((V 1 A) (V 1 B))))
This is: a + a * c + a ^ 2 + a * b, I need to get a + a * b + c + a * a ^ 2, because a * b < a ^ 2 and a < a ^ 2.
I tried to use the function sort, but my output is:
((M 1 1 ((V 1 A))) (M 1 2 ((V 2 A))) (M 1 2 ((V 1 A) (V 1 B))) (M 1 2 ((V 1 A) (V 1 C))))
that is a + a ^ 2 + a * b + a * c.
I use:
(defun sort-poly (a b)
(cond
(t (sort-poly-helper (varpowers a) (varpowers b)))))
(defun sort-poly-helper (a b)
(cond
((null a) (not (null b)))
((null b) nil)
((equal (third(first a)) (third(first b))) (sort-poly-helper (rest a) (rest b)))
(t (sort (list (third(first a)) (third(first b))) #'string-lessp))))
with:
(sort '((M 1 1 ((V 1 A))) (M 1 2 ((V 1 A) (V 1 C))) (M 1 2 ((V 2 A))) (M 1 2 ((V 1 A) (V 1 B)))) #'sort-poly)
Some help?
Thanks
Your definition of what you want to do is sufficiently opaque that an answer is hard to provide. But the way to start is to stop programming like it is 1956 and use some abstraction.
First of all, let's define how to make a variable and get at its bits:
(defun make-variable (name &optional (degree 1))
`(v ,name ,degree))
(defun variable-name (v)
(second v))
(defun variable-degree (v)
(third v))
Now let's define how to make polynomials from lists of variables. Note that the total degree of the polynomial is computable from the degrees of all the variables, so we do that.
(defun make-polynomial (variables &optional (coefficient 1))
;; The total degree of the polynomial can just be computed from the
;; degrees of its variables
`(m ,coefficient ,(reduce #'* variables :key #'variable-degree)
,variables))
(defun polynomial-coefficient (p)
(second p))
(defun polynomical-total-degree (p)
(third p))
(defun polynomial-variables (p)
(fourth p))
Now, given lists of polynomials, we can sort them using the abstractions we've built: we don't need to grovel around with list accessors (and indeed we could change the representation of polynomials or variables and nothing would ever know).
I am guessing that what you want to sort on is the highest degree of a variable in a polynomial although it is not really clear, and not the total degree of the polynomial (which would be easier). So let's write a function to pull out the highest variable degree:
(defun highest-variable-degree (p)
(reduce #'max (mapcar #'variable-degree (polynomial-variables p))))
And now we can sort lists of polynomials.
CL-USER 23 > (sort (list (make-polynomial (list (make-variable 'a)
(make-variable 'b 2)))
(make-polynomial (list (make-variable 'c)
(make-variable 'd))))
#'<
:key #'highest-variable-degree)
((m 1 1 ((v c 1) (v d 1))) (m 1 2 ((v a 1) (v b 2))))
Remember: it is not 1956 any more.
I need to make a function that transforms 2 list in one in lisp?Can you please help me?
(A B C) (X Y Z) --> ((A.X) (B.Y) (C.Z))
This is the example
For the case you asked :
CL-USER> (mapcar #'cons '(1 2 3) '(a b c))
((1 . A) (2 . B) (3 . C))
If you want to generalize :
CL-USER> (mapcar #'list '(1 2 3) '(a b c) '(x y z))
((1 A X) (2 B Y) (3 C Z))
In a function :
(defun foo (&rest l)
(apply #'mapcar #'list l))
Which gives:
CL-USER> (foo '(1 2 3) '(a b c) '(x y z))
((1 A X) (2 B Y) (3 C Z))
I'm trying to write a function in Common Lisp that deletes an item from a list. Here's what I've written so far:
(defun aux-remove-fio (lst toremove)
(if (equal (first lst) toremove)
(pop lst)
(aux-remove-fio (rest lst) toremove))))
When I test the function, here's the result:
CG-USER(49): a3
((1 (1 . 1) (1 . 2)) (2 (2 . 1) (1 . 2)))
CG-USER(50): (pop a3)
(1 (1 . 1) (1 . 2))
CG-USER(51): a3
((2 (2 . 1) (1 . 2)))
CG-USER(52): (setf a3 '((1 (1 . 1) (1 . 2)) (2 (2 . 1) (1 . 2))))
((1 (1 . 1) (1 . 2)) (2 (2 . 1) (1 . 2)))
CG-USER(53): (aux-remove-fio a3 '(1 (1 . 1) (1 . 2)))
(1 (1 . 1) (1 . 2))
CG-USER(54): a3
((1 (1 . 1) (1 . 2)) (2 (2 . 1) (1 . 2)))
Can anyone explain why my function isn't working?
Yes. Your function changes the value of its local variable, lst --- nothing more.
Here is a simpler example, showing the same thing:
(setq a3 '(1 2 3)) ; (1 2 3)
(defun foo (xs) (setq xs (cdr xs))) ; Change value of xs.
;; Change value of xs to (2 3). Its initial value is the value of a3, i.e., (1 2 3)
(foo a3)
a3 ; => (1 2 3)
After foo is called, a3 still points to the original cons cell whose car is 1 and whose cdr is the same cons cell as before, with car 2, etc. All you have done i smake local variable xs point to the cdr of the cons cell it originally pointed to, which was the same cons cell that a3 points to.
If you want your function to change the value of global variable a3, then do so directly:
(defun foo () (pop a3))
Or if you just want a function that pops the first element off of the list value of a special variable, then you have such a function: pop --- just use (pop a3).
If you want a function that changes the value of a global variable that you pass it, then pass the variable (i.e., symbol) and not its value:
(defun foo (var)
(let* ((val (symbol-value var))
(head (car val)))
(set var (cdr val))
head))
(foo 'a3) ; Pop off a3's head and return it.
a3 ; Now a3 has lost its head.
This definition of foo is like a simple form of pop, except that it is a function, so evaluates its argument.
This is my simple solution. I define a function in REPL
CL-USER> (defun remove-element (mylist n)
(append
(subseq mylist 0 n)
(subseq mylist (1+ n))))
then run it (errors on your Lisp implementation may differ)
CL-USER> (remove-element '(1 2 3 4 5) 0)
(2 3 4 5)
CL-USER> (remove-element '(1 2 3 4 5) 1)
(1 3 4 5)
CL-USER> (remove-element '(1 2 3 4 5) 5)
; Evaluation aborted on #<SB-KERNEL:BOUNDING-INDICES-BAD-ERROR ...
CL-USER> (remove-element '(1 2 3 4 5) -1)
; Evaluation aborted on #<TYPE-ERROR ...
Looking for a function that would do something akin to the following:
(foo 3 2) => '( ( (1 1) (1 2) (1 3) )
( (2 1) (2 2) (2 3) ) )
Would there be any built-in function in DrRacket that accomplishes that?
The main tool that you want to use to get such things in Racket is the various for loops. Assuming that you want to create a list-based matrix structure, then this is one way to get it:
#lang racket
(define (foo x y)
(for/list ([i y])
(for/list ([j x])
(list (add1 i) (add1 j)))))
And since people raised the more general question of how to make foo create a matrix of any dimension, here's a generalized version that works with any number of arguments, and still returns the same result when called as (foo 3 2):
#lang racket
(define (foo . xs)
(let loop ([xs (reverse xs)] [r '()])
(if (null? xs)
(reverse r)
(for/list ([i (car xs)])
(loop (cdr xs) (cons (add1 i) r))))))
(Note BTW that in both cases I went with a simple 0-based iteration, and used add1 to get the numbers you want. An alternative way would be to replace
(for/list ([i x]) ... (add1 i) ...)
with
(for/list ([i (in-range 1 (add1 x)]) ... i ...)
)
Code:
(define (foo-makey const max data)
(let* ((i (length data))
(newy (- max i))
(newpair (cons const newy)))
(if (= max i)
data
(foo-makey const max
(cons newpair data)))))
(define (foo-makex xmax ymax data)
(let* ((i (length data))
(newx (- xmax i)))
(if (= xmax i)
data
(foo-makex xmax ymax
(cons (foo-makey newx ymax '()) data)))))
(define (foo x y)
(foo-makex y x '()))
Output:
> (foo 3 2)
'(((1 . 1) (1 . 2) (1 . 3)) ((2 . 1) (2 . 2) (2 . 3)))
I can't answer your question as-is because I don't understand how the nested lists should work for >2 arguments. AFAIK there is no built-in function to do what you want.
To start you off, here is some code that generates output without nested lists. As an exercise try adjusting the code to do the nested listing. And see if there's a way you can make the code more efficient.
;;can take in any number of arguments
(define (permutations . nums)
(foldl
(lambda (current-num acc)
(append-map
(lambda (list-in-acc)
(for/list ((i (build-list current-num (curry + 1))))
(append list-in-acc (list i))))
acc))
(list (list))
(reverse nums)))
Example 1:
> (permutations 3 2)
'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3))
Example 2:
> (permutations 10)
'((1) (2) (3) (4) (5) (6) (7) (8) (9) (10))
Example 3:
> (permutations 2 3 4)
'((1 1 1)
(1 1 2)
(1 2 1)
(1 2 2)
(1 3 1)
(1 3 2)
(2 1 1)
(2 1 2)
(2 2 1)
(2 2 2)
(2 3 1)
(2 3 2)
(3 1 1)
(3 1 2)
(3 2 1)
(3 2 2)
(3 3 1)
(3 3 2)
(4 1 1)
(4 1 2)
(4 2 1)
(4 2 2)
(4 3 1)
(4 3 2))
(define (build-2d row col)
(build-list row (lambda(x) (build-list col (lambda(y) (list (+ x 1) (+ y 1))))))