3
\$\begingroup\$

I have some code here that I am very unhappy with. The task I am trying to accomplish is this.

Given a 2d vec like this:

[[0 2 0] [1 3 5] [3 3 0]]

which can contain positive ints including zero I want to remove all lines that are greater zero.

Where the definition of line is the following:

A line is represented by the position n in every vec inside the 2d vec.

So my example above has three lines:

[0 1 3], [2 3 3] and [0 5 0].

The line that I want to remove from it according to my algortihm is [2 3 3] because every element is greater than zero.

So my 2d vec would now look like this:

[[0 0] [1 5] [3 0]]

And finally I want to pad the vecs to their original size filling them with zero for every removed line, so that it looks finally like this:

[[0 0 0] [0 1 5] [0 3 0]]

This is what I came up with:

(defn in?
  "true if seq contains elm"
  [seq elm]
  (some #(= elm %) seq))

(defn not-in?
  "true if seq does not contain elm"
  [seq elm]
  (not (in? seq elm)))

(defn all-greater-zero-at
  "Given a 2-d vec [[0 1] [0 2]] return true if all elements at 'at' are
  greater than zero"
  [v at]
  (not-in? (map #(if (> (nth % at) 0) true false) v) false))

(defn to-be-removed
  "Returns a seq of positions to be removed (0 3 4)"
  [v width]
  (reduce (fn [a b] (if (all-greater-zero-at v b) (conj a b) a)) [] (range width)))

(defn remove-at
  "Removes an element from a 1d vec"
  [v at]
  (into [] (concat (subvec v 0 at) (subvec v (+ at 1) (count v)))))

(defn insert-at
  "inserts an element into a 1d vec"
  [v elm at]
  (into [] (concat (subvec v 0 at) elm (subvec v at (count v)))))

(defn remove-and-replace-all-at
  [v at]
  (map #(insert-at (remove-at % at) [0] at) v))

(defn replace-full-by-zero [v width]
  (reduce (fn [a b] (remove-and-replace-all-at a b)) v (to-be-removed v width)))

(defn remove-zeros [v at]
  (reduce (fn [a b] (conj a (remove-at b at))) [] v))

(defn fill-with-zeros
  "Takes a 2d vec and pads ith with zeros up to width"
  [v width]
  (map #(into [] (concat (take (- width (count (first v))) (repeat 0)) %)) v))

(defn clean-grid
  "removes all full lines"
  [fbz tbr]
  (loop [acc fbz tbr tbr i 0]
    (if (empty? tbr)
      acc
      (recur (remove-zeros acc (- (first tbr) i)) (rest tbr) (inc i)))))

(defn remove-full-lines [v width]
  (let [fbz (replace-full-by-zero v width)
        tbr (to-be-removed v width)
        cleaned-grid (clean-grid fbz tbr)]
    (into [] (fill-with-zeros cleaned-grid width))))

This seems like a lot of code for such a "simple" algorithm and I assume there are a lot of better ways to do that, but just did not come up with a better one, so, please, go ahead and fix it, if you want to.

\$\endgroup\$
  • \$\begingroup\$ Those look like 3D vecs, not 2D. \$\endgroup\$ – 200_success May 16 '15 at 16:17
3
\$\begingroup\$

A transpose function would be useful here. This is the code I came up with:

(defn transpose [m]
  "Transposes a matrix, returning a new matrix. For 2D matrices, rows and columns are swapped."
  (vec (apply map vector m)))

(defn any-zero? [r]
  ((complement not-any?) #(= 0 %) r))

(defn empty-matrix [x y]
  (vec (repeat y (vec (repeat x 0)))))

(defn filter-matrix [m]
  (let [row-size (-> m first count)
        fm (filterv any-zero? m)
        padding-size (- (count m) (count fm))]
          (into (empty-matrix row-size padding-size) fm)))

(defn transform-matrix [m]
  (-> m
      transpose
      filter-matrix
      transpose))

Let's try it out:

=> (transform-matrix [[0 2 0] [1 3 5] [3 3 0]])
[[0 0 0] [0 1 5] [0 3 0]]

If you want to do more advanced operations on matrices I recommend looking into the core.matrix library.

Hope this helps!

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks, this works. I just wonder why you call transpose three times in de-transpose? Shouldn't a single transpose be enough for the transformation back? \$\endgroup\$ – sveri May 16 '15 at 6:38
  • \$\begingroup\$ @sveri Ah yes, you are right. I'll update my answer. \$\endgroup\$ – Dirk Geurs May 16 '15 at 9:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.