Ideas on amithgeorge/reddit-dailyprogrammer-clojure 214_intermediate.clj

0001-index-papers-by-canvas-region.patch

From 82dab3592fcc4f51fa2ce25133617502b1671429 Mon Sep 17 00:00:00 2001
From: Leif Poorman <leif.poorman@gmail.com>
Date: Sun, 17 May 2015 20:30:12 -0400
Subject: [PATCH 1/3] index papers by canvas region

---
 src/rdp/214_intermediate.clj | 87 +++++++++++++++++++++++++++++++++-----------
 1 file changed, 66 insertions(+), 21 deletions(-)

diff --git a/src/rdp/214_intermediate.clj b/src/rdp/214_intermediate.clj
index 3fd26d1..f05d15d 100644
--- a/src/rdp/214_intermediate.clj
+++ b/src/rdp/214_intermediate.clj
@@ -1,6 +1,8 @@
 (ns rdp.214-intermediate
   (:require [clojure.java.io :as io]))
 
+(def BLOCKS 10)
+
 (defn- read-line-ints
   ([] (read-line-ints (read-line)))
   ([input-line]
@@ -30,9 +32,9 @@
          :canvas-width canvas-width
          :canvas-height canvas-height}))))
 
-(defn- read-input-file 
+(defn- read-input-file
   [file-name]
-  (with-open 
+  (with-open
    [rdr (io/reader (io/resource file-name))]
     (binding [*in* rdr]
       (parse-inputs))))
@@ -46,41 +48,84 @@
   [[canvas-x canvas-y] {:keys [x1 y1 x2 y2]}]
   (and (<= x1 canvas-x x2) (<= y1 canvas-y y2)))
 
-(defn- visible-color
+(defn- intersects?
+  [{left-1 :x1 top-1 :y1 right-1 :x2 bottom-1 :y2 :as rect1}
+   {left-2 :x1 top-2 :y1 right-2 :x2 bottom-2 :y2 :as rect2}]
+  (not
+   (or (> left-1 right-2) ; 1 to right of 2
+       (< right-1 left-2) ; 1 to left of 2
+       (> top-1 bottom-2) ; 1 below 2
+       (< bottom-1 top-2) ; 1 above 2
+       )))
+
+(defn- coarse-index [canvas x y]
+  (let [x-step (int (Math/ceil (/ (:w canvas) (float BLOCKS))))
+        y-step (int (Math/ceil (/ (:h canvas) (float BLOCKS))))
+        x-idx (quot x x-step)
+        y-idx (quot y y-step)]
+    (+ (* BLOCKS y-idx) x-idx)))
+
+(defn- subdiv-rect [canvas x-idx y-idx]
+  (let [x-step (int (Math/ceil (/ (:w canvas) BLOCKS)))
+        y-step (int (Math/ceil (/ (:h canvas) BLOCKS)))]
+    (make-paper 0 (* x-idx x-step) (* y-idx y-step) x-step y-step)))
+
+(defn- make-paper-index [canvas papers]
+  (reduce
+   (fn [index [xi yi]]
+     (let [rect (subdiv-rect canvas xi yi)]
+       (assoc index
+              (+ (* BLOCKS yi) xi)
+              (filterv #(intersects? rect %) papers))))
+   {}
+   (for [xi (range BLOCKS) yi (range BLOCKS)] [xi yi])))
+
+(defn- old-visible-color
   [coord papers]
   (some #(when (covered? coord %1) (:color %1))
-        papers))
+          papers))
+
+(defn- visible-color
+  [coord canvas paper-index]
+  (let [i (apply coarse-index canvas coord)
+        papers (get paper-index i [])]
+    (some #(when (covered? coord %1) (:color %1))
+          papers)))
 
 (defn- visible-color-frequencies
-  [{:keys [canvas-width canvas-height papers]}]
-  (persistent!
-   (reduce 
-    (fn [acc coord]
-      (if-let [color (visible-color coord papers)]
-        (assoc! acc color (inc (get acc color 0)))
-        acc))
-    (transient {})
-    (for [y (range canvas-height)
-          x (range canvas-width)]
-      [x y]))))
+  [{:keys [canvas-width canvas-height papers paper-index]}]
+  (let [canvas (last papers)]
+    (persistent!
+     (reduce
+      (fn [acc coord]
+        (if-let [color (visible-color coord canvas paper-index)]
+          (assoc! acc color (inc (get acc color 0)))
+          acc))
+      (transient {})
+      (for [y (range canvas-height)
+            x (range canvas-width)]
+        [x y])))))
 
 (defn- solve
   [input-file]
   (let [input (read-input-file input-file)
+        input (assoc input
+                     :paper-index
+                     (make-paper-index (last (:papers input)) (:papers input)))
         color-map (visible-color-frequencies input)
         sorted (sort-by key color-map)]
     (doseq [line sorted]
       (println (key line) (val line)))))
 
-;; (defn -main 
+;; (defn -main
 ;;   ([] (-main 0))
-;;   ([index] 
+;;   ([index]
 ;;    (time (solve (input-files (Integer/parseInt index))))))
 
-(defn -main 
+(defn -main
   ([] (-main "0"))
-  ([index] 
-   (time 
+  ([index]
+   (time
     (binding [*unchecked-math* :warn-on-boxed
-              *warn-on-reflection* true] 
+              *warn-on-reflection* true]
       (solve (input-files (Integer/parseInt index)))))))
-- 
1.9.1

0002-Calculate-blockwise-parallelize.patch

From 409422b84867113f444c885da7b735bc323eed3f Mon Sep 17 00:00:00 2001
From: Leif Poorman <leif.poorman@gmail.com>
Date: Sun, 17 May 2015 21:06:29 -0400
Subject: [PATCH 2/3] Calculate blockwise; parallelize

---
 src/rdp/214_intermediate.clj | 43 +++++++++++++++++++++++++++++--------------
 1 file changed, 29 insertions(+), 14 deletions(-)

diff --git a/src/rdp/214_intermediate.clj b/src/rdp/214_intermediate.clj
index f05d15d..8f661d4 100644
--- a/src/rdp/214_intermediate.clj
+++ b/src/rdp/214_intermediate.clj
@@ -93,18 +93,17 @@
           papers)))
 
 (defn- visible-color-frequencies
-  [{:keys [canvas-width canvas-height papers paper-index]}]
-  (let [canvas (last papers)]
-    (persistent!
-     (reduce
-      (fn [acc coord]
-        (if-let [color (visible-color coord canvas paper-index)]
-          (assoc! acc color (inc (get acc color 0)))
-          acc))
-      (transient {})
-      (for [y (range canvas-height)
-            x (range canvas-width)]
-        [x y])))))
+  [xlo xhi ylo yhi papers]
+  (persistent!
+   (reduce
+    (fn [acc coord]
+      (if-let [color (old-visible-color coord papers)]
+        (assoc! acc color (inc (get acc color 0)))
+        acc))
+    (transient {})
+    (for [y (range ylo yhi)
+          x (range xlo xhi)]
+      [x y]))))
 
 (defn- solve
   [input-file]
@@ -112,7 +111,22 @@
         input (assoc input
                      :paper-index
                      (make-paper-index (last (:papers input)) (:papers input)))
-        color-map (visible-color-frequencies input)
+        w (:canvas-width input)
+        h (:canvas-height input)
+        canvas (last (:papers input))
+        xstep (int (Math/ceil (/ w (float BLOCKS))))
+        ystep (int (Math/ceil (/ h (float BLOCKS))))
+        maps (doall
+              (pmap (fn [[xi yi]]
+                      (let [xlo (* xstep xi)
+                            ylo (* ystep yi)
+                            xhi (min w (+ xstep xlo))
+                            yhi (min h (+ ystep ylo))
+                            idx (coarse-index canvas xlo ylo)
+                            papers (get (:paper-index input) idx)]
+                        (visible-color-frequencies xlo xhi ylo yhi papers)))
+                    (for [xi (range BLOCKS) yi (range BLOCKS)] [xi yi])))
+        color-map (apply merge-with + maps)
         sorted (sort-by key color-map)]
     (doseq [line sorted]
       (println (key line) (val line)))))
@@ -128,4 +142,5 @@
    (time
     (binding [*unchecked-math* :warn-on-boxed
               *warn-on-reflection* true]
-      (solve (input-files (Integer/parseInt index)))))))
+      (solve (input-files (Integer/parseInt index)))))
+   (shutdown-agents)))
-- 
1.9.1

0003-Make-paper-a-record-use-direct-field-access.patch

From 18622f3c7d5e7d051a2550ec232fb41d5fa56c12 Mon Sep 17 00:00:00 2001
From: Leif Poorman <leif.poorman@gmail.com>
Date: Sun, 17 May 2015 21:19:56 -0400
Subject: [PATCH 3/3] Make paper a record; use direct field access

---
 src/rdp/214_intermediate.clj | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/src/rdp/214_intermediate.clj b/src/rdp/214_intermediate.clj
index 8f661d4..c9568b3 100644
--- a/src/rdp/214_intermediate.clj
+++ b/src/rdp/214_intermediate.clj
@@ -11,16 +11,12 @@
           (#(clojure.string/split %1 #" "))
           (map #(Integer/parseInt %1))))))
 
+(defrecord Paper [color x1 y1 w h x2 y2])
+
 (defn- make-paper
   ([w h] (make-paper 0 0 0 w h))
   ([color x y w h]
-   {:color color
-    :x1 x
-    :y1 y
-    :w w
-    :h h
-    :x2 (dec (+ x w))
-    :y2 (dec (+ y h))}))
+   (->Paper color x y w h (dec (+ x w)) (dec (+ y h)))))
 
 (defn- parse-inputs
   []
@@ -45,8 +41,8 @@
    "100rects3Kx3K.in"])
 
 (defn- covered?
-  [[canvas-x canvas-y] {:keys [x1 y1 x2 y2]}]
-  (and (<= x1 canvas-x x2) (<= y1 canvas-y y2)))
+  [[canvas-x canvas-y] ^Paper p]
+  (and (<= (.x1 p) canvas-x (.x2 p)) (<= (.y1 p) canvas-y (.y2 p))))
 
 (defn- intersects?
   [{left-1 :x1 top-1 :y1 right-1 :x2 bottom-1 :y2 :as rect1}
-- 
1.9.1

README.md

Some ideas on amithgeorge/reddit-dailyprogrammer-clojure, problem 214_intermediate.

I started with this commit.

Then I:

1. Divided the canvas into 10x10 blocks, created an index of {blockindex -> papers that intersect that block}. The reasoning is that if we calculate which block a pixel is in, we only need to check the papers that intersect that block.
2. Changed the code to calculate colors for a block at a time; after that, it was a simple 2-line change to parallelize the work using pmap
3. Make paper a record; use direct field access (this resulted in a modest improvement, but maybe not worth it).
4. EDIT: use arrays for papers and color histogram, primitive type hints on Paper record fields

I made no effort to clean up the code or reduce duplication, sorry for the hacky stream-of-consciousness code.

Performance

I ran lein run 1 after every commit, and got:

• Original code: 528477.159348 msecs
• After indexing: 105969.135633 msecs (~5x speedup)
• After parallelization: 12879.919062 msecs (~8x speedup again, on 12-core machine)
• After making Paper a record: 11408.637102 msecs (~10% speedup)
• EDIT: After using arrays for papers and color histogram and type hinting record fields: 1155.723592 msecs

The OP amithgeorge said here that the original code ran in 250-500 seconds on his machine (I'm unsure which version each benchmark was for). His C# version ran in 40 seconds. So I would say 11 seconds (or even 106) is a respectable showing.

EDIT: 1 second is definitely acceptable, don't you think?

Final_214_intermediate.clj

(ns rdp.214-intermediate
  (:require [clojure.java.io :as io]))

(def BLOCKS 10)

(defn- read-line-ints
  ([] (read-line-ints (read-line)))
  ([input-line]
   (if-let [line input-line]
     (->> line
          (#(clojure.string/split %1 #" "))
          (map #(Integer/parseInt %1))))))

(defrecord Paper [^long color ^long x1 ^long y1 ^long w ^long h ^long x2 ^long y2])

(defn- make-paper
  ([w h] (make-paper 0 0 0 w h))
  ([color x y w h]
   (->Paper color x y w h (dec (+ x w)) (dec (+ y h)))))

(defn- parse-inputs
  []
  (let [[canvas-width canvas-height] (read-line-ints)]
    (loop [papers (list (make-paper canvas-width canvas-height))
           colors #{0}]
      (if-let [[color x y w h] (read-line-ints)]
        (recur (conj papers (make-paper color x y w h))
               (conj colors color))
        {:papers (into [] papers)
         :colors colors
         :canvas-width canvas-width
         :canvas-height canvas-height}))))

(defn- read-input-file
  [file-name]
  (with-open
   [rdr (io/reader (io/resource file-name))]
    (binding [*in* rdr]
      (parse-inputs))))

(def ^:private input-files
  ["100rects100x100.in"
   "100rects10Kx10K.in"
   "100rects3Kx3K.in"])

(defn- covered?
  [^long canvas-x ^long canvas-y ^Paper p]
  (and (<= (.x1 p) canvas-x)
       (<= canvas-x (.x2 p))
       (<= (.y1 p) canvas-y)
       (<= canvas-y (.y2 p))))

(defn- intersects?
  [{left-1 :x1 top-1 :y1 right-1 :x2 bottom-1 :y2 :as rect1}
   {left-2 :x1 top-2 :y1 right-2 :x2 bottom-2 :y2 :as rect2}]
  (not
   (or (> left-1 right-2) ; 1 to right of 2
       (< right-1 left-2) ; 1 to left of 2
       (> top-1 bottom-2) ; 1 below 2
       (< bottom-1 top-2) ; 1 above 2
       )))

(defn- coarse-index [canvas x y]
  (let [x-step (int (Math/ceil (/ (:w canvas) (float BLOCKS))))
        y-step (int (Math/ceil (/ (:h canvas) (float BLOCKS))))
        x-idx (quot x x-step)
        y-idx (quot y y-step)]
    (+ (* BLOCKS y-idx) x-idx)))

(defn- subdiv-rect [canvas x-idx y-idx]
  (let [x-step (int (Math/ceil (/ (:w canvas) BLOCKS)))
        y-step (int (Math/ceil (/ (:h canvas) BLOCKS)))]
    (make-paper 0 (* x-idx x-step) (* y-idx y-step) x-step y-step)))

(defn- make-paper-index [canvas papers]
  (reduce
   (fn [index [xi yi]]
     (let [rect (subdiv-rect canvas xi yi)]
       (assoc index
              (+ (* BLOCKS yi) xi)
              (into-array (filter #(intersects? rect %) papers)))))
   {}
   (for [xi (range BLOCKS) yi (range BLOCKS)] [xi yi])))

#_(defn- old-visible-color
  [coord papers]
  (some #(when (covered? coord %1) (:color %1))
          papers))

(defn- old-visible-color
  [^long x ^long y ^"[Lrdp.214_intermediate.Paper;" papers]
  (let [len (alength papers)]
    (loop [i 0]
      (if (< i len)
        (let [p ^Paper (aget papers i)]
          (if (covered? x y p)
            (.color p)
            (recur (unchecked-inc i))))
        nil))))

(defn- visible-color
  [coord canvas paper-index]
  (let [i (apply coarse-index canvas coord)
        papers (get paper-index i [])]
    (some #(when (covered? coord %1) (:color %1))
          papers)))

(defn- visible-color-frequencies
  [xlo xhi ylo yhi papers]
  (let [acc (transient {})]
    (doseq [y (range ylo yhi)
            x (range xlo xhi)]
      (when-let [color (old-visible-color x y papers)]
        (assoc! acc color (inc (get acc color 0)))))
    (persistent! acc)))

(defn- visible-color-frequencies-arr
  [xlo xhi ylo yhi colors papers]
  (let [color-counts (long-array (count colors))]
    (doseq [y (range ylo yhi)
            x (range xlo xhi)]
      (when-let [color (old-visible-color x y papers)]
        (aset ^longs color-counts color
              (inc (aget ^longs color-counts color)))))
    (zipmap (range) color-counts)))

(defn- solve
  [input-file]
  (let [input (read-input-file input-file)
        input (assoc input
                     :paper-index
                     (make-paper-index (last (:papers input)) (:papers input)))
        w (:canvas-width input)
        h (:canvas-height input)
        canvas (last (:papers input))
        colors (:colors input)
        xstep (int (Math/ceil (/ w (float BLOCKS))))
        ystep (int (Math/ceil (/ h (float BLOCKS))))
        maps (doall
              (pmap (fn [[xi yi]]
                      (let [xlo (* xstep xi)
                            ylo (* ystep yi)
                            xhi (min w (+ xstep xlo))
                            yhi (min h (+ ystep ylo))
                            idx (coarse-index canvas xlo ylo)
                            papers (get (:paper-index input) idx)]
                        (visible-color-frequencies-arr xlo xhi ylo yhi colors papers)))
                    (for [xi (range BLOCKS) yi (range BLOCKS)] [xi yi])))
        color-map (apply merge-with + maps)
        sorted (sort-by key color-map)]
    (doseq [line sorted]
      (println (key line) (val line)))))

;; (defn -main
;;   ([] (-main 0))
;;   ([index]
;;    (time (solve (input-files (Integer/parseInt index))))))

(defn -main
  ([] (-main "0"))
  ([index]
   (time
    (binding [*unchecked-math* :warn-on-boxed
              *warn-on-reflection* true]
      (solve (input-files (Integer/parseInt index)))))
   (shutdown-agents)))