Convert pseudo-code with nested for-loops to Clojure - clojure

I want to implement this psuedo code in Clojure:
function(n)
B[0] <-- 1
for m <-- 1 to n do
B[m] <-- 0
for k <-- 0 to m - 1 do
B[m] <-- B[m] − binom(m+1, k) * B[k]
B[m] <-- B[m]/(m+1)
return B[n]
My first thought was to do something like this:
(defn foo [n]
(if (= n 0)
(int 1)
(for [k (range 0 (- n 1))]
(* (binom (+ n 1) k)
(foo k)))))
but now I'm stuck and I don't know how to continue. The nested loops confuse me a lot when I try to translate them to Clojure.
I'd really appreciate some help on how to write this code in Clojure, I feel a bit lost.
Thanks in advance!

Some algorithms are naturally imperative in nature. Don't be afraid to write imperative code if that is the easiest solution, rather than trying to "force fit" the algorithm into a functional style.
This algorithm could easily use a mutable atom to store the B array:
(defn factorial [x]
(reduce * (range 2 (inc x))))
(defn binom [n k]
(/ (factorial n)
(factorial k) (factorial (- n k))))
(defn bernoulli [n]
(let [B (atom (vec (repeat n 0)))] ; allocate B[0]..B[n-1] = zeros
(swap! B assoc 0 1) ; B[0] = 1
(doseq [m (range 1 (inc n))] ; 1..n
(swap! B assoc m 0) ; B[m] = 0
(doseq [k (range m)] ; 0..(m-1)
(swap! B #(assoc % m ; B[m] = ...
(-
(get % m) ; B[m]
(*
(binom (inc m) k)
(get % k)))))) ; B[k]
(swap! B update m ; B[m] = B[m] ...
#(/ % (inc m))))
(get #B n)))
(dotest
(dotimes [i 10]
(spyx [i (bernoulli i)])))
with result
[i (bernoulli i)] => [0 1]
[i (bernoulli i)] => [1 -1/2]
[i (bernoulli i)] => [2 1/6]
[i (bernoulli i)] => [3 0N]
[i (bernoulli i)] => [4 -1/30]
[i (bernoulli i)] => [5 0N]
[i (bernoulli i)] => [6 1/42]
[i (bernoulli i)] => [7 0N]
[i (bernoulli i)] => [8 -1/30]
[i (bernoulli i)] => [9 0N]
You could also use with-local-vars for some algorithms, or even drop down into a (mutable) Java array. You can see an example of that in this mutable Java matrix example

The given pseudocode computes the nth Bernoulli number. It uses all the previous Bernoulli numbers to compute the result. Much like the factorial function, this lends itself to a recursive algorithm which may be implemented with memoize to avoid re-computation of earlier numbers:
(def factorial
"Returns n!."
(memoize (fn [n]
(if (< 1 n)
(* n (factorial (dec n)))
1N))))
(def bernoulli
"Returns the nth Bernoulli number."
(memoize (fn [n]
(if (zero? n)
1
(let [n! (factorial n)
term #(/ (* n! (bernoulli %))
(factorial %)
(factorial (- n % -1)))
terms (map term (range n))]
(reduce - 0 terms))))))
(map bernoulli (range 9)) ; => (1 -1/2 1/6 0N -1/30 0N 1/42 0N -1/30)

The pseudo code uses plenty of in-place updates which makes it a bit hard to read. But essentially, the code computes a list of numbers where every number is computed from the previous numbers in the list. And then we pick one of the numbers in the list.
I would implement this algorithm like
(defn compute-next-B [B]
(let [m (count B)
m+1 (inc m)
terms (map-indexed (fn [k Bk] (- (* Bk (binom m+1 k)))) B)]
(conj B (/ (apply + terms) m+1))))
(defn foo [n]
(->> [1]
(iterate compute-next-B)
(drop n)
first
last))
The outer loop from the pseudo code is the lazy sequence produced by (iterate compute-next-B ...). The inner loop from the pseudo code is the iteration inside (apply + terms) on the lazy sequence terms.

Related

How to return a lazy sequence from a loop recur with a conditional in Clojure?

Still very new to Clojure and programming in general so forgive the stupid question.
The problem is:
Find n and k such that the sum of numbers up to n (exclusive) is equal to the sum of numbers from n+1 to k (inclusive).
My solution (which works fine) is to define the following functions:
(defn addd [x] (/ (* x (+ x 1)) 2))
(defn sum-to-n [n] (addd(- n 1)))
(defn sum-to-k [n=1 k=4] (- (addd k) (addd n)))
(defn is-right[n k]
(= (addd (- n 1)) (sum-to-k n k)))
And then run the following loop:
(loop [n 1 k 2]
(cond
(is-right n k) [n k]
(> (sum-to-k n k) (sum-to-n n) )(recur (inc n) k)
:else (recur n (inc k))))
This only returns one answer but if I manually set n and k I can get different values. However, I would like to define a function which returns a lazy sequence of all values so that:
(= [6 8] (take 1 make-seq))
How do I do this as efficiently as possible? I have tried various things but haven't had much luck.
Thanks
:Edit:
I think I came up with a better way of doing it, but its returning 'let should be a vector'. Clojure docs aren't much help...
Heres the new code:
(defn calc-n [n k]
(inc (+ (* 2 k) (* 3 n))))
(defn calc-k [n k]
(inc (+ (* 3 k)(* 4 n))))
(defn f
(let [n 4 k 6]
(recur (calc-n n k) (calc-k n k))))
(take 4 (f))
Yes, you can create a lazy-seq, so that the next iteration will take result of the previous iteration. Here is my suggestion:
(defn cal [n k]
(loop [n n k k]
(cond
(is-right n k) [n k]
(> (sum-to-k n k) (sum-to-n n) )(recur (inc n) k)
:else (recur n (inc k)))))
(defn make-seq [n k]
(if-let [[n1 k1] (cal n k)]
(cons [n1 k1]
(lazy-seq (make-seq (inc n1) (inc k1))))))
(take 5 (make-seq 1 2))
;;=> ([6 8] [35 49] [204 288] [1189 1681] [6930 9800])
just generating lazy seq of candidatess with iterate and then filtering them should probably be what you need:
(def pairs
(->> [1 2]
(iterate (fn [[n k]]
(if (< (sum-to-n n) (sum-n-to-k n k))
[(inc n) k]
[n (inc k)])))
(filter (partial apply is-right))))
user> (take 5 pairs)
;;=> ([6 8] [35 49] [204 288] [1189 1681] [6930 9800])
semantically it is just like manually generating a lazy-seq, and should be as efficient, but this one is probably more idiomatic
If you don't feel like "rolling your own", here is an alternate solution. I also cleaned up the algorithm a bit through renaming/reformating.
The main difference is that you treat your loop-recur as an infinite loop inside of the t/lazy-gen form. When you find a value you want to keep, you use the t/yield expression to create a lazy-sequence of outputs. This structure is the Clojure version of a generator function, just like in Python.
(ns tst.demo.core
(:use tupelo.test )
(:require [tupelo.core :as t] ))
(defn integrate-to [x]
(/ (* x (+ x 1)) 2))
(defn sum-to-n [n]
(integrate-to (- n 1)))
(defn sum-n-to-k [n k]
(- (integrate-to k) (integrate-to n)))
(defn sums-match[n k]
(= (sum-to-n n) (sum-n-to-k n k)))
(defn recur-gen []
(t/lazy-gen
(loop [n 1 k 2]
(when (sums-match n k)
(t/yield [n k]))
(if (< (sum-to-n n) (sum-n-to-k n k))
(recur (inc n) k)
(recur n (inc k))))))
with results:
-------------------------------
Clojure 1.10.1 Java 13
-------------------------------
(take 5 (recur-gen)) => ([6 8] [35 49] [204 288] [1189 1681] [6930 9800])
You can find all of the details in the Tupelo Library.
This first function probably has a better name from math, but I don't know math very well. I'd use inc (increment) instead of (+ ,,, 1), but that's just personal preference.
(defn addd [x]
(/ (* x (inc x)) 2))
I'll slightly clean up the spacing here and use the dec (decrement) function.
(defn sum-to-n [n]
(addd (dec n)))
(defn sum-n-to-k [n k]
(- (addd k) (addd n)))
In some languages predicates, functions that return booleans,
have names like is-odd or is-whatever. In clojure they're usually
called odd? or whatever?.
The question-mark is not syntax, it's just part of the name.
(defn matching-sums? [n k]
(= (addd (dec n)) (sum-n-to-k n k)))
The loop special form is kind of like an anonymous function
for recur to jump back to. If there's no loop form, recur jumps back
to the enclosing function.
Also, dunno what to call this so I'll just call it f.
(defn f [n k]
(cond
(matching-sums? n k) [n k]
(> (sum-n-to-k n k) (sum-to-n n)) (recur (inc n) k)
:else (recur n (inc k))))
(comment
(f 1 2) ;=> [6 8]
(f 7 9) ;=> [35 49]
)
Now, for your actual question. How to make a lazy sequence. You can use the lazy-seq macro, like in minhtuannguyen's answer, but there's an easier, higher level way. Use the iterate function. iterate takes a function and a value and returns an infinite sequence of the value followed by calling the function with the value, followed by calling the function on that value etc.
(defn make-seq [init]
(iterate (fn [n-and-k]
(let [n (first n-and-k)
k (second n-and-k)]
(f (inc n) (inc k))))
init))
(comment
(take 4 (make-seq [1 2])) ;=> ([1 2] [6 8] [35 49] [204 288])
)
That can be simplified a bit by using destructuring in the argument-vector of the anonymous function.
(defn make-seq [init]
(iterate (fn [[n k]]
(f (inc n) (inc k)))
init))
Edit:
About the repeated calculations in f.
By saving the result of the calculations using a let, you can avoid calculating addd multiple times for each number.
(defn f [n k]
(let [to-n (sum-to-n n)
n-to-k (sum-n-to-k n k)]
(cond
(= to-n n-to-k) [n k]
(> n-to-k to-n) (recur (inc n) k)
:else (recur n (inc k)))))

Genetic programming Clojure

I've pasted the code on this page in an IDE and it works. The problem is that when I replace the definition of target-data with this vector of pairs* it gives me this error**.
(vector [[1 2]
[2 3]
[3 4]
[4 5]] ) ; *
UnsupportedOperationException nth not supported on this type: core$vector clojure.lang.RT.nthFrom (RT.java:857) **
What should I do to use my own target-data?
UPDATED FULL CODE:
(ns evolvefn.core)
;(def target-data
; (map #(vector % (+ (* % %) % 1))
; (range -1.0 1.0 0.1)))
;; We'll use input (x) values ranging from -1.0 to 1.0 in increments
;; of 0.1, and we'll generate the target [x y] pairs algorithmically.
;; If you want to evolve a function to fit your own data then you could
;; just paste a vector of pairs into the definition of target-data instead.
(def target-data
(vec[1 2]
[2 3]
[3 4]
[4 5]))
;; An individual will be an expression made of functions +, -, *, and
;; pd (protected division), along with terminals x and randomly chosen
;; constants between -5.0 and 5.0. Note that for this problem the
;; presence of the constants actually makes it much harder, but that
;; may not be the case for other problems.
(defn random-function
[]
(rand-nth '(+ - * pd)))
(defn random-terminal
[]
(rand-nth (list 'x (- (rand 10) 5))))
(defn random-code
[depth]
(if (or (zero? depth)
(zero? (rand-int 2)))
(random-terminal)
(list (random-function)
(random-code (dec depth))
(random-code (dec depth)))))
;; And we have to define pd (protected division):
(defn pd
"Protected division; returns 0 if the denominator is zero."
[num denom]
(if (zero? denom)
0
(/ num denom)))
;; We can now evaluate the error of an individual by creating a function
;; built around the individual, calling it on all of the x values, and
;; adding up all of the differences between the results and the
;; corresponding y values.
(defn error
[individual]
(let [value-function (eval (list 'fn '[x] individual))]
(reduce + (map (fn [[x y]]
(Math/abs
(- (value-function x) y)))
target-data))))
;; We can now generate and evaluate random small programs, as with:
;; (let [i (random-code 3)] (println (error i) "from individual" i))
;; To help write mutation and crossover functions we'll write a utility
;; function that injects something into an expression and another that
;; extracts something from an expression.
(defn codesize [c]
(if (seq? c)
(count (flatten c))
1))
(defn inject
"Returns a copy of individual i with new inserted randomly somwhere within it (replacing something else)."
[new i]
(if (seq? i)
(if (zero? (rand-int (count (flatten i))))
new
(if (< (rand)
(/ (codesize (nth i 1))
(- (codesize i) 1)))
(list (nth i 0) (inject new (nth i 1)) (nth i 2))
(list (nth i 0) (nth i 1) (inject new (nth i 2)))))
new))
(defn extract
"Returns a random subexpression of individual i."
[i]
(if (seq? i)
(if (zero? (rand-int (count (flatten i))))
i
(if (< (rand) (/ (codesize (nth i 1))
(- (codesize i)) 1))
(extract (nth i 1))
(extract (nth i 2))))
i))
;; Now the mutate and crossover functions are easy to write:
(defn mutate
[i]
(inject (random-code 2) i))
(defn crossover
[i j]
(inject (extract j) i))
;; We can see some mutations with:
;; (let [i (random-code 2)] (println (mutate i) "from individual" i))
;; and crossovers with:
;; (let [i (random-code 2) j (random-code 2)]
;; (println (crossover i j) "from" i "and" j))
;; We'll also want a way to sort a populaty by error that doesn't require
;; lots of error re-computation:
(defn sort-by-error
[population]
(vec (map second
(sort (fn [[err1 ind1] [err2 ind2]] (< err1 err2))
(map #(vector (error %) %) population)))))
;; Finally, we'll define a function to select an individual from a sorted
;; population using tournaments of a given size.
(defn select
[population tournament-size]
(let [size (count population)]
(nth population
(apply min (repeatedly tournament-size #(rand-int size))))))
;; Now we can evolve a solution by starting with a random population and
;; repeatedly sorting, checking for a solution, and producing a new
;; population.
(defn evolve
[popsize]
(println "Starting evolution...")
(loop [generation 0
population (sort-by-error (repeatedly popsize #(random-code 2)))]
(let [best (first population)
best-error (error best)]
(println "======================")
(println "Generation:" generation)
(println "Best error:" best-error)
(println "Best program:" best)
(println " Median error:" (error (nth population
(int (/ popsize 2)))))
(println " Average program size:"
(float (/ (reduce + (map count (map flatten population)))
(count population))))
(if (< best-error 0.1) ;; good enough to count as success
(println "Success:" best)
(recur
(inc generation)
(sort-by-error
(concat
(repeatedly (* 1/2 popsize) #(mutate (select population 7)))
(repeatedly (* 1/4 popsize) #(crossover (select population 7)
(select population 7)))
(repeatedly (* 1/4 popsize) #(select population 7)))))))))
;; Run it with a population of 1000:
(evolve 1000)
And the error is:
(evolve 1000)
Starting evolution...
IllegalArgumentException No matching method found: abs clojure.lang.Reflector.invokeMatchingMethod (Reflector.java:80)
evolvefn.core=>

Perform multiple reductions in a single pass in Clojure

In Clojure I want to find the result of multiple reductions while only consuming the sequence once. In Java I would do something like the following:
double min = Double.MIN_VALUE;
double max = Double.MAX_VALUE;
for (Item item : items) {
double price = item.getPrice();
if (price > min) {
min = price;
}
if (price < max) {
max = price;
}
}
In Clojure I could do much the same thing by using loop and recur, but it's not very composable - I'd like to do something that lets you add in other aggregation functions as needed.
I've written the following function to do this:
(defn reduce-multi
"Given a sequence of fns and a coll, returns a vector of the result of each fn
when reduced over the coll."
[fns coll]
(let [n (count fns)
r (rest coll)
initial-v (transient (into [] (repeat n (first coll))))
fns (into [] fns)
reduction-fn
(fn [v x]
(loop [v-current v, i 0]
(let [y (nth v-current i)
f (nth fns i)
v-new (assoc! v-current i (f y x))]
(if (= i (- n 1))
v-new
(recur v-new (inc i))))))]
(persistent! (reduce reduction-fn initial-v r))))
This can be used in the following way:
(reduce-multi [max min] [4 3 6 7 0 1 8 2 5 9])
=> [9 0]
I appreciate that it's not implemented in the most idiomatic way, but the main problem is that it's about 10x as slow as doing the reductions one at at time. This might be useful for lots performing lots of reductions where the seq is doing heavy IO, but surely this could be better.
Is there something in an existing Clojure library that would do what I want? If not, where am I going wrong in my function?
that's what i would do: simply delegate this task to a core reduce function, like this:
(defn multi-reduce
([fs accs xs] (reduce (fn [accs x] (doall (map #(%1 %2 x) fs accs)))
accs xs))
([fs xs] (when (seq xs)
(multi-reduce fs (repeat (count fs) (first xs))
(rest xs)))))
in repl:
user> (multi-reduce [+ * min max] (range 1 10))
(45 362880 1 9)
user> (multi-reduce [+ * min max] [10])
(10 10 10 10)
user> (multi-reduce [+ * min max] [])
nil
user> (multi-reduce [+ * min max] [1 1 1000 0] [])
[1 1 1000 0]
user> (multi-reduce [+ * min max] [1 1 1000 0] [1])
(2 1 1 1)
user> (multi-reduce [+ * min max] [1 1 1000 0] (range 1 10))
(46 362880 1 9)
user> (multi-reduce [max min] (range 1000000))
(999999 0)
The code for reduce is fast for reducible collections. So it's worth trying to base multi-reduce on core reduce. To do so, we have to be able to construct reducing functions of the right shape. An ancillary function to do so is ...
(defn juxt-reducer [f g]
(fn [[fa ga] x] [(f fa x) (g ga x)]))
Now we can define the function you want, which combines juxt with reduce as ...
(defn juxt-reduce
([[f g] coll]
(if-let [[x & xs] (seq coll)]
(juxt-reduce (list f g) [x x] xs)
[(f) (g)]))
([[f g] init coll]
(reduce (juxt-reducer f g) init coll)))
For example,
(juxt-reduce [max min] [4 3 6 7 0 1 8 2 5 9]) ;=> [9 0]
The above follows the shape of core reduce. It can clearly be extended to cope with more than two functions. And I'd expect it to be faster than yours for reducible collections.
Here is how I would do it:
(ns clj.core
(:require [clojure.string :as str] )
(:use tupelo.core))
(def data (flatten [ (range 5 10) (range 5) ] ))
(spyx data)
(def result (reduce (fn [cum-result curr-val] ; reducing (accumulator) fn
(it-> cum-result
(update it :min-val min curr-val)
(update it :max-val max curr-val)))
{ :min-val (first data) :max-val (first data) } ; inital value
data)) ; seq to reduce
(spyx result)
(defn -main [] )
;=> data => (5 6 7 8 9 0 1 2 3 4)
;=> result => {:min-val 0, :max-val 9}
So the reducing function (fn ...) carries along a map like {:min-val xxx :max-val yyy} through each element of the sequence, updating the min & max values as required at each step.
While this does make only one pass through the data, it is doing a lot of extra work calling update twice per element. Unless your sequence is very unusual, it is probably more efficient to make two (very efficient) passes through the data like:
(def min-val (apply min data))
(def max-val (apply max data))
(spyx min-val)
(spyx max-val)
;=> min-val => 0
;=> max-val => 9

Overflow in Clojure computation despite using BigInt

The following closure computation overflows despite the use of big integers:
(defn binomial-coefficient [n k]
(let [rprod (fn [a b] (reduce * (range a (inc b))))]
(/ (rprod (- n k -1) n) (rprod 1 k))))
(binomial-coefficient 100N 50N)
I could not figure out where the overflow happens. For example, executing rprod by itself seems to work.
NB: the binomial coefficient code was taken from Rosetta Code.
The problem is that you're calling (rprod 1 k) with an integer 1 and not a bigint 1N:
(defn binomial-coefficient [n k]
(let [rprod (fn [a b] (reduce * (range a (inc b))))]
(/ (rprod (- n k -1) n) (rprod 1N k))))
(binomial-coefficient 100N 50N)
The problem lays in range function:
=> (range 1 10N)
(1 2 3 4 5 6 7 8 9)
=> (range 1N 10)
(1N 2N 3N 4N 5N 6N 7N 8N 9N)
Alternative solution is to use *', -' and inc' instead of ordinary *, - and inc operators, because they have build-in support for arbitrary precision and never overflow:
(defn binomial-coefficient [n k]
(let [rprod (fn [a b] (reduce *' (range a (inc' b))))]
(/ (rprod (-' n k -1) n) (rprod 1 k))))
(binomial-coefficient 100 50)

Generating binary numbers of n digits in clojure

I'd like to generate binary numbers of n digits from 0 to 2^n-1. For example of 3 digits, "000", "001", "010", ..., "111" (0 to 7 in decimal). The way I used is to use java.lang.Integer.toBinaryString() method and add zeros if necessary like the following:
(defn pad-zero [s n]
(str (reduce str (repeat (- n (count s)) "0")) s))
(defn binary-permutation [n]
(map (fn [s] (pad-zero s n))
(map #(Integer/toBinaryString %) (range 0 (Math/pow 2 n)))))
With this code, I can generate what I want like this. For 3 digits:
(binary-permutation 3)
=> ("000" "001" "010" "011" "100" "101" "110" "111")
But this codes look a little verbose.
Aren't there any ways better or more clojure way to do this?
You can simplify the formatting using cl-format from clojure.pprint:
(defn binary-permutation [n]
(map (partial cl-format nil "~v,'0B" n) (range 0 (Math/pow 2 n))))
You may also be interested to know that (Math/pow 2 n) is equivalent to (bit-shift-left 1 n).
Another way to express this would be in term of selections from clojure.math.combinatorics:
(defn binary-permutation [n]
(map (partial apply str) (selections [0 1] n)))
(defn binary-permutation [n]
(for [x (range (Math/pow 2 n))]
(apply str (reverse (take n (map #(bit-and 1 %) (iterate #(bit-shift-right % 1) x)))))))
(defn pad-zero [s n]
(apply str (take-last n (concat (repeat n \0) s))))