I try to implement a function that computes the Lagrange's four-square theorem with a natural number n in scheme. However I haven't any idea to do that... Can someone give me a example/code please?
For example, a^2 + b^2 + c^2 + d^2 = n, where n is the input of the function.
You can do this with two functions (main & auxiliary):
If n is natural, (lagrange n) gives the list of all the quadruplets (a, b, c, d) such as a^2 + b^2 + c^2 + d^2 = n.
(define lagrange
(lambda (n)
(lagrange-aux 4 0 n)))
(define lagrange-aux
(lambda (size m sum)
(cond ((and (zero? size) (zero? sum)) '(()))
((or (zero? size) (> (* m m) sum)) '())
(else (append (map (lambda (x) (cons m x))
(lagrange-aux (- size 1) 0 (- sum (* m m))))
(lagrange-aux size (+ m 1) sum))))))
Example:
(lagrange 13) ==>
((0 0 2 3) (0 0 3 2) (0 2 0 3) (0 2 3 0) (0 3 0 2) (0 3 2 0)
(1 2 2 2) (2 0 0 3) (2 0 3 0) (2 1 2 2) (2 2 1 2) (2 2 2 1)
(2 3 0 0) (3 0 0 2) (3 0 2 0) (3 2 0 0))
Related
I am trying to display a Fibonacci sequence less than an upper bound, but I'm having trouble printing out the series that is constrained by that upper bound.
Without using imperative programming principles with declaring variables such as setf, setq, and set, etc. How can I solve this problem?
So far I have
(defun fibonacci (n &optional (a 0) (b 1))
(if (or (zerop n) (< a n)
nil)
(cons a (fibonacci (1- n) b (+ a b)))))
Expected output of (fibonacci 100): (0 1 1 2 3 5 8 13 21 34 55 89). However, what I am getting is (0 1 1 2 3 5 8 13 21 34 55).
You are decreasing upper bound for no reason. When you remove 1- and move one ) to right place, it works as expected:
(defun fibonacci (n &optional (a 0) (b 1))
(if (or (zerop n) (> a n))
nil
(cons a (fibonacci n b (+ a b)))))
Tests:
CL-USER 4 > (fibonacci 10)
(0 1 1 2 3 5 8)
CL-USER 5 > (fibonacci 100)
(0 1 1 2 3 5 8 13 21 34 55 89)
What you meant is
(defun fibonacci (n &optional (a 0) (b 1))
(if (or (zerop n) (> a n))
nil
(cons a (fibonacci n b (+ a b)))))
You had a ) placement typo / error, and the flipped test. Also, n is the upper limit, not a count. So there's no reason to decrease it.
For my homework problem, I have to remove the duplicates in a list if part of the list is inside another. The expected outcome is supposed to be this:
(remove-redundant '((R (1 2 3 8 e 4 7 6 5))
(U (e 2 3 1 8 4 7 6 5))
(D (1 2 3 7 8 4 e 6 5)))
'((D (1 2 3 e 8 4 7 6 5))
(L (e 2 3 1 8 4 7 6 5))
(U (2 e 3 1 8 4 7 6 5))
(U (2 8 3 1 e 4 7 6 5))))
Returns:
((R (1 2 3 8 e 4 7 6 5)) (D (1 2 3 7 8 4 e 6 5)))
It is supposed to check to see if the list inside each list, for the 1st parameter appears anywhere in the 2nd. If it does appear, then remove that from the 1st list. Basically, if (1 2 3 e 8 4 7 6 5) matches something in the 1st list, remove it from the 1st list. I need to do this recursively, it is supposed to be a functional program.
I have already tried recursing through the list, but it doesn't reset (i.e. it will check the second list for the beginning of the first list but then will return.
(defun same-state (l1 l2)
(if (equal (cadr l1) (cadr l2)) t nil))
(defun remove-redundant (l1 l2)
(cond
((null l2) l1)
((null l1) nil)
((same-state (car l1) (car l2)) (remove-redundant (cdr l1) (cdr l2))
(T (remove-redundant l1 (cdr l2)))))
You're close, but there should be some accumulation of the cells you want to keep in the t case of your cond form,
eg.
;; ...
(t
(cons (car l1) (remove-redundant (cdr l1) (cdr l2))))
and when you check if the first element of l1 exists in l2 there should be another loop or recursion to check against all the elements in l2, eg.
(defun same-state (l1 l2)
(find l1 l2 :key #'cadr :test #'equal))
(defun remove-redundant (l1 l2)
(cond
((null l2) l1)
((null l1) nil)
((same-state (cadar l1) l2)
(remove-redundant (cdr l1) (cdr l2)))
(t (cons (car l1)
(remove-redundant (cdr l1) (cdr l2))))))
;; => ((R (1 2 3 8 e 4 7 6 5)) (D (1 2 3 7 8 4 e 6 5)))
You will need two loops: one to go through the first list, and then one per element of that to find matches in the second list.
I'm still learning Scheme.
If have these two list of lists:
'((1 2 (3 4) 5) (12 13 4))
'((3 4 9) (7 6 5 4))
I want to get this list:
'((1 2 (3 4) 5) (12 13 4) (3 4 9) (7 6 5 4))
But with cons:
(cons '((1 2 (3 4) 5) (12 13 4)) '((3 4 9) (7 6 5 4)))
I get this list:
'(((1 2 (3 4) 5) (12 13 4)) (3 4 9) (7 6 5 4))
NOTE:
In this example the both lists has two sublists. But they can have n sub-lists.
I have tried with append but it doesn't work when one of the list of lists is only a list:
(append '(1 2 3 4) '((23 24 25 26) (a b c)))
> '(1 2 3 4 (23 24 25 26) (a b c))
Is there a function that do it or do I have to implement it?
The behavior that you want is very specific, you won't find it in the standard library. Good news is, it's simple to implement in a portable and efficient way that covers all the possible cases, assuming that the input lists are non-empty:
(define (my-append lst1 lst2)
(cond ((and (pair? (car lst1)) (pair? (car lst2)))
(append lst1 lst2))
((pair? (car lst1))
(append lst1 (list lst2)))
((pair? (car lst2))
(append (list lst1) lst2))
(else
(append (list lst1) (list lst2)))))
For example:
(my-append '((1 2 (3 4) 5) (12 13 4)) '((3 4 9) (7 6 5 4)))
=> '((1 2 (3 4) 5) (12 13 4) (3 4 9) (7 6 5 4))
(my-append '(1 2 3 4) '((23 24 25 26) (a b c)))
=> '((1 2 3 4) (23 24 25 26) (a b c))
Take integer partition problem for example, I can write the following code to output all partitions of a positive integer n:
(defn foo
([n] (foo n n []))
([n k buf]
(if (zero? n)
(println buf)
(doseq [i (range 1 (inc (min n k)))]
(foo (- n i) i (conj buf i))))))
Then (foo 5) outputs:
[1 1 1 1 1]
[2 1 1 1]
[2 2 1]
[3 1 1]
[3 2]
[4 1]
[5]
The question is how could I write a function bar which generates a lazy-seq containing such results? For example, I want (bar 5) generates ([1 1 1 1 1] [2 1 1 1] [2 2 1] [3 1 1] [3 2] [4 1] [5]).
Here is a roughly equivalent function generating the partitions as a sequence of sequences:
(defn bar
([n] (bar n n))
([n k]
(if (zero? n)
[[]]
(for [i (range 1 (inc (min n k))), tail (bar (- n i) i)]
(cons i tail)))))
For example,
(bar 5)
; ((1 1 1 1 1) (2 1 1 1) (2 2 1) (3 1 1) (3 2) (4 1) (5))
How lazy is bar?
for is lazy.
to make it lazier, wrap the body in a lazy-seq.
I have my doubts about the above.
The function recurses to depth n.
Wrapping the body in lazy-seq I suspect just stacks up lazy
sequences, producing just as deep a recursive call stack on accessing the
first element.
Besides, the same tails are repeatedly computed; the more so since (bar n k) is the same for all k >= n.
If performance of this function is a specific concern, there are iterative algorithms with constant time per step. As #CharlesDuffy's comment implies, these can be re-jigged to produce lazy sequences.
Why gaze into the crystal ball when you can read the book?
The standard namespace clojure.math.combinatorics, hosted here, contains a partition function that produces a lazy sequence of the partitions of any sequence of objects - fast. Integer partition is where we count the elements of each partition of identical objects. They come out in reverse lexicographic order.
For example
(map #(map count %) (combo/partitions (repeat 5 :whatever)))
;((5) (4 1) (3 2) (3 1 1) (2 2 1) (2 1 1 1) (1 1 1 1 1))
No doubt the code can be stripped down to deal with just this case.
Here is recursive solution. There are some ways to optimize it and code is not the best.
(defn partitions [n]
(loop [m n
res [(init-step n m)]]
(let [l (last res)]
(if (= m 1)
res
(if (last-step? (last res))
(recur (- m 1) (vec (conj res (init-step n (- m 1)))))
(recur m (next-step res)))))))
(defn init-step [n m]
(if (= n m)
[n]
(loop [res [m (- n m)]]
(let [l (last res)
f (first res)]
(if (<= l f)
res
(recur (vec (conj (vec (butlast res)) f (- l f)))))))))
(defn next-step [res]
(let [input-vec (last res)
cnt (count input-vec)
i (.indexOf input-vec 1)
j (if (> i -1) (- i 1) (- cnt 1))
m (- cnt j)
new-vec (conj (vec (take j input-vec)) (- (input-vec j) 1))]
(conj res (vec (concat new-vec (repeat m 1))))))
(defn last-step? [input-vec]
(if
(or (nil? input-vec)
(= (count input-vec) 1)
(= (input-vec 1) 1)) true
false))
(partitions 10)
#=> [[10] [9 1] [8 2] [8 1 1] [7 3] [7 2 1] [7 1 1 1] [6 4] [6 3 1] [6 2 1 1] [6 1 1 1 1] [5 5] [5 4 1] [5 3 1 1] [5 2 1 1 1] [5 1 1 1 1 1] [4 4 2] [4 4 1 1] [4 3 1 1 1] [4 2 1 1 1 1] [4 1 1 1 1 1 1] [3 3 3 1] [3 3 2 1 1] [3 3 1 1 1 1] [3 2 1 1 1 1 1] [3 1 1 1 1 1 1 1] [2 2 2 2 2] [2 2 2 2 1 1] [2 2 2 1 1 1 1] [2 2 1 1 1 1 1 1] [2 1 1 1 1 1 1 1 1] [1 1 1 1 1 1 1 1 1 1]]
I'm stuck 5 days with this task in Racket, does anybody know how can I approach it?
Given a function of arity 2 and a list of n elements, return the evaluation of the string function of all the elements, for example:
>(reduce + '(1 2 3 4 5 6 7 8 9 10))
55
> (reduce zip '((1 2 3) (4 5 6) (7 8 9)))
'((1 (4 7)) (2 (5 8)) (3 (6 9)))
Here you go.
(define (reduce func list)
(assert (not (null? list)))
(if (null? (cdr list))
(car list)
(func (car list) (reduce func (cdr list)))))
Tests:
> (reduce + '(1 2 3 4 5 6 7 8 9 10))
55
> (reduce zip '((1 2 3) (4 5 6) (7 8 9)))
((1 (4 7)) (2 (5 8)) (3 (6 9)))
For completeness, an implementation for zip (one that assumes two lists and that your lists are all the same length) is:
(define (zip l1 l2) (map list l1 l2))
You can express it in terms of foldl:
(define (reduce f xs)
(and (not (empty? xs)) (foldl f (first xs) (rest xs))))
(define reduce
(λ (f init ls)
(if (empty? ls)
init
(reduce f (f init (first ls)) (rest ls)))))