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.
Related
I'm trying to sort the elements of the following list by using the third element of each sublist:
((v 1 a) (v 3 d) (v 6 b) (v 2 c))
So the result should be:
((v 1 a) (v 6 b) (v 2 c) (v 3 d))
I've tried something like this:
(sort (copy-seq my-list) #'> :key (lambda (x) (third (car x))) )
but it doesn't really work and I'm not sure how should I do this.
CL-USER 15 > (sort (copy-seq '((v 1 a) (v 3 d) (v 6 b) (v 2 c)))
#'string<
:key #'third)
((V 1 A) (V 6 B) (V 2 C) (V 3 D))
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 -))
When reaching my recursion cases, I use list to append the future result with the current one, but I end up with a nested list because of recursion. This causes an error when I have a number that causes recursion for more than five times.
Any ideas how I can get results in a single plain non-nested list, e.g.:
CL-USER 100 : 8 > (BINARY_LIST 4)
(1 0 0)
Code & Example output:
CL-USER 99 : 8 > (defun binary_list (i)
(COND
((= i 0) 0)
((= i 1) 1)
((= (mod i 2) 0) (list (binary_list (truncate i 2)) 0))
(t (list (binary_list (truncate i 2)) 1))
)
)
BINARY_LIST
CL-USER 100 : 8 > (BINARY_LIST 4)
((1 0) 0)
CL-USER 101 : 8 > (BINARY_LIST 104)
((((# 1) 0) 0) 0)
You are almost there. All you need to do is to replace list with nconc:
(defun binary-list (n)
(cond ((= n 0) (list 0))
((= n 1) (list 1))
(t (nconc (binary-list (truncate n 2)) (list (mod n 2))))))
You can avoid calling both truncate and mod by collecting both values in integer division:
(defun binary-list (n)
(assert (>= n 0))
(multiple-value-bind (q r) (floor n 2)
(if (zerop q)
(list r)
(nconc (binary-list q) (list r)))))
Note that this algorithm is quadratic because nconc has to traverse the result on each iteration. This can be avoided by passing an accumulator:
(defun binary-list (n &optional acc)
(assert (>= n 0))
(multiple-value-bind (q r) (floor n 2)
(if (zerop q)
(cons r acc)
(binary-list q (cons r acc)))))
Now we have a tail-recursive function which can be compiled to iteration by a modern compiler.
One more optimization trick you could use (which, in fact, should be done by the compiler - try disassemble to check!) is using ash and logand instead of the much more general and expensive floor:
(defun binary-list (n &optional acc)
(cond ((zerop n) (or acc (list 0)))
((plusp n)
(binary-list (ash n -1) (cons (logand 1 n) acc)))
(t (error "~S: non-negative argument required, got ~s" 'binary-list n))))
Incidentally, lispers usually use dash instead of underscores in symbols, so your binary_list should be binary-list if you do not want to offend our tender aesthetics.
this seems to me to be the most direct, least roundabout manner to achieve the desired results every time:
(defun mvp-binary-from-decimal (n r)
(if (zerop n)
r
(multiple-value-bind (a b)
(floor n 2)
(mvp-binary-from-decimal a (cons b r)))))
(defun binary-from-decimal (n)
(if (and (numberp n) (plusp n))
(mvp-binary-from-decimal n '())
(if (eql n 0) '(0) nil)))
tested in slime, sbcl, clisp - used as follows:
CL-USER> (binary-from-decimal 100)
(1 1 0 0 1 0 0)
CL-USER> (binary-from-decimal 10)
(1 0 1 0)
CL-USER> (binary-from-decimal 0)
(0)
there are some advanced reasons as to why this might be the most desirable manner in which to implement such functionality, but for now, suffice to say that it is clean, polite, readable and always works.
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)))))
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))))))