I am learning Clojure and Functional Programming and I am facing another problem that I am stuck and I have no idea how to deal with it. Here is the problem:
I have a vector of vectors:
[[a b][b c][c d][d e][e f][f g][f h][b i][d j][j l][l m][a n][a o][o p]]
And I need to establish a relationship between some of the items. The relationship rules are:
1 - Every item that has the same value as the first column has a direct relationship.
2 - If there is any item with the first column equals the second column from the rule 1, there is also a relationship, but an indirect one.
In our scenario the relationship would be:
Relationship for a (rule 1):
[[a b][a n][a o]]
Relationship for a (rule 2):
[[b c][o p]]
After that I also need to calculate, but I can't figure out how to do this the Functional Programming style with clojure. I have been working with O.O. Programming since 2008 and this is the first time I am learning functional programming.
Any ideas?
Thanks in advance.
ok. the first one is easy:
(def data '[[a b][b c][c d][d e][e f][f g][f h]
[b i][d j][j l][l m][a n][a o][o p]])
(defn rel1 [x data] (filter #(= (first %) x) data))
(rel1 'a data)
;; => ([a b] [a n] [a o])
you just keep all the pairs, whose first item is the one you need
the second one is slightly more complicated. You have to find first level relations for all the first level relations.
e.g: when the first level relations for a are [[a b][a n][a o]], you have to find first level relations for b, n, and o, and concatenate them:
(defn rel2 [x data]
(mapcat (fn [[_ k]] (rel1 k data))
(rel1 x data)))
(rel2 'a data)
;; => ([b c] [b i] [o p])
as a bonus:
you can make up a function to compute any nth relation of this kind:
if you already have rel1:
(defn rel1 [x data] (filter #(= (first %) x) data))
(defn rel-n [x data n]
(when (pos? n)
(nth (iterate #(mapcat (fn [[_ k]] (rel1 k data)) %)
[[nil x]])
n)))
in repl:
user> (rel-n 'a data 0)
nil
user> (rel-n 'a data 1)
([a b] [a n] [a o])
user> (rel-n 'a data 2)
([b c] [b i] [o p])
user> (rel-n 'a data 3)
([c d])
user> (rel-n 'a data 4)
([d e] [d j])
user> (rel-n 'a data 5)
([e f] [j l])
user> (rel-n 'a data 6)
([f g] [f h] [l m])
user> (rel-n 'a data 7)
()
Related
I am trying to write up a simple Markovian state space models, that, as the name suggests iteratively looks back one step to predict the next state.
Here is what is supposed to be a MWE, though it is not because I cannot quite figure out how I am supposed to place (recur ... ) in the below code.
;; helper function
(defn dur-call
[S D]
(if (< 1 D)
(- D 1)
(rand-int S)))
;; helper function
(defn trans-call
[S D]
(if (< 1 D)
S
(rand-int 3)))
;; state space model
(defn test-func
[t]
(loop
[S (rand-int 3)]
(if (<= t 0)
[S (rand-int (+ S 1))]
(let [pastS (first (test-func (- t 1)))
pastD (second (test-func (- t 1)))
S (trans-call pastS pastD)]
(recur ...?)
[S (dur-call S pastD)]))))
My target is to calculate some a state at say time t=5 say, in which case the model needs to look back and calculate states t=[0 1 2 3 4] as well. This should, in my mind, be done well with loop/recur but could also be done with reduce perhaps (not sure how, still new to Clojure). My problem is really that it would seemt have to use recur inside let but that should not work given how loop/recur are designed.
your task is really to generate the next item based on the previous one, starting with some seed. In clojure it can be fulfilled by using iterate function:
user> (take 10 (iterate #(+ 2 %) 1))
(1 3 5 7 9 11 13 15 17 19)
you just have to define the function to produce the next value. It could look like this (not sure about the correctness of the computation algorithm, just based on what is in the question):
(defn next-item [[prev-s prev-d :as prev-item]]
(let [s (trans-call prev-s prev-d)]
[s (dur-call s prev-d)]))
and now let's iterate with it, starting from some value:
user> (take 5 (iterate next-item [3 4]))
([3 4] [3 3] [3 2] [3 1] [0 0])
now your test function could be implemented this way:
(defn test-fn [t]
(when (not (neg? t))
(nth (iterate next-item
(let [s (rand-int 3)]
[s (rand-int (inc s))]))
t)))
you can also do it with loop (but it is still less idiomatic):
(defn test-fn-2 [t]
(when (not (neg? t))
(let [s (rand-int 3)
d (rand-int (inc s))]
(loop [results [[s d]]]
(if (< t (count results))
(peek results)
(recur (conj results (next-item (peek results)))))))))
here we pass all the accumulated results to the next iteration of the loop.
also you can introduce the loop's iteration index and just pass around the last result together with it:
(defn test-fn-3 [t]
(when (not (neg? t))
(let [s (rand-int 3)
d (rand-int (inc s))]
(loop [result [s d] i 0]
(if (= i t)
result
(recur (next-item result) (inc i)))))))
and one more example with reduce:
(defn test-fn-4 [t]
(when (not (neg? t))
(reduce (fn [prev _] (next-item prev))
(let [s (rand-int 3)
d (rand-int (inc s))]
[s d])
(range t))))
I just started learning Clojure and functional programming and I'm having a difficult time trying to implement the following task:
I have a vector of vectors like this [[a b] [a c] [b c] [c d] [d b]]. And I need to iterate through it removing the items that appears on the second column that had already appeared on the second column. For example the items [b c] and [d b] (because both c and b already appeared on the second column). I managed to get a function that remove one item at the time, but I need to iterate through the vector for each item checking and removing the items. How can I achieve that? I thought about using recursion to achieve that, but every attempt ended up in failure Sorry if this is a trivial question, but I am stuck with that.
For example
Input:
[[a b] [a c] [b c] [c d] [a d] [b e]]
Ouput (Expected):
[[a b] [a c] [c d] [b e]]
Removed items:
[[b c] [a d]]
As you can see, both c and d had already appeared on the previous items [a c] and [c d] respectively, so I have to remove the items [b c] and [a d].
So far, I have the following code
This function returns a vector of items to be removed. In our scenario, it returns the vector [[b c] [a d]]
(defn find-invalid [collection-data item-to-check]
(subvec (vec (filter #(= (second %) item-to-check) collection-data)) 1))
(defn find-invalid [collection-data item-to-check]
(subvec (vec (filter #(= (second %) item-to-check) collection-data)) 1))
This other function removes one item at a time from the original vector by a given index of the item
(defn remove-invalid [collection-data item-position]
(vec (concat (subvec collection-data 0 item-position) (subvec collection-data (inc item-position)))))
This last function is what I did to test this logic
(defn remove-invalid [original-collection ]
(dorun (for [item original-collection]
[
(dorun (for [invalid-item (find-invalid original-collection (second item))]
[
(cond (> (count invalid-item) 0)
(println (remove-invalid original-collection (.indexOf original-collection invalid-item)))
)
]))
])))
I think recursion could solve my problem, but I would appreciate any help to get that done :).
Thanks in advance.
One way to implement this would be to use reduce:
(first (reduce (fn [[result previous] [a b]]
[(if (contains? previous b)
result
(conj result [a b]))
(conj previous b)])
[[] #{}]
'[[a b] [a c] [b c] [c d] [d b]]))
;=> [[a b] [a c] [c d]]
We want to keep track of the result we've built up so far (result) and the set of items we've previously found in the second column (previous). For each new item [a b], then, we check whether previous contains the second item, b. If it does, we don't add anything to our result. Otherwise, we conj the new item [a b] onto the end of result. We also conj the second item, b, into previous. Since previous is a set, this won't do anything if previous already contained b. Finally, after the reduce completes, we take the first item from the result, which represents our final answer.
If I understand your question correctly, this should do it:
(defn clear [v]
(loop [v v existing #{} acc []]
(if (empty? v)
acc
(recur (rest v)
(conj existing (second (first v)))
(if (some existing [(ffirst v)]) acc (conj acc (first v)))))))
Solved with loop / recur. If I got some time I will see if I can use something like reduce or whatever function is appropriate here.
This filters: [["a" "b"] ["a" "c"] ["b" "c"] ["c" "d"] ["d" "b"]] to [["a" "b"] ["a" "c"]].
If you can rely on the duplicates being successive as in the example, go with
(->> '[[a b] [a c] [b c] [c d] [a d] [b e]]
(partition-by second)
(map first))
;-> ([a b] [a c] [c d] [b e])
Otherwise implement a distinct-by transducer based on Clojures distinct transducer.
(sequence (distinct-by second)
'[[a b] [a c] [b c] [c d] [a d] [b e]])
;-> ([a b] [a c] [c d] [b e])
Implementation
(defn distinct-by [f]
(fn [rf]
(let [seen (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [vinput (f input)] ; virtual input as seen through f
(if (contains? #seen vinput)
result
(do (vswap! seen conj vinput)
(rf result input)))))))))
The following is similar to #Elogent's answer, but uses :as clauses to avoid reconstructing things:
(defn filtered [stuff]
(second
(reduce
(fn [[seconds ans :as sec-ans] [x y :as xy]]
(if (seconds y)
sec-ans
[(conj seconds y) (conj ans xy)]))
[#{} []]
stuff)))
For example,
(filtered '[[a b] [a c] [b c] [c d] [d b]])
;[[a b] [a c] [c d]]
just for fun:
these ones do not preserve the result's order, but if it is ok with you, they're quite expressive (the duplicates can be in any order, unlike the partition-by variant above):
one is to just group everything by second value, and take first item from every val:
(map (comp first val)
(group-by second '[[a b] [a c] [b c] [c d] [a d] [b e]]))
;; => ([a b] [a c] [c d] [b e])
there is also a nice way to do it, using sorted sets:
(into (sorted-set-by #(compare (second %1) (second %2)))
'[[a b] [a c] [b c] [c d] [a d] [b e]])
;; => #{[a b] [a c] [c d] [b e]}
and one more, also not preserving the order:
(vals (into {} (map (juxt second identity)
(rseq '[[a b] [a c] [b c] [c d] [a d] [b e]]))))
;; => ([b e] [c d] [a c] [a b])
but yes, loop/recur is always faster i guess:
(defn remove-dupes [v]
(loop [[[_ i2 :as pair] & xs :as v] v present #{} res []]
(cond (empty? v) res
(present i2) (recur xs present res)
:else (recur xs (conj present i2) (conj res pair)))))
I'm a bit lost with usage of transients in clojure. Any help will be appreciated.
The sample code:
(defn test-transient [v]
(let [b (transient [])]
(for [x v] (conj! b x))
(persistent! b)))
user> (test-transient [1 2 3])
[]
I tried to make it persistent before return and the result is:
(defn test-transient2 [v]
(let [b (transient [])]
(for [x v] (conj! b x))
(persistent! b)
b))
user> (test-transient2 [1 2 3])
#<TransientVector clojure.lang.PersistentVector$TransientVector#1dfde20>
But if I use conj! separately it seems work ok:
(defn test-transient3 [v]
(let [b (transient [])]
(conj! b 0)
(conj! b 1)
(conj! b 2)
(persistent! b)))
user> (test-transient3 [1 2 3])
[0 1 2]
Does for has some constraint? If so, how can i copy values from persistent vector to transient?
Thank you.
Transients aren't supposed to be bashed in-place like that. Your last example only works due to implementation details which you shouldn't rely on.
The reason why for doesn't work is that it is lazy and the conj! calls are never executed, but that is besides the point, as you shouldn't work with transients that way anyway.
You should use conj! the same way as you would use the "regular" conj with immutable vectors - by using the return value.
What you are trying to do could be accomplished like this:
(defn test-transient [v]
(let [t (transient [])]
(persistent! (reduce conj! t v))))
Here is the situation: I have a vector of vectors ("data"), a set of headers, a subset of headers ("primary headers"), a constant ("C"), an element-wise function ("f"), and the remaining headers ("secondary headers"). My goal is to take the "data" and produce a new vector of vectors.
Example data:
[[1.0 "A" 2.0]
[1.0 "B" 4.0]]
Example headers:
["o1" "i1" "i2"]
Example primary headers:
["i1" "i2"]
Example secondary headers:
["o1"]
Example new vector of vectors:
[[(f "A") (f 2.0) C (f 1.0)]
[(f "B") (f 4.0) C (f 1.0)]]
My current attempt is to mapv each row, then map-indexed each element with an if to check for primary membership, then the constant, then map-indexed each element with an if to check for secondary membership, finally conj on the results. But I am not getting it to work right.
Example code:
(mapv (fn [row] (conj (vec (flatten (map-indexed
(fn [idx item] (let [header-name (nth headers idx)]
(if (= (some #{header-name} primary-headers) headers-name) (f item))))
row)))
C
(vec (flatten (map-indexed
(fn [idx item] (let [header-name (nth headers idx)]
(if (= (some #{header-name} secondary-headers) headers-name) (f item))))
row)))))
data)
You should consider using core.matrix for stuff like this. It is a very flexible tool for multi-dimensional array programming in Clojure.
Most array-manipulation operations are likely to be 1-2 liners.....
(def DATA [[1.0 "A" 2.0]
[1.0 "B" 4.0]])
(emap (partial str "f:") (transpose (mapv #(get-column DATA %) [1 0 2])))
=> [["f:A" "f:1.0" "f:2.0"]
["f:B" "f:1.0" "f:4.0"]]
You might need to look up the column names to calculate the [1 0 2] vector but hopefully this gives you a good idea how to do this....
Not sure if I got your problem right, but looks like you want something like this:
(defn magic [data h p s f]
(let [idx (map (into {} (map-indexed #(vector %2 %1) h))
(concat p s))]
(mapv #(mapv (comp f (partial get %))
idx)
data)))
Here is an example of my magic function:
(magic [[1.0 "A" 2.0]
[1.0 "B" 4.0]]
["o1" "i1" "i2"]
["i1" "i2"]
["o1"]
#(str "<" % ">"))
[["<A>" "<2.0>" "<1.0>"]
["<B>" "<4.0>" "<1.0>"]]
Let's get a closer look at it.
First of all, I'm calculating permutation index idx. In your case it's (1 2 0). In order to calculate it I'm turning ["o1" "i1" "i2"] into a hash map {"o1" 0, "i1" 1, "i2" 2} and then using it on ("i1" "i2" "o1") sequence of primary and secondary headers.
Then I'm using idx to rearrange data matrix. On this step I'm also applying f function to each element of new rearranged matrix.
Update
I thought that it'll be best to split my complicated magic function into three simpler ones:
(defn getPermutation [h1 h2]
(map (into {} (map-indexed #(vector %2 %1) h1))
h2))
(defn permutate [idx data]
(mapv #(mapv (partial get %) idx)
data)))
(defn mmap [f data]
(mapv (partial mapv f)
data))
Each function here is atomic (i.e. performing a single task), and they all could be easily combined to do exactly what magic function do:
(defn magic [data h p s f]
(let [idx (getPermutation h (concat p s))]
(->> data
(permutate idx)
(mmap f))))
getPermutation function here calculates idx permutation index vector.
permutate rearranges columns of a matrix data according to given idx vector.
mmap applies function f to each element of a matrix data.
Update 2
Last time I missed the part about adding a constant. So, in order to do so we'll need to change some of the code. Let's change permutate function allowing it to insert new values to the matrix.
(defn permutate [idx data & [default-val]]
(mapv #(mapv (partial get %) idx (repeat default-val))
data)))
Now, it'll use default-val if it won't be able to get the element with the specified index idx.
We'll also need a new magic function:
(defn magic2 [data h p s f c]
(let [idx (getPermutation h (concat p [nil] s))]
(permutate idx (mmap f data) c)))
I changed the order of applying mmap and permutate functions because it seems that you don't want to apply f to your constant.
And it works:
(magic2 [[1.0 "A" 2.0]
[1.0 "B" 4.0]]
["o1" "i1" "i2"]
["i1" "i2"]
["o1"]
#(str "<" % ">")
"-->")
[["<A>" "<2.0>" "-->" "<1.0>"]
["<B>" "<4.0>" "-->" "<1.0>"]]
Given
(def data [[1.0 "A" 2.0] [1.0 "B" 4.0]])
(def headers ["o1" "i1" "i2"])
(def primaries ["i1" "i2"])
(def secondaries ["o1"])
(defn invert-sequence [s] (into {} (map-indexed (fn [i x] [x i]) s)))
... this does the job:
(defn produce [hs ps ss f data const]
(let [perms (map #(mapv (invert-sequence hs) %) [ps ss])]
(mapv (fn [v] (->> perms
(map #(map (comp f v) %))
(interpose [const])
(apply concat)
vec))
data)))
Using the example in the question:
(produce headers primaries secondaries #(list 'f %) data 'C)
; [[(f "A") (f 2.0) C (f 1.0)] [(f "B") (f 4.0) C (f 1.0)]]
Using Leonid Beschastny's example:
(produce headers primaries secondaries #(str "<" % ">") data 'C)
; [["<A>" "<2.0>" C "<1.0>"] ["<B>" "<4.0>" C "<1.0>"]]
Using str:
(produce headers primaries secondaries str data 'C)
; [["A" "2.0" C "1.0"] ["B" "4.0" C "1.0"]]
Using identity:
(produce headers primaries secondaries identity data 'C)
; [["A" 2.0 C 1.0] ["B" 4.0 C 1.0]]
This is my input data:
[[:a 1 2] [:a 3 4] [:a 5 6] [:b \a \b] [:b \c \d] [:b \e \f]]
I would like to map this into the following:
{:a [[1 2] [3 4] [5 6]] :b [[\a \b] [\c \d] [\e \f]]}
This is what I have so far:
(defn- build-annotation-map [annotation & m]
(let [gff (first annotation)
remaining (rest annotation)
seqname (first gff)
current {seqname [(nth gff 3) (nth gff 4)]}]
(if (not (seq remaining))
m
(let [new-m (merge-maps current m)]
(apply build-annotation-map remaining new-m)))))
(defn- merge-maps [m & ms]
(apply merge-with conj
(when (first ms)
(reduce conj ;this is to avoid [1 2 [3 4 ... etc.
(map (fn [k] {k []}) (keys m))))
m ms))
The above produces:
{:a [[1 2] [[3 4] [5 6]]] :b [[\a \b] [[\c \d] [\e \f]]]}
It seems clear to me that the problem is in merge-maps, specifically with the function passed to merge-with (conj), but after banging my head for a while now, I'm about ready for someone to help me out.
I'm new to lisp in general, and clojure in particular, so I also appreciate comments not specifically addressing the problem, but also style, brain-dead constructs on my part, etc. Thanks!
Solution (close enough, anyway):
(group-by first [[:a 1 2] [:a 3 4] [:a 5 6] [:b \a \b] [:b \c \d] [:b \e \f]])
=> {:a [[:a 1 2] [:a 3 4] [:a 5 6]], :b [[:b \a \b] [:b \c \d] [:b \e \f]]}
(defn build-annotations [coll]
(reduce (fn [m [k & vs]]
(assoc m k (conj (m k []) (vec vs))))
{} coll))
Concerning your code, the most significant problem is naming. Firstly, I wouldn't, especially without first understanding your code, have any idea what is meant by annotation, gff, and seqname. current is pretty ambiguous too. In Clojure, remaining would generally be called more, depending on the context, and whether a more specific name should be used.
Within your let statement, gff (first annotation)
remaining (rest annotation), I'd probably take advantage of destructuring, like this:
(let [[first & more] annotation] ...)
If you would rather use (rest annotation) then I'd suggest using next instead, as it will return nil if it's empty, and allow you to write (if-not remaining ...) rather than (if-not (seq remaining) ...).
user> (next [])
nil
user> (rest [])
()
In Clojure, unlike other lisps, the empty list is truthy.
This article shows the standard for idiomatic naming.
Works at least on the given data set.
(defn build-annotations [coll]
(reduce
(fn [result vec]
(let [key (first vec)
val (subvec vec 1)
old-val (get result key [])
conjoined-val (conj old-val val)]
(assoc
result
key
conjoined-val)))
{}
coll))
(build-annotations [[:a 1 2] [:a 3 4] [:a 5 6] [:b \a \b] [:b \c \d] [:b \e \f]])
I am sorry for not offering improvements on your code. I am just learning Clojure and it is easier to solve problems piece by piece instead of understanding a bigger piece of code and finding the problems in it.
Although I have no comments to your code yet, I tried it for my own and came up with this solution:
(defn build-annotations [coll]
(let [anmap (group-by first coll)]
(zipmap (keys anmap) (map #(vec (map (comp vec rest) %)) (vals anmap)))))
Here's my entry leveraging group-by, although several steps in here are really concerned with returning vectors rather than lists. If you drop that requirement, it gets a bit simpler:
(defn f [s]
(let [g (group-by first s)
k (keys g)
v (vals g)
cleaned-v (for [group v]
(into [] (map (comp #(into [] %) rest) group)))]
(zipmap k cleaned-v)))
Depending what you actually want, you might even be able to get by with just doing group-by.
(defn build-annotations [coll]
(apply merge-with concat
(map (fn [[k & vals]] {k [vals]})
coll))
So,
(map (fn [[k & vals]] {k [vals]})
coll))
takes a collection of [keys & values] and returns a list of {key [values]}
(apply merge-with concat ...list of maps...)
takes a list of maps, merges them together, and concats the values if a key already exists.