Given the following list in Clojure:
(def pairs '[(2,1),(3,2),(2,4)])
I want to merge these based overlapping first item in the pair, and select the one with the greater second value.
ie I want them to merge into:
[(3,2),(2,4)]
because (2,1) and (2,4) have matching first values, and (2,4) has the greater second value, so it bumps off (2,1).
My question is: How do I merge pairs based on a nested value?
This is what I attempted:
(reduce
(fn [first-pair second-pair]
(if (not (= (first first-pair) (first second-pair)))
(conj first-pair second-pair)
(if (> (second first-pair) (second second-pair))
first-pair
second-pair)))
pairs
)
the simplest is to group all by first and then find max in each group:
user> (->> pairs
(group-by first)
vals
(map (fn [data] (apply max-key second data))))
;;=> ((2 4) (3 2))
also you can do it in one pass, without intermediate sequences:
user> (seq (reduce (fn [acc [f s]]
(update acc f (fnil max Double/NEGATIVE_INFINITY) s))
{} pairs))
;;=> ([2 4] [3 2])
If you don't mind the intermediate collection, you can group by first and the the max for each group. E.g.
user=> (map (partial apply max-key second) (vals (group-by first pairs)))
((2 4) (3 2))
Related
I have a function that can produce a list of n-element sublists from a list of elements but I am stuck in filtering out elements that are just permutations of each other. For example, f(A,B) -> ((A, B) (B,A)) is what I get but I just want ((A,B)) since (B,A) is a permutation. Is there a lisp function for this? I don't need the whole answer but a clue would be appreciated, note that A,B need not be atoms but can be string literals and even lists themselves.
I am doing this
(let (newlist '())
(loop :for x in l1 :do
(loop :for y in l2 :do
(push (list x y) newlist)))
... and I have another function that filters out these duplicates but it is clunky and probs won't scale for large inputs.
One interesting function is the (destructive) pushnew which pushes an element to a list only if it is not already existent in the set (list).
(defun pair-comb (l1 l2 &key (test #'eql) (key #'identity))
(let ((result '()))
(loop for x in l1 do
(loop for y in l2 do
(pushnew (list x y) result :test test :key key))
finally (return result))))
When we make the comparison between the elements in a way that it is order-agnostic, we would have the perfect function for us to collect different lists while ruling out the permutations of any of the already collected lists.
This can be done by #'sort-ing each list and compare by #'equalp or whatever equality function.
(pair-comb '(1 2 3) '(1 2 3 4 5) :test #'equalp :key (lambda (x) (sort x #'<)))
;;=> ((3 5) (3 4) (3 3) (2 5) (2 4) (2 3) (2 2) (1 5) (1 4) (1 3) (1 2) (1 1))
;; well, actually in this case #'eql would do it.
;; when using non-numeric elements, the `#'<` in sort has to be changed!
#lang racket
(define (cartesian-product . lists)
(foldr (lambda (xs ys)
(append-map (lambda (x)
(map (lambda (y)
(cons x y))
ys))
xs))
'(())
lists))
(cartesian-product '(1 2 3) '(5 6))
I have racket lang code, that calculate cartesian product of two sets or lists, I don't understand the code well, can any one convert code to pseudo code.
The function corresponds to this definition of cartesian products.
The dot . in the argument means that lists will collect all the arguments (in a list) no matter how many are passed in.
How to call such a function? Use apply. It applies a function using items from a list as the arguments: (apply f (list x-1 ... x-n)) = (f x-1 ... x-n)
foldr is just an abstraction over the natural recursion on lists
; my-foldr : [X Y] [X Y -> Y] Y [List-of X] -> Y
; applies fun from right to left to each item in lx and base
(define (my-foldr combine base lx)
(cond [(empty? lx) base]
[else (combine (first lx) (my-foldr func base (rest lx)))]))
Applying the simplifications from 1), 2) and 3) and turning the "combine" function in foldr to a separate helper:
(define (cartesian-product2 . lists)
(cond [(empty? lists) '(())]
[else (combine-cartesian (first lists)
(apply cartesian-product2 (rest lists)))]))
(define (combine-cartesian fst cart-rst)
(append-map (lambda (x)
(map (lambda (y)
(cons x y))
cart-rst))
fst))
(cartesian-product2 '(1 2 3) '(5 6))
Let's think about "what" combine-cartesian does: it simply converts a n-1-ary cartesian product to a n-ary cartesian product.
We want:
(cartesian-product '(1 2) '(3 4) '(5 6))
; =
; '((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))
We have (first lists) = '(1 2) and the result of the recursive call (induction):
(cartesian-product '(3 4) '(5 6))
; =
; '((3 5) (3 6) (4 5) (4 6))
To go from what we have (result of the recursion) to what we want, we need to cons 1 onto every element, and cons 2 onto every element, and append those lists. Generalizing this, we get a simpler reformulation of the combine function using nested loops:
(define (combine-cartesian fst cart)
(apply append
(for/list ([elem-fst fst])
(for/list ([elem-cart cart])
(cons elem-fst elem-cart)))))
To add a dimension, we consed every element of (first lists) onto every element of the cartesian product of the rest.
Pseudocode:
cartesian product <- takes in 0 or more lists to compute the set of all
ordered pairs
- cartesian product of no list is a list containing an empty list.
- otherwise: take the cartesian product of all but one list
and add each element of that one list to every
element of the cartesian product and put all
those lists together.
I'm trying to understand what count do.
I have read the documentation, and it says:
Returns (length (filter-map proc lst ...)), but without building the
intermediate list.
Then, I have read filter-map documentation, and it says:
Returns (filter (lambda (x) x) (map proc lst ...)), but without
building the intermediate list.
Then, I have read filter documentation, and I have understand it.
But, I don't understand filter-map. In particular that(lambda (x) x) in (filter (lambda (x) x) (map proc lst ...)).
What is the different between filter and filter-map?
By the way, the examples of filter and filter-map do the same and that make it more difficult to understand them.
I would say that the key insight here is that in the context of filter, you should read (lambda (x) x) as not-false?. So, the documentation for filter-map could be written to read:
Returns (filter not-false? (map proc lst ...)), but without building the intermediate list, where not-false? can be defined as (lambda (x) x).
The whole point is that if you know filter and map well, then you can explain filter-map like that. If you do not know what filter and map does it will not help you understand it. When you need to learn something new you often need to use prior experience. Eg. I can explain multiplication by saying 3 * 4 is the same as 3 + 3 + 3 + 3, but it doesn't help if you don't know what + is.
What is the difference between filter and filter-map
(filter odd? '(1 2 3 4 5)) ; ==> (1 3 5)
(filter-map odd? '(1 2 3 4 5)) ; ==> (#t #t #t))
The first collects the original values from the list when the predicate became truthy. In this case (odd? 1) is true and thus 1 is an element in the result.
filter-map doesn't filter on odd? it works as if you passed odd? to map. There you get a new list with the results.
(map odd? '(1 2 3 4 5)) ; ==> (#t #f #t #f #t #f)
Then it removes the false values so that you only have true values left:
(filter identity (map odd? '(1 2 3 4 5))) ; ==> (#t #t #t)
Now. It's important to understand that in Scheme every value except #f is true.
(lambda (x) x) is the identity function and is the same as identity in #lang racket. It returns its own argument.
(filter identity '(1 #f 2 #f 3)) ; ==> (1 2 3)
count works the same way as filter-map except it only returns how many element you would have got. Thus:
(count odd? '(1 2 3 4 5)) ; ==> 3
Now it mentions that it is the same as:
(length (filter identity (map odd? '(1 2 3 4 5)))
Execpt for the fact that the the code using map, filter, and length like that creates 2 lists. Thus while count does the same it does it without using map and filter. Now it seems this is a primitive, but you could do it like this:
(define (count fn lst)
(let loop ((lst lst) (cnt 0))
(cond ((null? lst) cnt)
((fn (car lst)) (loop (cdr lst) (add1 cnt)))
(else (loop (cdr lst) cnt))))
I am struggling to find the right approach to solve the following function
(FOO #'– '(1 2 3 4 5))
=> ((–1 2 3 4 5) (1 –2 3 4 5) (1 2 –3 4 5) (1 2 3 –4 5) (1 2 3 4 –5))
The first Parameter to the foo function is supposed to be a function "-" that has to be applied to each element returning a list of list as shown above. I am not sure as to what approach I can take to create this function. I thought of recursion but not sure how I will preserve the list in each call and what kind of base criteria would I have. Any help would be appreciated. I cannot use loops as this is functional programming.
It's a pity you cannot use loop because this could be elegantly solved like so:
(defun foo (fctn lst)
(loop
for n from 0 below (length lst) ; outer
collect (loop
for elt in lst ; inner
for i from 0
collect (if (= i n) (funcall fctn elt) elt))))
So we've got an outer loop that increments n from 0 to (length lst) excluded, and an inner loop that will copy verbatim the list except for element n where fctn is applied:
CL-USER> (foo #'- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
Replacing loop by recursion means creating local functions by using labels that replace the inner and the outer loop, for example:
(defun foo (fctn lst)
(let ((len (length lst)))
(labels
((inner (lst n &optional (i 0))
(unless (= i len)
(cons (if (= i n) (funcall fctn (car lst)) (car lst))
(inner (cdr lst) n (1+ i)))))
(outer (&optional (i 0))
(unless (= i len)
(cons (inner lst i) (outer (1+ i))))))
(outer))))
Part of the implementation strategy that you choose here will depend on whether you want to support structure sharing or not. Some of the answers have provided solutions where you get completely new lists, which may be what you want. If you want to actually share some of the common structure, you can do that too, with a solution like this. (Note: I'm using first/rest/list* in preference to car/car/cons, since we're working with lists, not arbitrary trees.)
(defun foo (operation list)
(labels ((foo% (left right result)
(if (endp right)
(nreverse result)
(let* ((x (first right))
(ox (funcall operation x)))
(foo% (list* x left)
(rest right)
(list* (revappend left
(list* ox (rest right)))
result))))))
(foo% '() list '())))
The idea is to walk down list once, keeping track of the left side (in reverse) and the right side as we've gone through them, so we get as left and right:
() (1 2 3 4)
(1) (2 3 4)
(2 1) (3 4)
(3 2 1) (4)
(4 3 2 1) ()
At each step but the last, we take the the first element from the right side, apply the operation, and create a new list use revappend with the left, the result of the operation, and the rest of right. The results from all those operations are accumulated in result (in reverse order). At the end, we simply return result, reversed. We can check that this has the right result, along with observing the structure sharing:
CL-USER> (foo '- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
By setting *print-circle* to true, we can see the structure sharing:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '(1 2 3 4 5)))
(list l (foo '- l)))
((1 . #1=(2 . #2=(3 . #3=(4 . #4=(5))))) ; input L
((-1 . #1#)
(1 -2 . #2#)
(1 2 -3 . #3#)
(1 2 3 -4 . #4#)
(1 2 3 4 -5)))
Each list in the output shares as much structure with the original input list as possible.
I find it easier, conceptually, to write some of these kind of functions recursively, using labels, but Common Lisp doesn't guarantee tail call optimization, so it's worth writing this iteratively, too. Here's one way that could be done:
(defun phoo (operation list)
(do ((left '())
(right list)
(result '()))
((endp right)
(nreverse result))
(let* ((x (pop right))
(ox (funcall operation x)))
(push (revappend left (list* ox right)) result)
(push x left))))
The base case of a recursion can be determined by asking yourself "When do I want to stop?".
As an example, when I want to compute the sum of an integer and all positive integers below it, I can do this recusively with a base case determined by answering "When do I want to stop?" with "When the value I might add in is zero.":
(defun sumdown (val)
(if (zerop val)
0
(+ (sumdown (1- val)) val)))
With regard to 'preserve the list in each call', rather than trying to preserve anything I would just build up a result as you go along. Using the 'sumdown' example, this can be done in various ways that are all fundamentally the same approach.
The approach is to have an auxiliary function with a result argument that lets you build up a result as you recurse, and a function that is intended for the user to call, which calls the auxiliary function:
(defun sumdown1-aux (val result)
(if (zerop val)
result
(sumdown1-aux (1- val) (+ val result))))
(defun sumdown1 (val)
(sumdown1-aux val 0))
You can combine the auxiliary function and the function intended to be called by the user by using optional arguments:
(defun sumdown2 (val &optional (result 0))
(if (zerop val)
result
(sumdown2 (1- val) (+ val result))))
You can hide the fact that an auxiliary function is being used by locally binding it within the function the user would call:
(defun sumdown3 (val)
(labels ((sumdown3-aux (val result)
(if (zerop val)
result
(sumdown3-aux (1- val) (+ val result)))))
(sumdown3-aux val 0)))
A recursive solution to your problem can be implemented by answering the question "When do I want to stop when I want to operate on every element of a list?" to determine the base case, and building up a result list-of-lists (instead of adding as in the example) as you recurse. Breaking the problem into smaller pieces will help - "Make a copy of the original list with the nth element replaced by the result of calling the function on that element" can be considered a subproblem, so you might want to write a function that does that first, then use that function to write a function that solves the whole problem. It will be easier if you are allowed to use functions like mapcar and substitute or substitute-if, but if you are not, then you can write equivalents yourself out of what you are allowed to use.
(defun occurrences (l)
(let (
(result (mapcar #'(lambda (elt) (cons elt (count elt l)) )
(remove-duplicates l) ) )
(result2 nil)
(result3 nil)
(result4 nil)
)
(progn
(sort result #'> :key #'cdr)
(loop for x in result
do (and(push (car x) result2)(push (cdr x) result3))
)
)))
This should return a sorted list occurrences in ascending order. With the exception that the elements that repeat a minimum number of times (in contract with the rest of the list) should not be returned. Unless all the elements repeat equal number of times, then only in this situation all the elements get returned.
For instance,
( occurrences '(1 2 3)) => (1 2 3), #notice each element repeats same # of times.
( occurrences '(1 1 3)) => (1) #since there 1 occurs more frequently than any other element in the list.
3 ( occurrences '(1 2 3 4 6 6 6 6)) => (6)
( occurrences '(1 1 3 3 0)) => (1, 3). #since (1 2), (3 2) and (0 1)
Because the occurrences of elements 1 and 3 are still higher than at least one element's occurrence in such list.
Note: Right now this function returns a sorted list, but incorrectly returns max values (number of occ.) plus elements, which occurrences, are not at least larger than one other element in the list.
Ex.
(occurrences '(7 7 7 1 2 3)) returns (7 1 2 3) but should only return 7. I would really appreciate the some help fixing this function to return whats expected.
A solution that uses your initial approach is the following:
(defun max-occurrences(l)
(let* ((occurrences (remove-duplicates
(mapcar #'(lambda (elt) (cons elt (count elt l))) l)
:test 'equal))
(max-occurrence (reduce #'max occurrences :initial-value 0 :key #'cdr)))
(mapcar #'car (remove-if-not (lambda(x) (= x max-occurrence)) occurrences :key #'cdr))))
However, this solution is not efficient, since it has a cost of O(n2) (in the initial phase, each element of the list is compared with all the others to count its frequency).
Edited
A more efficient solution could be obtained for instance by using a hash table (with the improvement suggested in the comment by #uselpa):
(defun max-occurrences(l)
(let* ((table (make-hash-table))
(max-count (loop for elt in l maximize (incf (gethash elt table 0)))))
(loop for elt being the hash-key of table using (hash-value count)
when (= count max-count) collect elt)))