Clojure Vector of Refs - vector

What's the simplest way to create a vector of distinct refs?
Using (repeat 5 (ref nil)) will return a list, but they will all reference the same ref:
user=> (repeat 5 (ref nil))
(#<Ref#16ef71: nil> #<Ref#16ef71: nil> #<Ref#16ef71: nil> #<Ref#16ef71: nil> #<R
ef#16ef71: nil>)
Same result with (replicate 5 (ref nil)):
user=> (replicate 5 (ref nil))
(#<Ref#1d88db7: nil> #<Ref#1d88db7: nil> #<Ref#1d88db7: nil> #<Ref#1d88db7: nil>
#<Ref#1d88db7: nil>)

user> (doc repeatedly)
-------------------------
clojure.core/repeatedly
([f])
Takes a function of no args, presumably with side effects, and returns an infinite
lazy sequence of calls to it
nil
user> (take 5 (repeatedly #(ref nil)))
(#<Ref#1f10a67: nil> #<Ref#1e2161d: nil> #<Ref#1a034d: nil> #<Ref#1cee792: nil> #<Ref#c5577c: nil>)
us

Ok, this is pretty gross, but it works:
user=> (map (fn [_] (ref nil)) (range 5))
(#<Ref#27147d: nil> #<Ref#b248c8: nil> #<Ref#c86116: nil> #<Ref#5e06ef: nil> #<Ref#19719f: nil>)
That returns a LazySeq, so if you want/need a Vector, then just use:
user=> (vec (map (fn [_] (ref nil)) (range 5)))
[#<Ref#5bf9cf: nil> #<Ref#6dbfb0: nil> #<Ref#43f787: nil> #<Ref#2fe9bf: nil> #<Ref#9b1e15: nil>]

Related

deref an atom after recursive function completes

I have an atom fs that I'm updating inside a recursive function freq-seq that's the value that holds the results of my computation. I have another function mine-freq-seqs to start freq-seq and when mine-freq-seqs is done I would like to receive the last value of said atom. So I thought I would do it like so
(ns freq-seq-enum)
(def fs (atom #{}))
(defn locally-frequents
[sdb min-sup]
(let [uniq-sdb (map (comp frequencies set) sdb)
freqs (apply merge-with + uniq-sdb)]
(->> freqs
(filter #(<= min-sup (second %)))
(map #(vector (str (first %)) (second %))))))
(defn project-sdb
[sdb prefix]
(if (empty? prefix) sdb
(into [] (->> sdb
(filter #(re-find (re-pattern (str (last prefix))) %))
(map #(subs % (inc (.indexOf % (str (last prefix))))))
(remove empty?)))))
(defn freq-seq
[sdb prefix prefix-support min-sup frequent-seqs]
(if ((complement empty?) prefix) (swap! fs conj [prefix prefix-support]))
(let [lf (locally-frequents sdb min-sup)]
(if (empty? lf) nil
(for [[item sup] lf] (freq-seq (project-sdb sdb (str prefix item)) (str prefix item) sup min-sup #fs)))))
(defn mine-freq-seqs
[sdb min-sup]
(freq-seq sdb "" 0 min-sup #fs))
running it first
(mine-freq-seqs ["CAABC" "ABCB" "CABC" "ABBCA"] 2)
then deref-ing the atom
(deref fs)
yields
#{["B" 4]
["BC" 4]
["AB" 4]
["CA" 3]
["CAC" 2]
["AC" 4]
["ABC" 4]
["CAB" 2]
["A" 4]
["CABC" 2]
["ABB" 2]
["CC" 2]
["CB" 3]
["C" 4]
["BB" 2]
["CBC" 2]
["AA" 2]}
however (doall (mine-freq-seqs ["CAABC" "ABCB" "CABC" "ABBCA"] 2) (deref fs))
just gives #{}
What I want is to let the freq-seq recurse to completion then get the value of the atom fs. So I can call mine-freq-seq and have my result returned in the REPL instead of having to manually deref it there.
First some alternate code without the atom then a look at why you get the empty return.
A more compact version where the sequences in a string are derived with a reduce rather than the recursion with regex and substr.
Then just do a frequencies on those results.
(defn local-seqs
[s]
(->> s
(reduce (fn [acc a] (into acc (map #(conj % a) acc))) #{[]})
(map #(apply str %))
(remove empty?)))
(defn freq-seqs
[sdb min-sup]
(->> (mapcat local-seqs sdb)
frequencies
(filter #(>= (second %) min-sup))
set))
That's the whole thing!
I haven't involved an atom because I didn't see a need but add it at the end if freq-seqs if you like.
For your original question: why the return that you see?
You are calling doall with 2 args, the result of your call and a collection. doall is a function and not a macro so the deref is performed immediately.
(defn doall
;; <snip>
([n coll] ;; you have passed #{} as coll
(dorun n coll) ;; and this line evals to nil
coll) ;; and #{} is returned
You have passed your result as the n arg and an empty set as the coll (from (deref fs))
Now when doall calls dorun, it encounters the following:
(defn dorun
;; <snip>
([n coll]
(when (and (seq coll) (pos? n)) ;; coll is #{} so the seq is falesy
(recur (dec n) (next coll)))) ;; and a nil is returned
Since the empty set from fs is the second arg (coll) and and is a macro, it will be falsey on (seq coll), return nil and then doall returns the empty set that was it's second arg.
Final note:
So that is something that works and why yours failed. As to how to make yours work, to fix the call above I tried:
(do (doall (mine-freq-seqs ["CAABC" "ABCB" "CABC" "ABBCA"] 2))
(deref fs))
That is closer to working but with the recusion in your process, it only forces the eval one level deep. So you could push the doall deeper into your funcs but I have proposed a completely different internal structure so I will leave the rest to you if you really need that structure.
I changed it a bit to remove all of the lazy bits (this happens silently in the repl but can be confusing when it changes outside of the repl). Note the changes with vec, mapv, and doall. At least now I get your result:
(def fs (atom #{}))
(defn locally-frequents
[sdb min-sup]
(let [uniq-sdb (map (comp frequencies set) sdb)
freqs (apply merge-with + uniq-sdb)]
(->> freqs
(filter #(<= min-sup (second %)))
(mapv #(vector (str (first %)) (second %))))))
(defn project-sdb
[sdb prefix]
(if (empty? prefix)
sdb
(into [] (->> sdb
(filter #(re-find (re-pattern (str (last prefix))) %))
(map #(subs % (inc (.indexOf % (str (last prefix))))))
(remove empty?)))))
(defn freq-seq
[sdb prefix prefix-support min-sup frequent-seqs]
(if ((complement empty?) prefix) (swap! fs conj [prefix prefix-support]))
(let [lf (locally-frequents sdb min-sup)]
(if (empty? lf)
nil
(vec (for [[item sup] lf] (freq-seq (project-sdb sdb (str prefix item)) (str prefix item) sup min-sup #fs))))))
(defn mine-freq-seqs
[sdb min-sup]
(freq-seq sdb "" 0 min-sup #fs))
(doall (mine-freq-seqs ["CAABC" "ABCB" "CABC" "ABBCA"] 2))
(deref fs) => #{["B" 4] ["BC" 4] ["AB" 4] ["CA" 3]
["CAC" 2] ["AC" 4] ["ABC" 4] ["CAB" 2]
["A" 4] ["CABC" 2] ["ABB" 2] ["CC" 2] ["CB" 3]
["C" 4] ["BB" 2] ["CBC" 2] ["AA" 2]}
I'm still not really sure what the goal is or how/why you get entries like "CABC".

Clojure - walk with path

I am looking for a function similar to those in clojure.walk that have an inner function that takes as argument :
not a key and a value, as is the case with the clojure.walk/walk function
but the vector of keys necessary to access a value from the top-level data structure.
recursively traverses all data
Example :
;; not good since it takes `[k v]` as argument instead of `[path v]`, and is not recursive.
user=> (clojure.walk/walk (fn [[k v]] [k (* 10 v)]) identity {:a 1 :b {:c 2}})
;; {:a 10, :c 30, :b 20}
;; it should receive as arguments instead :
[[:a] 1]
[[:b :c] 2]
Note:
It should work with arrays too, using the keys 0, 1, 2... (just like in get-in).
I don't really care about the outer parameter, if that allows to simplify the code.
Currently learning clojure, I tried this as an exercise.
I however found it quite tricky to implement it directly as a walk down the tree that applies the inner function as it goes.
To achieve the result you are looking for, I split the task in 2:
First transform the nested structure into a dictionary with the path as key, and the value,
Then map the inner function over, or reduce with the outer function.
My implementation:
;; Helper function to have vector's indexes work like for get-in
(defn- to-indexed-seqs [coll]
(if (map? coll)
coll
(map vector (range) coll)))
;; Flattening the tree to a dict of (path, value) pairs that I can map over
;; user> (flatten-path [] {:a {:k1 1 :k2 2} :b [1 2 3]})
;; {[:a :k1] 1, [:a :k2] 2, [:b 0] 1, [:b 1] 2, [:b 2] 3}
(defn- flatten-path [path step]
(if (coll? step)
(->> step
to-indexed-seqs
(map (fn [[k v]] (flatten-path (conj path k) v)))
(into {}))
[path step]))
;; Some final glue
(defn path-walk [f coll]
(->> coll
(flatten-path [])
(map #(apply f %))))
;; user> (println (clojure.string/join "\n" (path-walk #(str %1 " - " %2) {:a {:k1 1 :k2 2} :b [1 2 3]})))
;; [:a :k1] - 1
;; [:a :k2] - 2
;; [:b 0] - 1
;; [:b 1] - 2
;; [:b 2] - 3
It turns out that Stuart Halloway published a gist that could be of some use (it uses a protocol, which makes it extensible as well) :
(ns user)
(def app
"Intenal Helper"
(fnil conj []))
(defprotocol PathSeq
(path-seq* [form path] "Helper for path-seq"))
(extend-protocol PathSeq
java.util.List
(path-seq*
[form path]
(->> (map-indexed
(fn [idx item]
(path-seq* item (app path idx)))
form)
(mapcat identity)))
java.util.Map
(path-seq*
[form path]
(->> (map
(fn [[k v]]
(path-seq* v (app path k)))
form)
(mapcat identity)))
java.util.Set
(path-seq*
[form path]
(->> (map
(fn [v]
(path-seq* v (app path v)))
form)
(mapcat identity)))
java.lang.Object
(path-seq* [form path] [[form path]])
nil
(path-seq* [_ path] [[nil path]]))
(defn path-seq
"Returns a sequence of paths into a form, and the elements found at
those paths. Each item in the sequence is a map with :path
and :form keys. Paths are built based on collection type: lists
by position, maps by key, and sets by value, e.g.
(path-seq [:a [:b :c] {:d :e} #{:f}])
({:path [0], :form :a}
{:path [1 0], :form :b}
{:path [1 1], :form :c}
{:path [2 :d], :form :e}
{:path [3 :f], :form :f})
"
[form]
(map
#(let [[form path] %]
{:path path :form form})
(path-seq* form nil)))
(comment
(path-seq [:a [:b :c] {:d :e} #{:f}])
;; finding nils hiding in data structures:
(->> (path-seq [:a [:b nil] {:d :e} #{:f}])
(filter (comp nil? :form)))
;; finding a nil hiding in a Datomic transaction
(->> (path-seq {:db/id 100
:friends [{:firstName "John"}
{:firstName nil}]})
(filter (comp nil? :form)))
)
Note : in my case I could also have used Specter, so if you are reading this, you may want to check it out as well.
There is also https://github.com/levand/contextual/
(def node (:b (first (root :a))))
(= node {:c 1}) ;; => true
(c/context node) ;; => [:a 0 :b]

Adding values to vectors and sets

Here is what I have:
(def my-atom (atom []))
(defn add-to-my-atom! [x]
(swap! my-atom conj x))
How do I append value to the vector only if it's not present already? I want to be able to use a predicate for the testing. For example in Common Lisp there is pushnew:
pushnew item place &key key test test-not
Is there something similar in Clojure? Perhaps, I should use sets instead of vectors. Fine. How do you define predicate that set will use to compare its values? For example, set can contain strings, and suppose that differences in case should not affect operations on sets, how Clojure deals with that?
Using a vector:
user> (def my-atom (atom []))
(defn push-new
[place item pred]
(if (pred place item)
(conj place item)
place))
(defn add-to-my-atom!
[x]
(swap! my-atom push-new x
(fn [place item]
(not (some #(= (.toLowerCase %)
(.toLowerCase item))
place)))))
#'user/add-to-my-atom!
user> (add-to-my-atom! "Hello World!")
["Hello World!"]
user> (add-to-my-atom! "hello world!")
["Hello World!"]
user> (add-to-my-atom! "ABCDE")
["Hello World!" "ABCDE"]
user> (add-to-my-atom! "abcde")
["Hello World!" "ABCDE"]
Using a set with a custom sorting comparitor:
user> (def my-atom (atom (sorted-set-by (fn [a b] (compare (.toLowerCase a) (.toLowerCase b))))))
#'user/my-atom
user> (swap! my-atom conj "Hello")
#{"Hello"}
user> (swap! my-atom conj "hello")
#{"Hello"}
user> (swap! my-atom conj "abc")
#{"abc" "Hello"}
user> (swap! my-atom conj "Abc")
#{"abc" "Hello"}
If you were not working with atoms, the fn to add to a vector if it is not there would be:
(defn push-new [v value]
(if (some #{value} v)
v
(conj v value)))
Now you can easily use that fn to move from one value of the atom to the next:
(defn add-to-my-atom [the-atom x]
(swap! the-atom push-new x))
Depending on your use case, a set can be more appropriate. Clojure relies on the equals and hashcode implementation of the objects that you put into the set, unless you use a sorted-set-by, or you can simply uppercase them before putting them into the set.

How to abstract a mancala board in lisp

I'm trying to make a Mancala game in Lisp. It's going to have an AI to play against a human player, but I'm stuck. I can't find the way to represent the board as list; the major issue in my mind is how to move the tokens. Here are the references of how to play mancala
I'm thinking about a circular list, but I can't find any clear documentation on how to do that in Lisp.
Sorry about my grammar; English is not my native language.
Now I havent read the rules (sorry!) so this is just to address the idea of using a circular data structure.
A data structure doesnt have to be circular. As long as you pretend it is it will work!
Have a read of the mod function.
;; a1 a6 b1 b6
(defparameter *board* '(nil nil nil nil nil nil nil nil nil nil nil nil))
(defun wrap-position (pos)
(mod pos (length *board*)))
(defun push-token (position)
(push t (nth (wrap-position position) *board*)))
(defun pull-token (position)
(let ((contents (nth (wrap-position position) *board*)))
(setf (nth (wrap-position position) *board*) (rest contents))))
(defun print-board ()
(format t "| ~{~10<~a~>~} |~%| ~{~10<~a~>~} |" (reverse (subseq *board* 6))
(subseq *board* 0 6))
*board*)
Now the technique above is destructive. If you don't know yet what that is in lisp have a google or search here on stackoveflow, there are some good descriptions. It is worth looking into as you may find that your AI want to 'try out' lots of potential moves with 'damaging' the actual game board, a non destructive approach can help with this. The phenomenal book land of lisp has some great info on this.
Here is a simple usage example
CL-USER> *board*
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
CL-USER> (push-token 5)
(T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T) NIL NIL NIL NIL NIL NIL)
CL-USER> (push-token 5)
(T T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T T) NIL NIL NIL NIL NIL NIL)
CL-USER> (PULL-token 5)
(T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T) NIL NIL NIL NIL NIL NIL)
...I change the board before doing the next bit...
CL-USER> (print-board)
| NIL NIL NIL NIL NIL NIL |
| NIL NIL NIL NIL NIL (T T T T) |
Now have a look at Sylwester's answer and see that you can replace the sublists with just a number of stones. You will need to change the print-board obviously but that gives you a very simple model you can manipulate very easily (almost can be the big step you need to make this non-destructive). Have a go!
I would have used an array of 14 fixnums. index 0-5 are pits for A, 6 is A's basket. 7-12 are pits for player B and 13 is B's basket. You do minimax with copy-array.
If you want lists I would have either had A and B's lists individually or interleaved them. You could also just have a list of 14 cons.
Sorry, I couldn't really understand how to play the game, but here's something I could think about w/r to how to go about the board:
(defstruct (mancala-cell
(:print-object
(lambda (cell stream)
(format stream "<stones: ~d>"
(length (mancala-cell-stones cell))))))
(stones nil :type list)
(next nil))
(defun make-cells ()
(labels ((%make-cells (head count)
(let ((next (make-mancala-cell)))
(setf (mancala-cell-next head) next)
(if (> count 0) (%make-cells next (1- count)) next))))
(let* ((first (make-mancala-cell))
(last (%make-cells first 12)))
(setf (mancala-cell-next last) first))))
(defstruct (mancala-board
(:print-object
(lambda (board stream)
(loop :for i :from 0 :below 12
:for cell := (mancala-board-cells board)
:then (mancala-cell-next cell)
:do (princ (case i
(6 #\Newline) (0 "") (otherwise #\-))
stream)
(princ cell stream)))))
(cells (make-cells) :type mancala-cell))
(print (make-mancala-board))
;; <stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>
;; <stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>
Then here's one more example:
(defstruct (mancala-cell
(:print-object
(lambda (cell stream)
(format stream "<stones: ~d>"
(mancala-cell-stones cell)))))
(stones 4 :type fixnum))
(defconstant +null-cell+ (make-mancala-cell))
(deftype mancala-grid () '(array mancala-cell (12)))
(defun make-cells ()
(loop
:for i :from 0 :below 12
:with result := (make-array
12 :element-type 'mancala-cell
:initial-element +null-cell+)
:do (setf (aref result i) (make-mancala-cell))
:finally (return result)))
(defstruct (mancala-board
(:print-object
(lambda (board stream)
(loop :for i :from 0 :below 12
:for cell :across (mancala-board-cells board)
:do (princ (case i
(6 #\Newline) (0 "") (otherwise #\-))
stream)
(princ cell stream)))))
(cells (make-cells) :type mancala-grid))
(defun map-cells-in-range (function board &key (start 0) (end 12))
(loop
:for i :from start :below end
:with board := (mancala-board-cells board)
:collect (funcall function (aref board (mod i 12)))))
(defun fold-cells-in-range (function board &key (start 0) (end 12))
(loop
:for i :from start :below (1- end)
:with board := (mancala-board-cells board)
:for cell := (aref board (mod i 12))
:for result := (funcall
function
(aref board (mod i 12))
(aref board (mod (1+ i) 12)))
:then (funcall function result (aref board (mod (1+ i) 12)))
:finally (return result)))
(fold-cells-in-range
(lambda (a b)
(+ (mancala-cell-stones b)
(if (integerp a) a (mancala-cell-stones a))))
(make-mancala-board)) ; 48

Merge list of maps and combine values to sets in Clojure

What function can I put as FOO here to yield true at the end? I played with hash-set (only correct for first 2 values), conj, and concat but I know I'm not handling the single-element vs set condition properly with just any of those.
(defn mergeMatches [propertyMapList]
"Take a list of maps and merges them combining values into a set"
(reduce #(merge-with FOO %1 %2) {} propertyMapList))
(def in
(list
{:a 1}
{:a 2}
{:a 3}
{:b 4}
{:b 5}
{:b 6} ))
(def out
{ :a #{ 1 2 3}
:b #{ 4 5 6} })
; this should return true
(= (mergeMatches in) out)
What is the most idiomatic way to handle this?
This'll do:
(let [set #(if (set? %) % #{%})]
#(clojure.set/union (set %) (set %2)))
Rewritten more directly for the example (Alex):
(defn to-set [s]
(if (set? s) s #{s}))
(defn set-union [s1 s2]
(clojure.set/union (to-set s1) (to-set s2)))
(defn mergeMatches [propertyMapList]
(reduce #(merge-with set-union %1 %2) {} propertyMapList))
I didn't write this but it was contributed by #amitrathore on Twitter:
(defn kv [bag [k v]]
(update-in bag [k] conj v))
(defn mergeMatches [propertyMapList]
(reduce #(reduce kv %1 %2) {} propertyMapList))
I wouldn't use merge-with for this,
(defn fnil [f not-found]
(fn [x y] (f (if (nil? x) not-found x) y)))
(defn conj-in [m map-entry]
(update-in m [(key map-entry)] (fnil conj #{}) (val map-entry)))
(defn merge-matches [property-map-list]
(reduce conj-in {} (apply concat property-map-list)))
user=> (merge-matches in)
{:b #{4 5 6}, :a #{1 2 3}}
fnil will be part of core soon so you can ignore the implementation... but it just creates a version of another function that can handle nil arguments. In this case conj will substitute #{} for nil.
So the reduction conjoining to a set for every key/value in the list of maps supplied.
Another solution contributed by #wmacgyver on Twitter based on multimaps:
(defn add
"Adds key-value pairs the multimap."
([mm k v]
(assoc mm k (conj (get mm k #{}) v)))
([mm k v & kvs]
(apply add (add mm k v) kvs)))
(defn mm-merge
"Merges the multimaps, taking the union of values."
[& mms]
(apply (partial merge-with union) mms))
(defn mergeMatches [property-map-list]
(reduce mm-merge (map #(add {} (key (first %)) (val (first %))) property-map-list)))
This seems to work:
(defn FOO [v1 v2]
(if (set? v1)
(apply hash-set v2 v1)
(hash-set v1 v2)))
Not super pretty but it works.
(defn mergeMatches [propertyMapList]
(for [k (set (for [pp propertyMapList] (key (first pp))))]
{k (set (remove nil? (for [pp propertyMapList] (k pp))))}))

Resources