does anyone know how to count all numbers or characters in list and print it in pair in this format: (number . number_of_occurrences). For example:
(count '(3 1 3 2 1 2 3 3 3))
((3 . 5) (1 . 2) (2 . 2))
(count '(d b a c b b a))
((d . 1) (b . 3) (a . 2) (c . 1))
Thanks in advance for helping me :)
Here's an idea - use a hash table to keep track of the number of occurrences. This is an O(n) procedure:
(define (counter lst)
(let ((counts (make-hash)))
(let loop ((lst lst))
(cond ((null? lst)
(hash->list counts))
(else
(hash-update! counts (car lst) add1
(lambda () 0))
(loop (cdr lst)))))))
Alternatively, here's a simpler version (it doesn't use filter) of #mobyte's solution in Scheme - noticing that this is O(n^2) and hence less efficient than the hash table-based procedure:
(define (counter lst)
(map (lambda (e)
(cons e (count (curry equal? e) lst)))
(remove-duplicates lst)))
Either way, It works as expected:
(counter '(3 1 3 2 1 2 3 3 3))
=> '((3 . 5) (2 . 2) (1 . 2))
(counter '(d b a c b b a))
=> '((b . 3) (a . 2) (d . 1) (c . 1))
This is solution in clojure. But I hope it'll be helpful:
(defn counter [l]
(map (fn [e]
[e (count (filter #{e} l))])
(distinct l)))
(counter [3 1 3 2 1 2 3 3 3])
-> ([3 5] [1 2] [2 2])
(counter '(d b a c b b a))
-> ([d 1] [b 3] [a 2] [c 1])
Related
for example:
(duplicate 3 (list 1 2 3)) = (list 1 1 1 2 2 2 3 3 3)
i tried this:
(define (duplicate n l)
(cond [(zero? n) empty]
[else (cons l (duplicate (sub1 n) l))]))
but it gives me:
(duplicate 2 (list 1 2)) = (list (list 1 2) (list 1 2))
You are actually half way. What you have created is something that takes one element and a count and makes a list of that many elements.
(duplicate 3 'e) ; ==> (3 3 3)
That means that you can use that:
(duplicate-list 3 l)
; ==> (append (duplicate 3 (car l))
; (duplicate-list 3 (cdr l)))
(define (duplicate n x)
"Repeat x n times."
(cond [(zero? n) empty]
[else (cons x (duplicate (sub1 n) x))]))
(define (mappend fn . lists)
"map but appending the results."
(apply append (apply map fn lists)))
(define (duplicate-list n l)
"duplicate each element in l."
(mappend (lambda (x) (duplicate n x)) l))
Then
(duplicate-list 3 (list 1 2 3))
;; '(1 1 1 2 2 2 3 3 3)
Hello i have to programm this fucntion in lisp:
(defun combine-list-of-lsts (lst)...)
So when executing the function i should get
(combine-list-of-lsts '((a b c) (+-) (1 2 3 4)))
((A + 1) (A + 2) (A + 3) (A + 4) (A-1) (A-2) (A-3) (A-4) (B + 1) (B + 2) (B + 3) (B + 4) (B-1) (B-2) (B-3) (B-4)(C + 1) (C + 2) (C + 3) (C + 4) (C-1) (C-2) (C-3) (C-4))
What i have now is:
(defun combine-list-of-lsts (lst)
(if (null (cdr lst))
(car lst)
(if (null (cddr lst))
(combine-lst-lst (car lst) (cadr lst))
(combine-lst-lst (car lst) (combine-list-of-lsts (cdr lst))))))
Using this auxiliar functions:
(defun combine-lst-lst (lst1 lst2)
(mapcan #'(lambda (x) (combine-elt-lst x lst2)) lst1))
(defun combine-elt-lst (elt lst)
(mapcar #'(lambda (x) (list elt x)) lst))
But what i get with this:
((A (+ 1)) (A (+ 2)) (A (+ 3)) (A (+ 4)) (A(-1)) (A(-2)) (A(-3)) (A(-4))...)
I dont know how to make this but without the parenthesis
The first thing is to look at this case:
(combine-list-of-lsts '((a b c)))
What should that be? Maybe not what your function returns...
Then I would look at the function combine-list-of-lsts. Do you need two IF statements?
Then look at combine-elt-lst. Do you really want to use LIST? It creates a new list. Wouldn't it make more sense to just add the element to the front?
Usually, when you want to reduce mutliple arguments into single result, you need function #'reduce. Your combination of lists has name cartesian n-ary product.
Following function:
(defun cartesian (lst1 lst2)
(let (acc)
(dolist (v1 lst1 acc)
(dolist (v2 lst2)
(push (cons v1 v2) acc)))))
creates cartesian product of two supplied lists as list of conses, where #'car is an element of lst1, and #'cdr is an element of lst2.
(cartesian '(1 2 3) '(- +))
==> ((3 . -) (3 . +) (2 . -) (2 . +) (1 . -) (1 . +))
Note, however, that calling #'cartesian on such product will return malformed result - cons of cons and element:
(cartesian (cartesian '(1 2) '(+ -)) '(a))
==> (((1 . +) . A) ((1 . -) . A) ((2 . +) . A) ((2 . -) . A))
This happens, because members of the first set are conses, not atoms. On the other hand, lists are composed of conses, and if we reverse order of creating products, we could get closer to flat list, what is our goal:
(cartesian '(1 2)
(cartesian '(+ -) '(a)))
==> ((2 + . A) (2 - . A) (1 + . A) (1 - . A))
To create proper list, we only need to cons each product with nil - in other words to create another product.
(cartesian '(1 2)
(cartesian '(+ -)
(cartesian '(a) '(nil))))
==> ((2 + A) (2 - A) (1 + A) (1 - A))
Wrapping everything up: you need to create cartesian product of successive lists in reversed order, having last being '(nil), what can be achieved with reduce expression. Final code will look something like this:
(defun cartesian (lst1 lst2)
(let (acc)
(dolist (v1 lst1 acc)
(dolist (v2 lst2)
(push (cons v1 v2) acc)))))
(defun combine-lsts (lsts)
(reduce
#'cartesian
lsts
:from-end t
:initial-value '(nil)))
There is one more way you can try,
(defun mingle (x y)
(let ((temp nil))
(loop for item in x do
(loop for it in y do
(cond ((listp it) (setf temp (cons (append (cons item 'nil) it) temp)))
(t (setf temp (cons (append (cons item 'nil) (cons it 'nil)) temp))))))
temp))
Usage:(mingle '(c d f) (mingle '(1 2 3) '(+ -))) =>
((F 1 +) (F 1 -) (F 2 +) (F 2 -) (F 3 +) (F 3 -) (D 1 +) (D 1 -) (D 2 +)
(D 2 -) (D 3 +) (D 3 -) (C 1 +) (C 1 -) (C 2 +) (C 2 -) (C 3 +) (C 3 -))
I'm trying to implement a method that will take a list of lists and return a the cartesian product of these lists.
Here's what I have so far:
(defn cart
([] '())
([l1] (map list l1))
([l1 l2]
(map
(fn f[x] (map
(fn g [y] (list x y))
l2))
l1)
)
)
(defn cartesian-product [& lists]
(reduce cart lists)
)
;test cases
(println (cartesian-product '(a b) '(c d))) ; ((a c) (a d) (b c) (b d))
(println (cartesian-product ())) ;()
(println (cartesian-product '(0 1))) ; ((0) (1))
(println (cartesian-product '(0 1) '(0 1))) ; ((0 0) (0 1) (1 0) (1 1))
(println (apply cartesian-product (take 4 (repeat (range 2))))) ;((0 0 0 0) (0 0 0 1) (0 0 1 0) (0 0 1 1) (0 1 0 0) (0 1 0 1) (0 1 1 0) (0 1 1 1) (1 0 0 0) (1 0 0 1) (1 0 1 0) (1 0 1 1) (1 1 0 0) (1 1 0 1) (1 1 1 0) (1 1 1 1))
The problem is my solution is really 'brackety'.
(((a c) (a d)) ((b c) (b d)))
()
(0 1)
(((0 0) (0 1)) ((1 0) (1 1)))
(((((((0 0) (0 1)) 0) (((0 0) (0 1)) 1)) 0) (((((0 0) (0 1)) 0) (((0 0) (0 1)) 1)) 1)) ((((((1 0) (1 1)) 0) (((1 0) (1 1)) 1)) 0) (((((1 0) (1 1)) 0) (((1 0) (1 1)) 1)) 1)))
I tried adding
(apply concat(reduce cart lists))
but then I get a crash like so:
((a c) (a d) (b c) (b d))
()
IllegalArgumentException Don't know how to create ISeq from: java.lang.Long clojure.lang.RT.seqFrom (RT.java:494)
So, I think I'm close but missing something. However since I'm so new to clojure and functional programming I could be on the completely wrong track. Please help! :)
This is a lot easier to do as a for-comprehension than by trying to work out the recursion manually:
(defn cart [colls]
(if (empty? colls)
'(())
(for [more (cart (rest colls))
x (first colls)]
(cons x more))))
user> (cart '((a b c) (1 2 3) (black white)))
((a 1 black) (a 1 white) (a 2 black) (a 2 white) (a 3 black) (a 3 white)
(b 1 black) (b 1 white) (b 2 black) (b 2 white) (b 3 black) (b 3 white)
(c 1 black) (c 1 white) (c 2 black) (c 2 white) (c 3 black) (c 3 white))
The base case is obvious (it needs to be a list containing the empty list, not the empty list itself, since there is one way to take a cartesian product of no lists). In the recursive case, you just iterate over each element x of the first collection, and then over each cartesian product of the rest of the lists, prepending the x you've chosen.
Note that it's important to write the two clauses of the for comprehension in this slightly unnatural order: swapping them results in a substantial slowdown. The reason for this is to avoid duplicating work. The body of the second binding will be evaluated once for each item in the first binding, which (if you wrote the clauses in the wrong order) would mean many wasted copies of the expensive recursive clause. If you wish to be extra careful, you can make it clear that the two clauses are independent, by instead writing:
(let [c1 (first colls)]
(for [more (cart (rest colls))
x c1]
(cons x more)))
I would check https://github.com/clojure/math.combinatorics it has
(combo/cartesian-product [1 2] [3 4])
;;=> ((1 3) (1 4) (2 3) (2 4))
For the sake of comparison, in the spirit of the original
(defn cart
([xs]
xs)
([xs ys]
(mapcat (fn [x] (map (fn [y] (list x y)) ys)) xs))
([xs ys & more]
(mapcat (fn [x] (map (fn [z] (cons x z)) (apply cart (cons ys more)))) xs)))
(cart '(a b c) '(d e f) '(g h i))
;=> ((a d g) (a d h) (a d i) (a e g) (a e h) (a e i) (a f g) (a f h) (a f i)
; (b d g) (b d h) (b d i) (b e g) (b e h) (b e i) (b f g) (b f h) (b f i)
; (c d g) (c d h) (c d i) (c e g) (c e h) (c e i) (c f g) (c f h) (c f i))
I know I'm late to the party -- I just wanted to add a different approach, for the sake of completeness.
Compared to amalloy's approach, it is lazy too (the parameter lists are eagerly evaluated, though) and slightly faster when all results are required (I tested them both with the demo code below), however it is prone to stack overflow (much like the underlying for comprehension it generates and evaluates) as the number of lists increases. Also, keep in mind that eval has a limit to the size of the code it can be passed to.
Consider first a single instance of the problem: You want to find the cartesian product of [:a :b :c] and '(1 2 3). The obvious solution is to use a for comprehension, like this:
(for [e1 [:a :b :c]
e2 '(1 2 3)]
(list e1 e2))
; ((:a 1) (:a 2) (:a 3) (:b 1) (:b 2) (:b 3) (:c 1) (:c 2) (:c 3))
Now, the question is: Is it possible to generalize this in a way that works with an arbitrary number of lists? The answer here is affirmative. This is what the following macro does:
(defmacro cart [& lists]
(let [syms (for [_ lists] (gensym))]
`(for [~#(mapcat list syms lists)]
(list ~#syms))))
(macroexpand-1 '(cart [:a :b :c] '(1 2 3)))
; (clojure.core/for [G__4356 [:a :b :c]
; G__4357 (quote (1 2 3))]
; (clojure.core/list G__4356 G__4357))
(cart [:a :b :c] '(1 2 3))
; ((:a 1) (:a 2) (:a 3) (:b 1) (:b 2) (:b 3) (:c 1) (:c 2) (:c 3))
Essentially, you have the compiler generate the appropriate for comprehension for you. Converting this to a function is pretty straightforward, but there is a small catch:
(defn cart [& lists]
(let [syms (for [_ lists] (gensym))]
(eval `(for [~#(mapcat #(list %1 `'~%2) syms lists)]
(list ~#syms)))))
(cart [:a :b :c] '(1 2 3))
; ((:a 1) (:a 2) (:a 3) (:b 1) (:b 2) (:b 3) (:c 1) (:c 2) (:c 3))
Lists that are left unquoted are treated as function calls, which is why quoting %2 is necessary here.
Online Demo:
; https://projecteuler.net/problem=205
(defn cart [& lists]
(let [syms (for [_ lists] (gensym))]
(eval `(for [~#(mapcat #(list %1 `'~%2) syms lists)]
(list ~#syms)))))
(defn project-euler-205 []
(let [rolls (fn [n d]
(->> (range 1 (inc d))
(repeat n)
(apply cart)
(map #(apply + %))
frequencies))
peter-rolls (rolls 9 4)
colin-rolls (rolls 6 6)
all-results (* (apply + (vals peter-rolls))
(apply + (vals colin-rolls)))
peter-wins (apply + (for [[pk pv] peter-rolls
[ck cv] colin-rolls
:when (> pk ck)]
(* pv cv)))]
(/ peter-wins all-results)))
(println (project-euler-205)) ; 48679795/84934656
Personally, I would use amalloy's for solution. My general rule of thumb is that if my loop can be expressed as a single map/filter/etc call with a simple function argument (so a function name or short fn/#() form), its better to use the function. As soon as it gets more complex than that, a for expression is far easier to read. In particular, for is far better than nested maps. That said, if I didn't use for here, this is how I'd write the function:
(defn cart
([] '(()))
([xs & more]
(mapcat #(map (partial cons %)
(apply cart more))
xs)))
Things to note: First, there's no need for the reduce. Recursion can handle it just fine.
Second, only two cases. We can call the function just fine on an empty list, so all we care about is empty vs non-empty.
Third, as amalloy explained, the correct value of (cart) is '(()). This is actually rather subtle, and I reliably mess this up when I write a function like this. If you walk through a simple case very carefully, you should be able to see why that value makes the recursion work.
Fourth, I generally don't like to use fn. This is more of a personal preference, but I always use #(), partial, or comp if I can get away with it. #() is definitely idiomatic for smaller functions, though the other two are a bit less common.
Fifth, some style notes. The biggest issue is indentation. The best suggestion here is to find an editor that auto-indents lisp code. Auto-indentation is one of the most important things for your editor to provide, since it makes it blindingly obvious when your parens don't match up. Also, closing parens never go on their own line, fns don't need internal names unless you are planning on recursing, and I generally have a few more newlines than you do. I like to think that my code above is reasonably decently styled, and as another example, here is how I would format your code:
(defn cart
([] '())
([l1] (map list l1))
([l1 l2]
(map (fn [x]
(map (fn [y]
(list x y))
l2))
l1)))
(defn cartesian-product [& lists]
(reduce cart lists))
For most purposes Alan's answer is great as you get a lazy comprehension, and a lazy seq will not cause a stack overflow as you realize its members, even if you do not use (recur).
I was interested in trying to craft the tail recursive version with explicit recur, not the least of which because laziness wasn't going to be of any help in my application, but also for fun and giggles:
(defn cartesian-product
([cols] (cartesian-product '([]) cols))
([samples cols]
(if (empty? cols)
samples
(recur (mapcat #(for [item (first cols)]
(conj % item)) samples)
(rest cols)))))
I'll explain in math, here's the transformation I'm struggling to write Scheme code for:
(f '(a b c) '(d e f)) = '(ad (+ bd ae) (+ cd be af) (+ ce bf) cf)
Where two letters together like ad means (* a d).
I'm trying to write it in a purely functional manner, but I'm struggling to see how. Any suggestions would be greatly appreciated.
Here are some examples:
(1mul '(0 1) '(0 1)) = '(0 0 1)
(1mul '(1 2 3) '(1 1)) = '(1 3 5 3)
(1mul '(1 2 3) '(1 2)) = '(1 4 7 6)
(1mul '(1 2 3) '(2 1)) = '(2 5 8 3)
(1mul '(1 2 3) '(2 2)) = '(2 6 10 6)
(1mul '(5 5 5) '(1 1)) = '(5 10 10 5)
(1mul '(0 0 1) '(2 5)) = '(0 0 2 5)
(1mul '(1 1 2 3) '(2 5)) = '(2 7 9 16 15)
So, the pattern is like what I posted at the beginning:
Multiply the first number in the list by every number in the second list (ad, ae, af) and then continue along, (bd, be, bf, cd, ce, cf) and arrange the numbers "somehow" to add the corresponding values. The reason I call it overlapping is because you can sort of visualize it like this:
(list
aa'
(+ ba' ab')
(+ ca' bb' ac')
(+ cb' bc')
cc')
Again,
(f '(a b c) '(d e f)) = '(ad (+ bd ae) (+ cd be af) (+ ce bf) cf)
However, not just for 3x3 lists, for any sized lists.
Here's my code. It's in racket
#lang racket
(define (drop n xs)
(cond [(<= n 0) xs]
[(empty? xs) '()]
[else (drop (sub1 n) (rest xs))]))
(define (take n xs)
(cond [(<= n 0) '()]
[(empty? xs) '()]
[else (cons (first xs) (take (sub1 n) (rest xs)))]))
(define (mult as bs)
(define (*- a b)
(list '* a b))
(define degree (length as))
(append
(for/list ([i (in-range 1 (+ 1 degree))])
(cons '+ (map *- (take i as) (reverse (take i bs)))))
(for/list ([i (in-range 1 degree)])
(cons '+ (map *- (drop i as) (reverse (drop i bs)))))))
The for/lists are just ways of mapping over a list of numbers and collecting the result in a list. If you need, I can reformulate it just maps.
Is this a good candidate for recursion? Not sure, but here's a
a direct translation of what you asked for.
(define (f abc def)
(let ((a (car abc)) (b (cadr abc)) (c (caddr abc))
(d (car def)) (e (cadr def)) (f (caddr def)))
(list (* a d)
(+ (* b d) (* a e))
(+ (* c d) (* b e) (* a f))
(+ (* c e) (* b f))
(* c f))))
Is it correct to assume, that you want to do this computation?
(a+b+c)*(d+e+f) = a(d+e+f) + b(d+e+f) + c(d+e+f)
= ad+ae+af + bd+be+bf + cd+ce+cf
If so, this is simple:
(define (f xs ys)
(* (apply + xs) (apply + ys))
If you are interested in the symbolic version:
#lang racket
(define (f xs ys)
(define (fx x)
(define (fxy y)
(list '* x y))
(cons '+ (map fxy ys)))
(cons '+ (map fx xs)))
And here is a test:
> (f '(a b c) '(d e f))
'(+ (+ (* a d) (* a e) (* a f))
(+ (* b d) (* b e) (* b f))
(+ (* c d) (* c e) (* c f)))
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))))))