Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Migrated generic.collection

  • Loading branch information...
commit ff0ff6f911e3624a2296376c829900c779513047 1 parent 42a5100
@khinsen khinsen authored
View
114 src/main/clojure/clojure/algo/generic/collection.clj
@@ -0,0 +1,114 @@
+;; Generic interfaces for collection-related functions
+
+;; by Konrad Hinsen
+
+;; Copyright (c) Konrad Hinsen, 2009-2011. All rights reserved. The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution. By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license. You must not
+;; remove this notice, or any other, from this software.
+
+(ns
+ ^{:author "Konrad Hinsen"
+ :doc "Generic collection interface
+ This library defines generic versions of common
+ collection-related functions as multimethods that can be
+ defined for any type."}
+ clojure.algo.generic.collection
+ (:refer-clojure :exclude [assoc conj dissoc empty get into seq]))
+
+;
+; assoc
+;
+(defmulti assoc
+ "Returns a new collection in which the values corresponding to the
+ given keys are updated by the given values. Each type of collection
+ can have specific restrictions on the possible keys."
+ {:arglists '([coll & key-val-pairs])}
+ (fn [coll & items] (type coll)))
+
+(defmethod assoc :default
+ [map & key-val-pairs]
+ (apply clojure.core/assoc map key-val-pairs))
+
+;
+; conj
+;
+(defmulti conj
+ "Returns a new collection resulting from adding all xs to coll."
+ {:arglists '([coll & xs])}
+ (fn [coll & xs] (type coll)))
+
+(defmethod conj :default
+ [coll & xs]
+ (apply clojure.core/conj coll xs))
+
+;
+; dissoc
+;
+(defmulti dissoc
+ "Returns a new collection in which the entries corresponding to the
+ given keys are removed. Each type of collection can have specific
+ restrictions on the possible keys."
+ {:arglists '([coll & keys])}
+ (fn [coll & keys] (type coll)))
+
+(defmethod dissoc :default
+ [map & keys]
+ (apply clojure.core/dissoc map keys))
+
+;
+; empty
+;
+(defmulti empty
+ "Returns an empty collection of the same kind as the argument"
+ {:arglists '([coll])}
+ type)
+
+(defmethod empty :default
+ [coll]
+ (clojure.core/empty coll))
+
+;
+; get
+;
+(defmulti get
+ "Returns the element of coll referred to by key. Each type of collection
+ can have specific restrictions on the possible keys."
+ {:arglists '([coll key] [coll key not-found])}
+ (fn [coll & args] (type coll)))
+
+(defmethod get :default
+ ([coll key]
+ (clojure.core/get coll key))
+ ([coll key not-found]
+ (clojure.core/get coll key not-found)))
+
+;
+; into
+;
+(defmulti into
+ "Returns a new coll consisting of to-coll with all of the items of
+ from-coll conjoined. A default implementation based on reduce, conj, and
+ seq is provided."
+ {:arglists '([to from])}
+ (fn [to from] (type to)))
+
+(declare seq)
+(defmethod into :default
+ [to from]
+ (reduce conj to (seq from)))
+
+;
+; seq
+;
+(defmulti seq
+ "Returns a seq on the object s."
+ {:arglists '([s])}
+ type)
+
+(defmethod seq :default
+ [s]
+ (clojure.core/seq s))
View
106 src/test/clojure/clojure/algo/generic/test_collection.clj
@@ -0,0 +1,106 @@
+;; Test routines for clojure.algo.generic.collection
+
+;; Copyright (c) Konrad Hinsen, 2011. All rights reserved. The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution. By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license. You must not
+;; remove this notice, or any other, from this software.
+
+(ns clojure.algo.generic.test-collection
+ (:use [clojure.test :only (deftest is are run-tests)]
+ [clojure.algo.generic :only (root-type)])
+ (:require [clojure.algo.generic.collection :as gc]))
+
+; Define a multiset class. The representation is a map from values to counts.
+(defrecord multiset [map])
+(derive multiset root-type)
+
+(defn mset
+ [& elements]
+ (gc/into (new multiset {}) elements))
+
+; Implement the collection multimethods.
+(defmethod gc/conj multiset
+ ([ms x]
+ (let [msmap (:map ms)]
+ (new multiset (assoc msmap x (inc (get msmap x 0))))))
+ ([ms x & xs]
+ (reduce gc/conj (gc/conj ms x) xs)))
+
+(defmethod gc/empty multiset
+ [ms]
+ (new multiset {}))
+
+(defmethod gc/seq multiset
+ [ms]
+ (apply concat (map (fn [[x n]] (repeat n x)) (:map ms))))
+
+; Define a sparse vector class. The representation is a map from
+; integer indices to values.
+(defrecord sparse-vector [map])
+(derive sparse-vector root-type)
+
+(defn s-vector
+ [& values]
+ (apply gc/conj (new sparse-vector {}) values))
+
+; Implement the collection multimethods
+(defmethod gc/assoc sparse-vector
+ [sv key value]
+ (assert (integer? key))
+ (assert (not (neg? key)))
+ (new sparse-vector
+ (if (nil? value)
+ (:map sv)
+ (assoc (:map sv) key value))))
+
+(defmethod gc/get sparse-vector
+ ([sv key]
+ (gc/get sv key nil))
+ ([sv key default]
+ (get (:map sv) key default)))
+
+(defmethod gc/conj sparse-vector
+ [sv & xs]
+ (loop [svmap (:map sv)
+ index (inc (apply max (conj (keys svmap) -1)))
+ xs xs]
+ (if (empty? xs)
+ (new sparse-vector svmap)
+ (recur (if (nil? (first xs))
+ svmap
+ (assoc svmap index (first xs)))
+ (inc index) (rest xs)))))
+
+(defmethod gc/empty sparse-vector
+ [sv]
+ (new sparse-vector {}))
+
+(defmethod gc/seq sparse-vector
+ [sv]
+ (let [svmap (:map sv)
+ max-index (apply max (conj (keys svmap) -1))]
+ (if (neg? max-index)
+ nil
+ (for [i (range (inc max-index))] (get svmap i nil)))))
+
+; Multiset tests
+(deftest multiset-tests
+ (are [a b] (= a b)
+ (mset :a :a :b) (mset :a :b :a)
+ (gc/conj (mset) :a) (mset :a)
+ (gc/conj (mset) :b :a :b :a) (mset :a :a :b :b)
+ (gc/empty (mset :a)) (mset)
+ (gc/seq (mset :a :a :a)) '(:a :a :a)))
+
+; Sparse vector tests
+(deftest sparse-vector-tests
+ (are [a b] (= a b)
+ (gc/empty (s-vector)) (s-vector)
+ (gc/conj (s-vector 1 2) 3) (s-vector 1 2 3)
+ (gc/assoc (s-vector 1 2) 2 3) (s-vector 1 2 3)
+ (gc/assoc (s-vector 1 2) 4 3) (s-vector 1 2 nil nil 3)
+ (gc/get (s-vector 1 2 3) 1) 2
+ (gc/seq (gc/assoc (s-vector 1) 3 3) '(1 nil nil 3))))
Please sign in to comment.
Something went wrong with that request. Please try again.