How to implement multi-threading for a recursive function - multithreading

Consider a simple 2-player game played as follows: An even number of coins is laid out in a row. Taking turns, each player removes the coin on one of the ends of the row. The object is to have the highest value in coins when all coins have been taken.
Player one finds the sum of all of the even-numbered coins, and all the odd-numbered coins. If the sum of the odd numbered coins is higher, player one takes the leftmost coin; otherwise he takes the rightmost.
Player two now has a choice, with an odd number of coins. Taking either the first coin or the last coin will result in a slightly different list of coins for player one. Player two uses the result of a recursive search to determine whether to pick the first or the last coin.
And I want to be able to somehow implement multi-threading on the p2-helper recursive function, just now sure how. Any suggestions or ideas would be greatly appreciated, thanks!
(ns game.core
(:gen-class))
; function that returns the vector of a string (split up by spaces)
(defn vector-from-string [s]
(drop 1 (map read-string (clojure.string/split (clojure.string/trim-newline s) #" "))))
; function that returns the slurped string of a read-in file
(defn string-from-file [f]
(slurp f))
; function that returns the sum of all the odd-indexed items in a vector
(defn sum-of-evens [v]
(reduce + (take-nth 2 (rest v))))
; function that returns the sum of all the odd-indexed items in a vector
(defn sum-of-odds [v]
(reduce + (take-nth 2 v)))
; function that returns the vector that is left after player one moves, and then the coin that player one took
(defn p1 [v]
(if (> (sum-of-odds v) (sum-of-evens v))
[(drop 1 v) (first v)]
[(drop-last v) (last v)]))
; nearly identical to 'p1' but this function only returns the affected vector after player 1 has moved
(defn p2-p1 [v]
(if (even? (count v))
(if (> (sum-of-odds v) (sum-of-evens v))
(drop 1 v)
(drop-last v))
(drop 0 v)))
; recursive search for player two
(defn p2-helper [v]
(if (or (= (count v) 1) (= (count v) 0))
(reduce + v)
(max (+ (p2-helper (drop 1 (p2-p1 v))) (first (p2-p1 v))) (+ (p2-helper (drop-last (p2-p1 v))) (last (p2-p1 v))))))
; function that returns the vector that is left after player two moves, and then the coin that player two took
(defn p2 [v]
(if (> (+ (p2-helper (drop 1 (p2-p1 v))) (first (p2-p1 v))) (+ (p2-helper (drop-last (p2-p1 v))) (last (p2-p1 v))))
[(drop 1 v) (first v)]
[(drop-last v) (last v)]))
; function to play the game out until no coins are left
(defn play-game [v]
(def coins v)
(def p1score 0)
(def p2score 0)
(while (not (empty? coins))
(do
(let [[new-vec score] (p1 coins)]
(def coins new-vec)
(def p1score (+ p1score score)))
(let [[new-vec score] (p2 coins)]
(def coins new-vec)
(def p2score (+ p2score score)))))
(println "player 1 score:" p1score)
(println "player 2 score:" p2score))
; main
(defn -main [& args]
(let [v (vector-from-string (string-from-file "10.txt")) ]
(play-game v)))

An initial approach would be to just add #(future (p2-helpet ... around each recursive call. this will likely run too many threads and run slower.
a second approach might be to change the helpers to put work on a task queue and make some threads to process them. this will be better, though still might be slower.
I'd continue improving it by unrolling the recursion with a call to trampoline to stop it blowing the stack. then try just making the top level parallel, or just the two top levels.

Related

Lisp: Add respective elements of a list of lists

Let's say I have a list:
((1 2 3) (8 4 7) (41 79 30) (0 8 5))
I want to do this:
(1+8+41+0 2+4+79+8 3+7+30+5) = (50 93 45)
I've found an ugly solution:
(defun nested+ (lst)
(let ((acc nil))
(dotimes (i (length (first lst)))
(push (apply #'+ (mapcar #'(lambda (a) (nth i a)) lst)) acc))
(reverse acc)))
It seems to work for my purposes, but I guess it is slow and un-lispy. What's the proper way?
One option is (apply #'mapcar #'+ list). Mapcar will consume as many lists as you give it and stop when it reaches the end of the shortest list.
The naive solution would be
(apply #'mapcar #'+ list)
However, as already pointed out e.g. here by stackoverflow and here by LispWorks, the call-arguments-limit of (in the worst case) 50 arguments applies to functions called by apply. And reduce is suggested instead.
Thus, I suggest:
(defun sum-all (lists)
(reduce #'(lambda (l1 l2) (mapcar #'+ l1 l2)) lists))
And indeed
(sum-all '((1 2 3) (8 4 7) (41 79 30) (0 8 5)))
;; (50 93 45)
Another option is to loop over your list of lists:
(defun sum-all (lists)
(loop
for list in lists
for result = (copy-list list) then (map-into result #'+ result list)
finally (return result)))
During the first iteration, the first list is copied. The resulting list is then used in successive iterations to hold the respective sums. At the end of the iteration, that result list is returned.

How to implement multithreading

Game rules
Consider a simple 2-player game played as follows: An even number of coins is laid out in a row. Taking turns, each player removes the coin on one of the ends of the row. The object is to have the highest value in coins when all coins have been taken.
Player one finds the sum of all of the even-numbered coins, and all the odd-numbered coins. If the sum of the odd numbered coins is higher, player one takes the leftmost coin; otherwise he takes the rightmost.
Player two has a choice, with an odd number of coins. So he tries taking a coin from both ends, to see which option would leave player 1 worse off.
The problem
I basically want to implement multitheading to this program. I am still very new to Clojure, and I couldn't really find any good material online, regarding multithreading, that could be applied to my program.
The code
(ns game.core
(:gen-class))
(defn vector-from-string [s]
(drop 1 (map read-string (clojure.string/split (clojure.string/trim-newline s) #" "))))
(defn string-from-file [f]
(slurp f))
(defn sum-of-evens [v]
(def evens (vector))
(loop [v v, index 1]
(when (seq v)
(if (even? index)
(def evens (conj evens (first v))))
(recur (rest v) (inc index))))
(reduce + evens))
(defn sum-of-odds [v]
(def odds (vector))
(loop [v v, index 1]
(when (seq v)
(if (odd? index)
(def odds (conj odds (first v))))
(recur (rest v) (inc index))))
(reduce + odds))
(defn player-two [v p1score p2score]
(if (not (empty? v))
(if (> (max (sum-of-odds (drop 1 v)) (sum-of-evens (drop 1 v))) (max (sum-of-odds (drop-last v)) (sum-of-evens (drop-last v))))
(player-one (drop-last v) p1score (+ p2score(last v)))
(player-one (drop 1 v) p1score (+ p2score (first v))))
(println "p1score" p1score "p2score" p2score)))
(defn player-one [v p1score p2score]
(if (not (empty? v))
(if (> (sum-of-odds v) (sum-of-evens v))
(player-two (drop 1 v) (+ p1score (first v)) p2score)
(player-two (drop-last v) (+ p1score (last v)) p2score))
(println "p1score" p1score "p2score" p2score)))
(defn -main [& args]
(let [v (vector-from-string (string-from-file "numbers.txt")) ]
(player-one v 0 0)))
So -main runs the player-one function first, and player-one calls player-two, and they both continue on until the end of the program. I would like to somehow implement multithreading to speed up the executing of this game with a higher amount of starting coins.
Your code is currently very unidiomatic.
A few remarks that hopefully help you getting into the right direction:
A def inside a defn (or def) is (almost) always wrong. You're thinking in terms of variable assignment and mutable variables here. This is not how Clojure works. Use variables in your recur instead, if you absolutely must, use a local atom (also almost always wrong, but less often wrong than def inside defn).
Your loops are unnecessarily complicated. You want to sum over the elements at even or odd indices? Use a combination of reduce, take-nth and rest:
(take-nth 2 [1 2 3])
;=> (1 3)
(take-nth 2 (rest [1 2 3 4]))
;=> (2 4)
The whole things looks like you're compiling this over and over again and then run the JVM with it. Am I right? The preferred way is to work at the REPL. How to access it, depends on which editing environment you use. There are many beginner-friendly REPLs out there. Gorilla REPL is one example.
Once you got your code and development workflow in better shape, you may want to explore functions like pmap and future for easy access to multi-threading. More advanced stuff involves a library called core.async, but that's probably not the ideal route for the beginner. You can also fall back to Java interop to create your threads. Again something that, while not really hard to do, requires a bit of experience with Clojure.
Hope that helps, even it is not a direct answer to your question.
First let's look at some issues in your example that will need to be addressed before parallelizing this code.
sum-of-evens is using def inside a function, which is almost always a mistake. This might seem to have the effect you want, but it's not the right way to achieve it. defs are typically used for namespace-level (at the same level as your function defns) values. We can refactor sum-of-evens to not rely on unintentionally side-effecty behavior via def:
(defn sum-of-evens [v]
(loop [v v
index 1
evens []]
(if (seq v)
(recur (rest v)
(inc index)
(if (even? index) ;; add a binding to loop, not a def
(conj evens (first v))
evens)) ;; pass unchanged value when necessary
(reduce + evens))))
But we can further simplify this function with keep-indexed:
(defn sum-of-evens [coll]
(->> coll
(keep-indexed (fn [i v] (when (even? (inc i))
v)))
(apply +)))
And when we do the same for sum-of-odds, we can see the functions are nearly identical except for the condition they use: odd? vs. even?. We can make another function that takes a predicate function:
(defn sum-by-index-pred [f coll]
(->> coll
(keep-indexed (fn [i v] (when (f i) v)))
(apply +)))
;; using partial application and function composition
(def sum-of-evens (partial sum-by-index-pred (comp even? inc)))
(def sum-of-odds (partial sum-by-index-pred (comp odd? inc)))
Looking at the implementation of player-one and player-two, they seem to be mutually recursive. I don't see how you could parallelize this to make it any faster because each turn is dependent on the previous turn's outcome; there's nothing to parallelize.
I'd suggest refactoring this so that your game rules and state are computed in one place, rather than mutually recursive functions.
(loop [scores (array-map :player-1 0 :player-2 0)
turns (cycle (keys scores))
vs (shuffle (range 100))]
(if (seq vs)
(let [higher-odds? (> (sum-of-odds vs) (sum-of-evens vs))
scores (if higher-odds?
(update scores (first turns) + (first vs))
(update scores (first turns) + (last vs)))
remain (if higher-odds?
(rest vs)
(butlast vs))]
(recur scores (rest turns) remain))
(prn scores)))
;; {:player-1 2624, :player-2 2326}
I'm not sure if this preserves your original game logic but it should be close, and it does generalize it for more than two players. Try adding :player-3 0 to the starting scores.

How to modify string by index in Clojure?

I want to modify a string by applying a function to some of its chars (by starting index and length).
For example, I want to increment the ascii representation of the string "aaaaa" from the 2nd index to the 4th.
[start=1 length=3]
"aaaaa" => "abbba"
The only way I could think of is applying map, but it goes over all the sequence.
You could use subs to get the portions you do and don't want to modify. After modification use str to concatenate the result together:
(defn replace-in-str [f in from len]
(let [before (subs in 0 from)
after (subs in (+ from len))
being-replaced (subs in from (+ from len))
replaced (f being-replaced)]
(str before replaced after)))
You can call it:
(replace-in-str
(fn [sub-str] (apply str (map #(char (+ 1 (int %))) sub-str)))
"aaaaa"
1
3)
Indeed map applies the function to every element in the sequence. One way to get around that is to start with map-indexed. Unlike map, map-indexed passes the element's index as the first argument to the mapping function. When we have element's index, we can use it to choose if we need to perform the operation or just return the element as is.
A solution might look like this:
(defn inc-char [c]
(char (inc (long c))))
(defn if-in-range [from to f]
(fn [i x & args]
(if (<= from i (dec to))
(apply f x args)
x)))
(defn map-subs [from to f s]
(apply str (map-indexed (if-in-range from to f) s)))
(map-subs 1 4 inc-char "aaaaa")
;; "abbba"
I thought of using map-index to execute the operation only on the specified index:
((fn [op start length] (map-indexed (fn [i m] (if (<= start i length)
(op m)
m)) "aaaaa"))
#(char (+ 1 (int %)))
1
3)
=> (\a \b \b \b \a)
Here you go:
(defn replace-str
[s start-i end-i]
(apply str (map-indexed (fn [index val]
(if (and (>= index start-i)
(<= index end-i))
(char (+ (int val) 1))
val))
s)))
(replace-str "aaaa" 1 2)
;=> "abba"

Idiomatic string rotation in Clojure

How to idiomatically rotate a string in Clojure for the Burrows-Wheeler transform?
I came up with this, which uses (cycle "string"), but feels a bit imperative:
(let [s (str "^" "banana" "|")
l (count s)
c (cycle s)
m (map #(take l (drop % c)) (range l))]
(apply map str m))
=> ("^banana|" "banana|^" "anana|^b" "nana|^ba" "ana|^ban" "na|^bana" "a|^banan" "|^banana")
I'm not sure if this qualifies as code golf. Is there a cleaner way to do this?
I would do:
(defn bwrot [s]
(let [s (str "^" s "|")]
(for [i (range (count s))]
(str (subs s i) (subs s 0 i)))))
or:
(defn bwrot [s]
(let [n (+ 2 (count s))
s (str "^" s "|^" s "|")]
(for [i (range n)]
(subs s i (+ i n)))))
The second one should allocate less (one string instead of three per iteration).
There used to be a rotations function in clojure.contrib.seq that might be worth a look for inspiration. The source is reproduced below:
(defn rotations
"Returns a lazy seq of all rotations of a seq"
[x]
(if (seq x)
(map
(fn [n _]
(lazy-cat (drop n x) (take n x)))
(iterate inc 0) x)
(list nil)))
Then you could do something like:
(apply map str (rotations "^banana|"))
; => ("^banana|" "banana|^" "anana|^b" "nana|^ba" "ana|^ban" "na|^bana" "a|^banan" "|^banana")
A stepped call to partition works:
(defn bwt[s]
(let [s' (str "^" s "|")
c (cycle s')
l (count s')]
(map last (sort (apply map str (take l (partition l 1 c)))))))
(apply str (bwt "banana"))
=> "|bnn^aaa"
If I was unconcerned about efficiency or number of characters I'd write something like:
(defn rotate-string
[s]
(apply str (concat (drop 1 s) (take 1 s))))
(defn string-rotations
[s]
(->> s
(iterate rotate-string)
(take (count s))))
(rotate-string "^banana|") ; "banana|^"
(string-rotations "^banana|") ; ("^banana|" "banana|^" "anana|^b" "nana|^ba" "ana|^ban" "na|^bana" "a|^banan" "|^banana")
In particular, factoring out the single rotation into its own function.
Another way to accomplish rotation is to use a "double string" (i.e. concatenate the string to itself) and play around with substrings.
(defn rotations [strng]
(let [indices (range (count strng))
doublestr (str strng strng)]
(map #(subs doublestr % (+ % (count strng))) indices)))
(rotations "^banana|")
;;(^banana| banana|^ anana|^b nana|^ba ana|^ban na|^bana a|^banan |^banana)
Rotations of "foo":
Take the double string "foofoo"
Length n of "foo" = 3
The rotations are all the n substrings of "foofoo" that start with indices 0, 1, 2 and have the same length n

Cartesian Product of a finite sequence of potentially infinite sequences

The Problem
I need to create a function that, when given a finite sequence of potentially infinite sequences, it produces the sequence that is their "cartesian product".
i.e. given the sequence
'((1 2) (3 4))
the function produces (some ordering of):
'((1 3) (1 4) (2 3) (2 4)
Importantly, for every p in the list of cartesian products ps, there must be some natural number n such that (= p (last (take n ps))). Or, informally, you only need to iterate through the sequence a finite amount to reach any element in it.
This condition becomes important when dealing with infinite lists.
Solution in Haskell
In Haskell, this is how I would have done it:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs
combine :: [[a]] -> [[a]]
combine = foldr prod [[]]
where
prod xs css = foldr1 interleave [ [x:cs | cs <- css] | x <- xs]
And calling it you get the following:
combine [[0..] [0..]] = [[0,0,0],[1,0,0],[,1,0],[2,0,0],[0,0,1],[1,1,0],...
Solution in Clojure
And so I attempted to replicate this in Clojure, like so, (It's pretty much a direct translation):
(defn interleave
"Returns a lazy sequence of the interleavings of sequences `xs` and `ys`
(both potentially infinite), leaving no elements discarded."
[xs ys]
(lazy-seq
(if-let [[x & xs*] (seq xs)]
(cons x (interleave ys xs*))
ys)))
(defn interleave*
"Converts a sequence of potentially infinite sequences into its lazy
interleaving."
[xss]
(lazy-seq
(when-let [[xs & xss*] (seq xss)]
(interleave xs (interleave* xss*)))))
(defn combine
"Takes a finite sequence of potentially infinite sequences, and combines
them to produce a possibly infinite sequence of their cartesian product."
[xss]
(if-let [[xs & xss*] (seq xss)]
(interleave*
(for [x xs]
(for [cs (combine xss*)]
(lazy-seq (cons x cs)))))
'(()) ))
But when I run:
(take 1 (combine [(range) (range)]))
I get:
StackOverflowError cfg.util/combine/iter--3464--3468/fn--3469/fn--3470/iter--3471--3475/fn--3476
So, how do I make it lazy enough, so as to avoid the stack overflow? Really, I don't understand how Clojure's lazy sequence model works which is the main problem.
I think your solution may be algorithmically intractable, reconstructing the sub-sequences time and again, much as the simple Fibonacci function:
(defn fib [n]
(case n
(0N 1N) n
(+ (fib (- n 1)) (fib (- n 2)))))
... recomputes its precedents.
In any event, the search for [100 10] in the cartesian product of (range) and (range):
(first (filter #{[100 10]} (combine [(range) (range)])))
... does not return in a reasonable time.
I can offer you a faster though far less elegant solution.
First, a couple of utilities:
Something from #amalloy to compute the Cartesian product of finite sequences:
(defn cart [colls]
(if (empty? colls)
'(())
(for [x (first colls)
more (cart (rest colls))]
(cons x more))))
A function adapted from the Clojure Cookbook to map the values of a map:
(defn map-vals [f m] (zipmap (keys m) (map f (vals m))))
Now for the function we want, which I've called enum-cart, as it enumerates the Cartesian product even of infinite sequences:
(defn enum-cart [colls]
(let [ind-colls (into (sorted-map) (map-indexed (fn [n s] [n (seq s)]) colls))
entries ((fn tins [ss] (let [ss (select-keys ss (map key (filter val ss)))]
(lazy-seq
(if (seq ss)
(concat
(map-vals first ss)
(tins (map-vals next ss)))))))
ind-colls)
seens (reductions
(fn [a [n x]] (update-in a [n] conj x))
(vec (repeat (count colls) []))
entries)]
(mapcat
(fn [sv [n x]] (cart (assoc sv n [x])))
seens entries)))
The idea is to generate an indexed sequence of entries, going round the non-exhausted sequences. From this we generate a companion sequence of what we have already seen from each sequence. We pairwise combine these two, generating the free cartesian product of the new element with what we have of the other sequences. The answer is the concatenation of these free products.
For example
(enum-cart [(range 3) (range 10 15)])
... produces
((0 10)
(1 10)
(0 11)
(1 11)
(2 10)
(2 11)
(0 12)
(1 12)
(2 12)
(0 13)
(1 13)
(2 13)
(0 14)
(1 14)
(2 14))
And
(first (filter #{[100 10]} (enum-cart [(range) (range)])))
;(100 10)
... returns more or less instantly.
Notes
Is this better done in Knuth or elsewhere? I don't have access to
it.
The last non-exhausted sequence need not be kept, as there is nothing
else to use it.
So, I figured it out. And the issue is a subtle, but frustrating one. The problem stems from the destructuring I perform, in basically every function: I use this sort of idiom: [x & xs*] (seq xs), however, this realizes the first element of xs*, as well as realizing x. This behaviour is similar to what you would see if you were to use first and next to get the head and tail of the list respectively.
Using first/rest instead of destructuring in this way fixed the stack overflow:
(defn interleave
"Returns a lazy sequence of the interleavings of sequences `xs` and `ys`
(both potentially infinite), leaving no elements discarded."
[xs ys]
(lazy-seq
(if-let [xs* (seq xs)]
(cons (first xs*) (interleave ys (rest xs*)))
ys)))
(defn interleave*
"Converts a sequence of potentially infinite sequences into its lazy
interleaving."
[xss]
(lazy-seq
(when-let [xss* (seq xss)]
(interleave (first xss*)
(interleave* (rest xss*))))))
(defn combine
"Takes a finite sequence of potentially infinite sequences, and combines
them to produce a possibly infinite sequence of their cartesian product."
[xss]
(if-let [xss* (seq xss)]
(interleave*
(for [x (first xss*)]
(for [cs (combine (rest xss*))]
(lazy-seq (cons x cs)))))
'(()) ))
And running it, we get:
(= (take 5 (combine [(range) (range) (range)]))
'((0 0 0) (1 0 0) (0 1 0) (2 0 0) (0 0 1)))

Resources