001  (ns sparse-array.core
002    "Operations on sparse arrays.")
003  
004  (declare put get)
005  
006  (def ^:dynamic *safe-sparse-operations*
007    "Whether spase array operations should be conducted safely, with careful
008    checking of data conventions and exceptions thrown if expectations are not
009    met. Normally `false`."
010    false)
011  
012  (defn- unsafe-sparse-operations?
013    "returns `true` if `*safe-sparse-operations*` is `false`, and vice versa."
014    []
015    (not (true? *safe-sparse-operations*)))
016  
017  (defn make-sparse-array
018    "Make a sparse array with these `dimensions`. Every member of `dimensions`
019    must be a keyword; otherwise, `nil` will be returned."
020    [& dimensions]
021    (when
022      (and (pos? (count dimensions))
023           (every? keyword? dimensions))
024      {:dimensions (count dimensions)
025       :coord (first dimensions)
026       :content (if
027                  (empty? (rest dimensions))
028                  :data
029                  (rest dimensions))}))
030  
031  (defn- safe-test-or-throw
032    "If `v` is truthy or `*safe-sparse-operations*` is false, return `v`;
033    otherwise, throw an `ExceptionInfo` with this `message` and the map `m`."
034    [v message m]
035    (if-not
036      v
037      (if
038        *safe-sparse-operations*
039        (throw (ex-info message m))
040        v)
041      v))
042  
043  (defn sparse-array?
044    "`true` if `x` is a sparse array conforming to the conventions established
045    by this library, else `false`."
046    ;; TODO: sparse-array? should not throw exceptions even when
047    ;; *safe-sparse-operations* is true, since we may use to test
048    ;; whether an object is a sparse array. The place to throw the exceptions
049    ;; (if required) is after it has failed.
050    ([x]
051     (apply
052       sparse-array?
053       (cons
054         x
055         (cons
056           (:coord x)
057           (when
058             (coll? (:content x))
059             (:content x))))))
060    ([x & axes]
061     (and
062       (safe-test-or-throw
063         (map? x)
064         "Array must be a map" {:array x})
065       (safe-test-or-throw
066         (and (integer? (:dimensions x)) (pos? (:dimensions x)))
067         (str "The value of `:dimensions` must be a positive integer, not " (:dimensions x))
068         {:array x})
069       (safe-test-or-throw
070         (keyword? (:coord x))
071         (str "The value of `:coord` must be a keyword, not " (:coord x))
072         {:array x})
073       (safe-test-or-throw
074         (= (:coord x) (first axes))
075         (str "The value of `:coord` must be " (first axes) ", not " (:coord x))
076         {:array x})
077       (if
078         (empty? (rest axes))
079         (safe-test-or-throw
080           (= (:content x) :data)
081           "If there are no further axes the value of `:content` must be `:data`"
082           {:array x})
083         (and
084           (= (:content x) (rest axes))
085           (every?
086             sparse-array?
087             (map #(x %) (filter integer? (keys x)))))))))
088  
089  (defn- unsafe-put
090    [array value coordinates]
091    (cond
092      (every?
093        #(and (integer? %) (or (zero? %) (pos? %)))
094        coordinates)
095      (assoc
096        array
097        (first coordinates)
098        (if
099          (= :data (:content array))
100          value
101          (apply
102            put
103            (cons
104              (or
105                (array (first coordinates))
106                (apply make-sparse-array (:content array)))
107              (cons value (rest coordinates))))))))
108  
109  (defn put
110    "Return a sparse array like this `array` but with this `value` at these
111    `coordinates`. Returns `nil` if any coordinate is invalid."
112    [array value & coordinates]
113    (cond
114      (nil? value)
115      nil
116      (unsafe-sparse-operations?)
117      (unsafe-put array value coordinates)
118      (not (sparse-array? array))
119      (throw (ex-info "Sparse array expected" {:array array}))
120      (not= (:dimensions array) (count coordinates))
121      (throw
122        (ex-info
123          (str "Expected " (:dimensions array) " coordinates; found " (count coordinates))
124          {:array array
125           :coordinates coordinates}))
126      (not
127        (every?
128          #(and (integer? %) (or (zero? %) (pos? %)))
129          coordinates))
130      (throw
131        (ex-info
132          "Coordinates must be zero or positive integers"
133          {:array array
134           :coordinates coordinates
135           :invalid (remove #(and (pos? %) (integer? %)) coordinates)}))
136      :else
137      (unsafe-put array value coordinates)))
138  
139  (defn- unsafe-get
140    ;; TODO: I am CERTAIN there is a more elegant solution to this.
141    [array coordinates]
142    (let [v (array (first coordinates))]
143      (cond
144        (= :data (:content array))
145        v
146        (nil? v)
147        nil
148        :else
149        (apply get (cons v (rest coordinates))))))
150  
151  (defn get
152    "Return the value in this sparse `array` at these `coordinates`."
153    [array & coordinates]
154    (cond
155      (unsafe-sparse-operations?)
156      (unsafe-get array coordinates)
157      (not (sparse-array? array))
158      (throw (ex-info "Sparse array expected" {:array array}))
159      (not (every?
160             #(and (integer? %) (or (zero? %) (pos? %)))
161             coordinates))
162      (throw
163        (ex-info
164          "Coordinates must be zero or positive integers"
165          {:array array
166           :coordinates coordinates
167           :invalid (remove #(and (pos? %) (integer? %)) coordinates)}))
168      (not (= (:dimensions array) (count coordinates)))
169      (throw
170        (ex-info
171          (str "Expected " (:dimensions array) " coordinates; found " (count coordinates))
172          {:array array
173           :coordinates coordinates}))
174      :else
175      (unsafe-get array coordinates)))
176  
177  (defn dense-dimensions
178    "How many usable dimensions (represented as vectors) does the dense array
179    `x` have?"
180    [x]
181    (if
182      (vector? x)
183      (if
184        (every? vector? x)
185        (inc (apply min (map dense-dimensions x)))
186        ;; `min` is right here, not `max`, because otherwise
187        ;; we will get malformed arrays. Be liberal with what you
188        ;; consume, conservative with what you return!
189        1)
190      0))
191  
192  (defn dense-array?
193    "Basically, any vector can be considered as a dense array of one dimension.
194    If we're seeking a dense array of more than one dimension, the number of
195    dimensions should be specified as `d`."
196    ([x]
197     (vector? x))
198    ([x d]
199     (and (vector? x) (< d (dense-dimensions x)))))
200  
201  (defn merge-sparse-arrays
202    "Return a sparse array taking values from sparse arrays `a1` and `a2`,
203    but preferring values from `a2` where there is a conflict. `a1` and `a2`
204    must have the **same** dimensions in the **same** order, or `nil` will
205    be returned."
206    [a1 a2]
207    (cond
208      (nil? a1) a2
209      (nil? a2) a1
210      (not (= (:content a1) (:content a2)))
211      ;; can't reasonably merge arrays with different dimensions
212      nil
213      (= :data (:content a1))
214      (merge a1 a2)
215      (or (unsafe-sparse-operations?) (and (sparse-array? a1) (sparse-array? a2)))
216      (reduce
217        merge
218        a2
219        (map
220          #(assoc a2 % (merge-sparse-arrays (a1 %) (a2 %)))
221          (filter
222            integer?
223            (set
224              (concat
225                (keys a1)
226                (keys a2))))))))
227  
228  (defn merge-dense-with-sparse
229    "Merge this dense array `d` with this sparse array `s`, returning a new
230    dense array with the same arity as `d`, preferring values from `s` where
231    there is conflict"
232    [d s]
233    (apply
234      vector
235      (map
236        #(cond
237           (= :data (:content s))
238           (or (s %2) %1)
239           (nil? (s %2))
240           %1
241           :else
242           (merge-dense-with-sparse %1 (s %2)))
243        d
244        (range))))
245  
246  (defn merge-arrays
247    "Merge two arrays `a1`, `a2`, which may be either dense or sparse but which
248    should have the same number of axes and compatible dimensions, and return a
249    new dense array preferring values from `a2`."
250    [a1 a2]
251    (cond
252      (dense-array? a2)
253      a2 ;; if a2 is dense, no values from a1 will be returned
254      (sparse-array? a1)
255      (cond
256        (sparse-array? a2)
257        (merge-sparse-arrays a1 a2)
258        *safe-sparse-operations*
259        (throw
260          (ex-info
261            "Object passed as array is neither dense not sparse"
262            {:array a2})))
263      (dense-array? a1)
264      (cond
265        (sparse-array? a2)
266        (merge-dense-with-sparse a1 a2)
267        *safe-sparse-operations*
268        (throw
269          (ex-info
270            "Object passed as array is neither dense not sparse"
271            {:array a2})))
272      *safe-sparse-operations*
273      (throw
274        (ex-info
275          "Object passed as array is neither dense not sparse"
276          {:array a1}))))
277  
278  (defn dense-to-sparse
279    "Return a sparse array representing the content of the dense array `x`,
280    assuming these `axes` if specified. *NOTE THAT* if insufficient
281    values of `axes` are specified, the resulting sparse array will
282    be malformed."
283    ([x]
284     (dense-to-sparse x (map #(keyword (str "i" %)) (range))))
285    ([x axes]
286     (let
287       [dimensions (dense-dimensions x)]
288       (reduce
289         merge
290         (apply make-sparse-array (take dimensions axes))
291         (map
292           (fn [i v] (if (nil? v) nil (hash-map i v)))
293           (range)
294           (if
295             (> dimensions 1)
296             (map #(dense-to-sparse % (rest axes)) x)
297             x))))))
298  
299  (defn arity
300    "Return the arity of the sparse array `x`."
301    [x]
302    (inc (apply max (filter integer? (keys x)))))
303  
304  (defn child-arity
305    "Return the largest arity among the arities of the next dimension layer of
306    the sparse array `x`."
307    [x]
308    (apply
309      max
310      (cons
311        -1 ;; if no children are sparse arrays, we should return 0ß
312        (map
313          arity
314          (filter sparse-array? (vals x))))))
315  
316  (defn sparse-to-dense
317    "Return a dense array representing the content of the sparse array `x`.
318  
319    **NOTE THAT** this has the potential to consume very large amounts of memory."
320    ([x]
321     (sparse-to-dense x (arity x)))
322    ([x arity]
323     (if
324       (map? x)
325       (let [a (child-arity x)]
326         (apply
327           vector
328           (map
329             #(let [v (x %)]
330                (if
331                  (= :data (:content x))
332                  v
333                  (sparse-to-dense v a)))
334             (range arity))))
335       (apply vector (repeat arity nil)))))
336  
337