001  (ns sparse-array.core)
002  
003  (declare put get)
004  
005  (def ^:dynamic *safe-sparse-operations*
006    "Whether spase array operations should be conducted safely, with careful
007    checking of data conventions and exceptions thrown if expectations are not
008    met. Normally `false`."
009    false)
010  
011  (defn- unsafe-sparse-operations?
012    "returns `true` if `*safe-sparse-operations*` is `false`, and vice versa."
013    []
014    (not (true? *safe-sparse-operations*)))
015  
016  (defn make-sparse-array
017    "Make a sparse array with these `dimensions`. Every member of `dimensions`
018    must be a keyword; otherwise, `nil` will be returned."
019    [& dimensions]
020    (when
021      (and (pos? (count dimensions))
022           (every? keyword? dimensions))
023      {:dimensions (count dimensions)
024       :coord (first dimensions)
025       :content (if
026                  (empty? (rest dimensions))
027                  :data
028                  (rest dimensions))}))
029  
030  (defn- safe-test-or-throw
031    "If `v` is truthy or `*safe-sparse-operations*` is false, return `v`;
032    otherwise, throw an `ExceptionInfo` with this `message` and the map `m`."
033    [v message m]
034    (if-not
035      v
036      (if
037        *safe-sparse-operations*
038        (throw (ex-info message m))
039        v)
040      v))
041  
042  (defn sparse-array?
043    "`true` if `x` is a sparse array conforming to the conventions established
044    by this library, else `false`."
045    ;; TODO: sparse-array? should not throw exceptions even when
046    ;; *safe-sparse-operations* is true, since we may use to test
047    ;; whether an object is a sparse array. The place to throw the exceptions
048    ;; (if required) is after it has failed.
049    ([x]
050     (apply
051       sparse-array?
052       (cons
053         x
054         (cons
055           (:coord x)
056           (when
057             (coll? (:content x))
058             (:content x))))))
059    ([x & axes]
060     (and
061       (safe-test-or-throw
062         (map? x)
063         "Array must be a map" {:array x})
064       (safe-test-or-throw
065         (and (integer? (:dimensions x)) (pos? (:dimensions x)))
066         (str "The value of `:dimensions` must be a positive integer, not " (:dimensions x))
067         {:array x})
068       (safe-test-or-throw
069         (keyword? (:coord x))
070         (str "The value of `:coord` must be a keyword, not " (:coord x))
071         {:array x})
072       (safe-test-or-throw
073         (= (:coord x) (first axes))
074         (str "The value of `:coord` must be " (first axes) ", not " (:coord x))
075         {:array x})
076       (if
077         (empty? (rest axes))
078         (safe-test-or-throw
079           (= (:content x) :data)
080           "If there are no further axes the value of `:content` must be `:data`"
081           {:array x})
082         (and
083           (= (:content x) (rest axes))
084           (every?
085             sparse-array?
086             (map #(x %) (filter integer? (keys x)))))))))
087  
088  (defn- unsafe-put
089    [array value coordinates]
090    (cond
091      (every?
092        #(and (integer? %) (or (zero? %) (pos? %)))
093        coordinates)
094      (assoc
095        array
096        (first coordinates)
097        (if
098          (= :data (:content array))
099          value
100          (apply
101            put
102            (cons
103              (or
104                (array (first coordinates))
105                (apply make-sparse-array (:content array)))
106              (cons value (rest coordinates))))))))
107  
108  (defn put
109    "Return a sparse array like this `array` but with this `value` at these
110    `coordinates`. Returns `nil` if any coordinate is invalid."
111    [array value & coordinates]
112    (cond
113      (nil? value)
114      nil
115      (unsafe-sparse-operations?)
116      (unsafe-put array value coordinates)
117      (not (sparse-array? array))
118      (throw (ex-info "Sparse array expected" {:array array}))
119      (not= (:dimensions array) (count coordinates))
120      (throw
121        (ex-info
122          (str "Expected " (:dimensions array) " coordinates; found " (count coordinates))
123          {:array array
124           :coordinates coordinates}))
125      (not
126        (every?
127          #(and (integer? %) (or (zero? %) (pos? %)))
128          coordinates))
129      (throw
130        (ex-info
131          "Coordinates must be zero or positive integers"
132          {:array array
133           :coordinates coordinates
134           :invalid (remove #(and (pos? %) (integer? %)) coordinates)}))
135      :else
136      (unsafe-put array value coordinates)))
137  
138  (defn- unsafe-get
139    ;; TODO: I am CERTAIN there is a more elegant solution to this.
140    [array coordinates]
141    (let [v (array (first coordinates))]
142      (cond
143        (= :data (:content array))
144        v
145        (nil? v)
146        nil
147        :else
148        (apply get (cons v (rest coordinates))))))
149  
150  (defn get
151    "Return the value in this sparse `array` at these `coordinates`."
152    [array & coordinates]
153    (cond
154      (unsafe-sparse-operations?)
155      (unsafe-get array coordinates)
156      (not (sparse-array? array))
157      (throw (ex-info "Sparse array expected" {:array array}))
158      (not (every?
159             #(and (integer? %) (or (zero? %) (pos? %)))
160             coordinates))
161      (throw
162        (ex-info
163          "Coordinates must be zero or positive integers"
164          {:array array
165           :coordinates coordinates
166           :invalid (remove #(and (pos? %) (integer? %)) coordinates)}))
167      (not (= (:dimensions array) (count coordinates)))
168      (throw
169        (ex-info
170          (str "Expected " (:dimensions array) " coordinates; found " (count coordinates))
171          {:array array
172           :coordinates coordinates}))
173      :else
174      (unsafe-get array coordinates)))
175  
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