├── .gitignore ├── doc └── intro.md ├── .travis.yml ├── src └── clojure │ └── clojurewerkz │ └── archimedes │ ├── util.clj │ ├── conversion.clj │ ├── element.clj │ ├── query.clj │ ├── io.clj │ ├── graph.clj │ ├── vertex.clj │ └── edge.clj ├── changelog.md ├── project.clj ├── test └── clojurewerkz │ └── archimedes │ ├── element_test.clj │ ├── io_test.clj │ ├── graph_test.clj │ ├── query_test.clj │ ├── vertex_test.clj │ └── edge_test.clj └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml* 6 | *.jar 7 | *.class 8 | .lein-* 9 | .#* 10 | .nrepl-* 11 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to archimedes 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | before_script: lein2 with-profile dev javac 4 | script: lein2 all test 5 | jdk: 6 | - openjdk7 7 | - oraclejdk7 8 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/util.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.util 2 | (:require [clojure.reflect :as r]) 3 | (:use [clojure.pprint :only (pprint)])) 4 | 5 | (defn keywords-to-str-array [strs] 6 | (into-array String (map name strs))) 7 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/conversion.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.conversion 2 | (:import [com.tinkerpop.blueprints Direction Query$Compare])) 3 | 4 | (defprotocol EdgeDirectionConversion 5 | (to-edge-direction [input] "Converts input to a Blueprints edge direction")) 6 | 7 | (extend-protocol EdgeDirectionConversion 8 | clojure.lang.Named 9 | (to-edge-direction [input] 10 | (to-edge-direction (name input))) 11 | 12 | String 13 | (to-edge-direction [input] 14 | (case (.toLowerCase input) 15 | "in" Direction/IN 16 | "out" Direction/OUT 17 | "both" Direction/BOTH)) 18 | 19 | Direction 20 | (to-edge-direction [input] 21 | input)) 22 | 23 | (defn convert-symbol-to-compare [s] 24 | (case s 25 | = Query$Compare/EQUAL 26 | not= Query$Compare/NOT_EQUAL 27 | >= Query$Compare/GREATER_THAN_EQUAL 28 | > Query$Compare/GREATER_THAN 29 | <= Query$Compare/LESS_THAN_EQUAL 30 | < Query$Compare/LESS_THAN)) 31 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/element.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.element 2 | (:refer-clojure :exclude [keys vals assoc! dissoc! get]) 3 | (:import com.tinkerpop.blueprints.Element)) 4 | 5 | (defn get 6 | ([^Element elem key] 7 | (get elem key nil)) 8 | ([^Element elem key not-found] 9 | (let [value (.getProperty elem (name key))] 10 | (if (nil? value) not-found value)))) 11 | 12 | (defn keys 13 | [^Element elem] 14 | (set (map keyword (.getPropertyKeys elem)))) 15 | 16 | (defn vals 17 | [^Element elem] 18 | (set (map #(.getProperty elem %) (.getPropertyKeys elem)))) 19 | 20 | (defn id-of 21 | [^Element elem] 22 | (.getId elem)) 23 | 24 | (defn assoc! 25 | [^Element elem & kvs] 26 | ;;Avoids changing keys that shouldn't be changed. 27 | ;;Important when using types. You aren't ever going to change a 28 | ;;user's id for example. 29 | (doseq [[key value] (partition 2 kvs)] 30 | (.setProperty elem (name key) value)) 31 | elem) 32 | 33 | (defn merge! 34 | [^Element elem & maps] 35 | (doseq [d maps] 36 | (apply assoc! (cons elem (flatten (into [] d))))) 37 | elem) 38 | 39 | (defn dissoc! 40 | [^Element elem & keys] 41 | (doseq [key keys] (.removeProperty elem (name key))) 42 | elem) 43 | 44 | (defn update! 45 | [^Element elem key f & args] 46 | (let [curr-val (get elem key) 47 | new-val (apply f (cons curr-val args))] 48 | (assoc! elem key new-val))) 49 | 50 | (defn clear! 51 | [^Element elem] 52 | (apply dissoc! (cons elem (keys elem)))) 53 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | ## Changes in 2.5.0.0 2 | 3 | ### Titan 0.5.0 4 | 5 | Archimedes now targets Titan 0.5.0. 6 | 7 | 8 | ### Blueprints 2.5.0.0 9 | 10 | Archimedes now uses Blueprints 2.5.0. 11 | 12 | 13 | ## Changes in 1.0.0-alpha5 14 | 15 | * Bug fix for `transact!` and it's feature sniffing. Whenever 16 | `*graph*` gets rebound now, archimedes sniffs graph to see whether 17 | it should use a simple or threaded `transact!`. I suspect that using 18 | `with-graph` could break the feature sniffing (transact! could be 19 | set for one set of features while the provided graph could have a 20 | totally different set of features). Using the apporiate function by 21 | hand is one solution to this. 22 | * `*element-id-key*` and `*edge-label-key*` have been introduced to 23 | allow developers to change how `to-map` represents vertices and 24 | edges. These values can be changed via `set-element-id-key!` and 25 | `set-edge-label-key!`. 26 | 27 | ## Changes in 1.0.0-alpha4 28 | 29 | * Bug fix for using Ogre. 30 | 31 | ## Changes in 1.0.0-alpha3 32 | 33 | * Fixed bugs in `get-vertex`, `set-property`, and `get-all-edges`. 34 | * Renamed `count-edges` to `count` and `delete!` to `remove!`. 35 | * Archimedes is now a Clojurewerkz project. 36 | * Depends on Ogre 2.3.0.1 now. 37 | 38 | ## Changes in 1.0.0-alpha2 39 | 40 | Added in `get-graph` which returns the graph held inside of the 41 | var. Update dependancy on Blueprints to `2.3.0` and Ogre to 42 | `2.3.0.0`. 43 | 44 | ## version < 1.0.0 45 | 46 | Mostly working towards first release. 47 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/query.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.query 2 | (:refer-clojure :exclude [count]) 3 | (:require [clojurewerkz.archimedes.conversion :refer (convert-symbol-to-compare to-edge-direction)]) 4 | (:import [com.tinkerpop.blueprints Vertex Edge Direction Query])) 5 | 6 | ;; 7 | ;; Implementation 8 | ;; 9 | 10 | (defn start-at 11 | [^Vertex starting-point] 12 | (.query starting-point)) 13 | 14 | ;; 15 | ;; API 16 | ;; 17 | 18 | (defmacro has 19 | ([q k] `(.has ~q ~(name k))) 20 | ([q k v] `(.has ~q ~(name k) ~v)) 21 | ([q k c v] `(.has ~q ~(name k) ~v (convert-symbol-to-compare '~c)) )) 22 | 23 | (defn interval 24 | [^Query q key start-val end-val] 25 | (.interval q (name key) start-val end-val)) 26 | 27 | (defn direction 28 | [^Query q dir] 29 | (.direction q (to-edge-direction dir))) 30 | 31 | (defn labels 32 | [^Query q & coll] 33 | (.labels q (into-array String (map name (filter identity coll))))) 34 | 35 | (defn limit 36 | [^Query q ^long max] 37 | (.limit q max)) 38 | 39 | (defmacro find-vertices 40 | [^Vertex starting-point & body] 41 | `(let [^com.tinkerpop.blueprints.Query query# (-> (start-at ~starting-point) ~@body)] 42 | (into [] (.vertices query#)))) 43 | 44 | (defmacro find-edges 45 | [^Vertex starting-point & body] 46 | `(let [^com.tinkerpop.blueprints.Query query# (-> (start-at ~starting-point) ~@body)] 47 | (into [] (.edges query#)))) 48 | 49 | (defmacro count ^long 50 | [^Vertex starting-point & body] 51 | `(let [^com.tinkerpop.blueprints.Query query# (-> (start-at ~starting-point) ~@body)] 52 | (.count query#))) 53 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurewerkz/archimedes "3.0.0.0-SNAPSHOT" 2 | :description "Clojure wrapper for Tinkerpop Blueprints" 3 | :url "https://github.com/clojurewerkz/archimedes" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.6.0"] 7 | [potemkin "0.2.0"] 8 | [com.tinkerpop.blueprints/blueprints-core "2.5.0"]] 9 | :source-paths ["src/clojure"] 10 | :profiles {:dev {:dependencies [[com.thinkaurelius.titan/titan-core "0.5.0"] 11 | [com.thinkaurelius.titan/titan-berkeleyje "0.5.0"] 12 | [org.slf4j/slf4j-nop "1.7.5"] 13 | [clojurewerkz/support "1.0.0" :exclusions [com.google.guava/guava 14 | org.clojure/clojure]] 15 | [commons-io/commons-io "2.4"]]} 16 | :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]} 17 | :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]} 18 | :master {:dependencies [[org.clojure/clojure "1.8.0-master-SNAPSHOT"]]}} 19 | :aliases {"all" ["with-profile" "dev:dev,1.5:dev,1.7:dev,master"]} 20 | :repositories {"sonatype" {:url "http://oss.sonatype.org/content/repositories/releases" 21 | :snapshots false 22 | :releases {:checksum :fail :update :always}} 23 | "sonatype-snapshots" {:url "http://oss.sonatype.org/content/repositories/snapshots" 24 | :snapshots true 25 | :releases {:checksum :fail :update :always}}} 26 | :global-vars {*warn-on-reflection* true}) 27 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/io.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.io 2 | (:require [clojure.java.io :as io] 3 | [clojurewerkz.archimedes.graph :as g]) 4 | (:import [com.tinkerpop.blueprints.util.io.graphml GraphMLWriter GraphMLReader] 5 | [com.tinkerpop.blueprints.util.io.gml GMLWriter GMLReader] 6 | [com.tinkerpop.blueprints.util.io.graphson GraphSONWriter GraphSONReader GraphSONMode])) 7 | 8 | (defn- load-graph-with-reader 9 | [reader g string-or-file] 10 | (let [in-stream (io/input-stream string-or-file)] 11 | (reader g in-stream))) 12 | 13 | (defn- write-graph-with-writer 14 | [writer g string-or-file] 15 | (if (not (g/get-feature g "supportsVertexIteration")) 16 | (throw (Exception. "Cannot write a graph that does not support vertex iteration."))) 17 | (let [out-stream (io/output-stream string-or-file)] 18 | (writer g out-stream))) 19 | 20 | ;; GML 21 | (def load-graph-gml (partial load-graph-with-reader #(GMLReader/inputGraph %1 %2))) 22 | (def write-graph-gml (partial write-graph-with-writer #(GMLWriter/outputGraph %1 %2))) 23 | 24 | ;; GraphML 25 | (def load-graph-graphml (partial load-graph-with-reader #(GraphMLReader/inputGraph %1 %2))) 26 | (def write-graph-graphml (partial write-graph-with-writer #(GraphMLWriter/outputGraph %1 %2))) 27 | 28 | ;; GraphSON 29 | (def load-graph-graphson (partial load-graph-with-reader #(GraphSONReader/inputGraph %1 %2))) 30 | 31 | ;; write-graph-graphson can take an optional 2nd argument: 32 | ;; show-types - determines if types are written explicitly to the JSON 33 | ;; Note that for Titan Graphs with types, you will want show-types=true. 34 | ;; See https://github.com/tinkerpop/blueprints/wiki/GraphSON-Reader-and-Writer-Library 35 | (defn write-graph-graphson 36 | [g string-or-file & [ show-types ]] 37 | (let [graphSON-mode (if show-types GraphSONMode/EXTENDED GraphSONMode/NORMAL)] 38 | (write-graph-with-writer 39 | #(GraphSONWriter/outputGraph %1 %2 graphSON-mode) 40 | g 41 | string-or-file))) 42 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/element_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.element-test 2 | (:use [clojure.test :only [deftest is]]) 3 | (:require [clojurewerkz.archimedes.graph :refer (clean-tinkergraph)] 4 | [clojurewerkz.archimedes.vertex :as v] 5 | [clojurewerkz.archimedes.edge :as e])) 6 | 7 | (deftest test-get-keys 8 | (let [g (clean-tinkergraph) 9 | a (v/create-with-id! g 100 {:name "v1" :a 1 :b 1}) 10 | b (v/create-with-id! g 101 {:name "v2" :a 1 :b 1}) 11 | c (e/connect-with-id! g 102 a :label b {:name "e1" :a 1 :b 1}) 12 | coll-a (v/keys a) 13 | coll-b (v/keys b) 14 | coll-c (v/keys c)] 15 | (is (= #{:name :a :b} coll-a coll-b coll-c)) 16 | (is (= clojure.lang.PersistentHashSet (type coll-a))))) 17 | 18 | (deftest test-get-id 19 | (let [g (clean-tinkergraph) 20 | a (v/create-with-id! g 100) 21 | b (v/create-with-id! g 101) 22 | c (e/connect-with-id! g 102 a :label b )] 23 | (is (= java.lang.String (type (v/id-of a)))) 24 | (is (= java.lang.String (type (e/id-of c)))))) 25 | 26 | (deftest test-remove-property! 27 | (let [g (clean-tinkergraph) 28 | a (v/create-with-id! g 100 {:a 1}) 29 | b (v/create-with-id! g 101) 30 | c (e/connect-with-id! g 102 a :label b {:a 1})] 31 | (v/dissoc! a :a) 32 | (v/dissoc! c :a) 33 | (is (nil? (:a (v/to-map a)))) 34 | (is (nil? (:a (v/to-map c)))))) 35 | 36 | 37 | (deftest test-clear! 38 | (let [g (clean-tinkergraph) 39 | a (v/create-with-id! g 100 {:a 1}) 40 | b (v/create-with-id! g 101) 41 | c (e/connect-with-id! g 102 a :label b {:a 1})] 42 | (v/clear! a) 43 | (e/clear! c) 44 | (is (empty? (v/keys a))) 45 | (is (empty? (e/keys c))))) 46 | 47 | 48 | (deftest test-update! 49 | (let [g (clean-tinkergraph) 50 | a (v/create-with-id! g 100 {:a 1}) 51 | b (v/create-with-id! g 101) 52 | c (e/connect-with-id! g 102 a :label b {:a 1})] 53 | (v/update! a :a + 9) 54 | (v/update! a :b (constantly 10)) 55 | (e/update! c :a + 9) 56 | (e/update! c :b (constantly 10)) 57 | (is (= 10 (v/get a :a))) 58 | (is (= 10 (v/get c :a))) 59 | (is (= 10 (v/get a :b))) 60 | (is (= 10 (v/get c :b))))) 61 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Archimedes, a Clojure Library For Tinkerpop Blueprints 2 | 3 | Archimedes is a Clojure library for working with graphs that conform to the [Tinkerpop Blueprints](http://tinkerpop.com) interface. 4 | 5 | ## Project Goals 6 | 7 | * Provide an API that makes [Tinkerpop Blueprints](http://tinkerpop.com) really easy to use from Clojure 8 | * Be reasonably feature complete 9 | * Don't introduce any significant amount of performance overhead 10 | 11 | 12 | ## Community 13 | 14 | Discussion about Archimedes takes place on the [Titanium mailing list](https://groups.google.com/forum/#!forum/clojure-titanium) 15 | Feel free to join in and ask any questions you may have. 16 | 17 | ## Artifacts 18 | 19 | Archimedes artifacts are 20 | [released to Clojars](https://clojars.org/clojurewerkz/archimedes). If 21 | you are using Maven, add the following repository definition to your 22 | `pom.xml`: 23 | 24 | ``` xml 25 | 26 | clojars.org 27 | http://clojars.org/repo 28 | 29 | ``` 30 | 31 | ### The Most Recent Release 32 | 33 | With Leiningen: 34 | 35 | [clojurewerkz/archimedes "2.5.0.0"] 36 | 37 | 38 | With Maven: 39 | 40 | 41 | clojurewerkz 42 | archimedes 43 | 2.5.0.0 44 | 45 | 46 | ## Documentation & Examples 47 | 48 | Archimedes documentation guides are not ready yet. 49 | 50 | ### Code Examples 51 | 52 | Our [test suite](test/archimedes) has many code examples. 53 | 54 | ## Supported Clojure Versions 55 | 56 | Archimedes is built from the ground up for Clojure 1.4 and up. The most recent stable release 57 | is always recommended. 58 | 59 | 60 | ## Continuous Integration 61 | 62 | [![Build Status](https://travis-ci.org/clojurewerkz/archimedes.svg?branch=master)](https://travis-ci.org/clojurewerkz/archimedes) 63 | 64 | ## Development 65 | 66 | Archimedes uses 67 | [Leiningen 2](https://github.com/technomancy/leiningen/blob/master/doc/TUTORIAL.md). 68 | Make sure you have it installed and then run tests against supported 69 | Clojure versions using 70 | 71 | lein all test 72 | 73 | Then create a branch and make your changes on it. Once you are done 74 | with your changes and all tests pass, submit a pull request on Github. 75 | 76 | 77 | 78 | ## License 79 | 80 | Copyright (C) 2013-2016 Zack Maril and the ClojureWerkz Team 81 | 82 | Licensed under the [Eclipse Public License](http://www.eclipse.org/legal/epl-v10.html) (the same as Clojure). 83 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/io_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.io-test 2 | (:use [clojure.test :only (deftest testing is)]) 3 | (:require [clojurewerkz.archimedes.graph :as g] 4 | [clojurewerkz.archimedes.io :as io] 5 | [clojurewerkz.archimedes.vertex :as v] 6 | [clojurewerkz.archimedes.edge :as e] 7 | [clojure.java.io :as clj-io]) 8 | (:import [java.io File])) 9 | 10 | (defn- has-n-vertices [graph n] 11 | (is (= n (count (seq (.getVertices graph)))))) 12 | 13 | (defn- has-n-edges [graph n] 14 | (is (= n (count (seq (.getEdges graph)))))) 15 | 16 | (defn- make-test-graph 17 | [] 18 | (let [graph (g/clean-tinkergraph) 19 | vertex-1 (v/create-with-id! graph 100) 20 | vertex-2 (v/create-with-id! graph 101) 21 | edge (e/connect-with-id! graph 102 vertex-1 :edge vertex-2)] 22 | graph)) 23 | 24 | (defn- make-test-graph-with-types 25 | [] 26 | (let [graph (g/clean-tinkergraph) 27 | vertex-1 (v/create-with-id! graph 100 {:my-int (int 1) 28 | :my-long (long 2) 29 | :my-float (float 3) 30 | :my-double (double 4) 31 | :my-boolean true}) 32 | vertex-2 (v/create-with-id! graph 101 {:my-int (int 10) 33 | :my-long (long 20) 34 | :my-float (float 30) 35 | :my-double (double 40) 36 | :my-boolean false}) 37 | edge (e/connect-with-id! graph 102 vertex-1 :edge vertex-2)] 38 | graph)) 39 | 40 | (deftest test-loading-and-saving-graphs-graphml 41 | (let [graph (make-test-graph) 42 | tmp (File/createTempFile "my-test-graph" ".graphml")] 43 | (io/write-graph-graphml graph tmp) 44 | ;; Open new graph and read it 45 | (let [graph2 (g/clean-tinkergraph)] 46 | (io/load-graph-graphml graph2 tmp) 47 | (has-n-vertices graph2 2) 48 | (has-n-edges graph2 1)))) 49 | 50 | (deftest test-loading-and-saving-graphs-gml 51 | (let [graph (make-test-graph) 52 | tmp (File/createTempFile "my-test-graph" ".gml")] 53 | (io/write-graph-gml graph tmp) 54 | ;; Open new graph and read it 55 | (let [graph2 (g/clean-tinkergraph)] 56 | (io/load-graph-gml graph2 tmp) 57 | (has-n-vertices graph2 2) 58 | (has-n-edges graph2 1)))) 59 | 60 | (deftest test-loading-and-saving-graphs-graphson 61 | (testing "Without type information" 62 | (let [graph (make-test-graph) 63 | tmp (File/createTempFile "my-test-graph" ".graphson")] 64 | (io/write-graph-graphson graph tmp) 65 | ;; Open new graph and read it 66 | (let [graph2 (g/clean-tinkergraph)] 67 | (io/load-graph-graphson graph2 tmp) 68 | (has-n-vertices graph2 2) 69 | (has-n-edges graph2 1)))) 70 | 71 | (testing "With a graph with type information" 72 | (let [graph (make-test-graph-with-types) 73 | tmp-typed (File/createTempFile "my-test-graph-typed" ".graphson") 74 | tmp-untyped (File/createTempFile "my-test-graph-untyped" ".graphson")] 75 | (io/write-graph-graphson graph tmp-typed true) 76 | (io/write-graph-graphson graph tmp-untyped false) 77 | (testing "Loading a graphson with type infomation" 78 | (let [graph2 (g/clean-tinkergraph)] 79 | (io/load-graph-graphson graph2 tmp-typed) 80 | (has-n-vertices graph2 2) 81 | (has-n-edges graph2 1))) 82 | (testing "Loading a graphson without type infomation" 83 | (let [graph2 (g/clean-tinkergraph)] 84 | (io/load-graph-graphson graph2 tmp-untyped) 85 | (has-n-vertices graph2 2) 86 | (has-n-edges graph2 1)))))) 87 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/graph_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.graph-test 2 | (:use [clojure.test :only (use-fixtures deftest testing is)]) 3 | (:require [clojurewerkz.archimedes.graph :as g] 4 | [clojurewerkz.archimedes.vertex :as v] 5 | [clojurewerkz.support.io :as sio]) 6 | (:import [com.tinkerpop.blueprints.impls.tg TinkerGraphFactory TinkerGraph] 7 | [com.thinkaurelius.titan.core TitanFactory TitanGraph] 8 | [org.apache.commons.io FileUtils])) 9 | 10 | (def ^:dynamic *graph*) 11 | 12 | (defn temp-db-fixture 13 | [f] 14 | (let [tmp (sio/create-temp-dir)] 15 | (try 16 | (binding [*graph* (TitanFactory/open (str "berkeleyje:" (.getPath tmp)))] 17 | (try 18 | (f) 19 | (finally 20 | (.shutdown *graph*)))) 21 | (finally 22 | (FileUtils/deleteQuietly tmp))))) 23 | 24 | (use-fixtures :each temp-db-fixture) 25 | 26 | (deftest test-opening-a-graph-in-memory 27 | (testing "Graph in memory" 28 | (is (= (type (g/clean-tinkergraph)) 29 | TinkerGraph)))) 30 | 31 | (deftest test-tinkergraph-does-not-support-transactions 32 | (testing "We cannot perform a transaction on a Tinkergraph" 33 | (is (thrown? java.lang.AssertionError 34 | (g/with-transaction [g (g/clean-tinkergraph)] nil))))) 35 | 36 | (deftest test-transaction-rollback-on-exception 37 | (testing "Uncaught exception reverts added vertex" 38 | (try 39 | (g/with-transaction [tx *graph*] 40 | (v/create! tx {:name "Mallory"}) 41 | (is (= (count (v/get-all-vertices tx)) 1)) 42 | (throw (Exception. "Died"))) 43 | (catch Exception e 44 | (is (= (.getMessage e) "Died")))) 45 | (is (empty? (v/get-all-vertices *graph*))))) 46 | 47 | (deftest test-transaction-explicit-rollback 48 | (testing "Setting :rollback? option reverts added vertex" 49 | (g/with-transaction [tx *graph* :rollback? true] 50 | (v/create! tx {:name "Mallory"}) 51 | (is (= (count (v/get-all-vertices tx)) 1))) 52 | (is (empty? (v/get-all-vertices *graph*))))) 53 | 54 | (deftest test-threaded-transaction-rollback-on-exception 55 | (testing "Uncaught exception reverts added vertex" 56 | (try 57 | (g/with-transaction [tx *graph* :threaded? true] 58 | (v/create! tx {:name "Mallory"}) 59 | (is (= (count (v/get-all-vertices tx)) 1)) 60 | (throw (Exception. "Died"))) 61 | (catch Exception e 62 | (is (= (.getMessage e) "Died")))) 63 | (is (empty? (v/get-all-vertices *graph*))))) 64 | 65 | (deftest test-threaded-transaction-explicit-rollback 66 | (testing "Setting :rollback? option reverts added vertex (threaded=true)" 67 | (g/with-transaction [tx *graph* :threaded? true :rollback? true] 68 | (v/create! tx {:name "Mallory"}) 69 | (is (= (count (v/get-all-vertices tx)) 1))) 70 | (is (empty? (v/get-all-vertices *graph*))))) 71 | 72 | (def num-attempts (atom 0)) 73 | 74 | (deftest test-transaction-retry 75 | (testing "Retry transaction" 76 | (reset! num-attempts 0) 77 | (is (thrown-with-msg? java.lang.Exception #"Died" 78 | (g/with-transaction-retry [tx *graph* :max-attempts 3 :wait-time 100] 79 | (v/create! tx {:name "Mallory"}) 80 | (swap! num-attempts inc) 81 | (throw (Exception. "Died"))))) 82 | (is (= @num-attempts 3)))) 83 | 84 | (deftest test-transaction-commit 85 | (testing "Commit edit to graph" 86 | (g/with-transaction [tx *graph*] 87 | (v/create! tx [:name "Bob"])) 88 | (is (= (count (v/get-all-vertices *graph*)) 1)))) 89 | 90 | (deftest test-threaded-transaction-commit 91 | (testing "Commit edit to graph (threaded=true)" 92 | (g/with-transaction [tx *graph* :threaded? true] 93 | (v/create! tx [:name "Bob"])) 94 | (is (= (count (v/get-all-vertices *graph*)) 1)))) 95 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/graph.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.graph 2 | (:import (com.tinkerpop.blueprints Element Graph TransactionalGraph 3 | ThreadedTransactionalGraph 4 | TransactionalGraph$Conclusion) 5 | (com.tinkerpop.blueprints.impls.tg TinkerGraphFactory))) 6 | 7 | (def ^{:dynamic true} *element-id-key* :__id__) 8 | 9 | (def ^{:dynamic true} *edge-label-key* :__label__) 10 | 11 | 12 | (defn set-element-id-key! 13 | [new-id] 14 | (alter-var-root (var *element-id-key*) (constantly new-id))) 15 | 16 | (defn set-edge-label-key! 17 | [new-id] 18 | (alter-var-root (var *edge-label-key*) (constantly new-id))) 19 | 20 | (defn new-tinkergraph 21 | [] 22 | (TinkerGraphFactory/createTinkerGraph)) 23 | 24 | (defn clean-tinkergraph 25 | [] 26 | (let [g (new-tinkergraph)] 27 | (doseq [e (seq (.getEdges g))] (.removeEdge g e)) 28 | (doseq [v (seq (.getVertices g))] (.removeVertex g v)) 29 | g)) 30 | 31 | (defn get-features 32 | "Get a map of features for a graph. 33 | (http://tinkerpop.com/docs/javadocs/blueprints/2.1.0/com/tinkerpop/blueprints/Features.html)" 34 | [g] 35 | (.. g getFeatures toMap)) 36 | 37 | (defn get-feature 38 | "Gets the value of the feature for a graph." 39 | [g s] 40 | (get ^java.util.Map (get-features g) s)) 41 | 42 | ;;TODO Transactions need to be much more fine grain in terms of 43 | ;;control. And expections as well. new-transaction will only work on a 44 | ;;ThreadedTransactionalGraph. 45 | (defn new-transaction 46 | "Creates a new transaction based on the given graph object." 47 | [g] 48 | (.newTransaction g)) 49 | 50 | (defn commit 51 | "Commit all changes to the graph." 52 | [g] 53 | (.commit g)) 54 | 55 | (defn shutdown 56 | "Shutdown the graph." 57 | [g] 58 | (.shutdown g)) 59 | 60 | (defn rollback 61 | "Stops the current transaction and rolls back any changes made." 62 | [g] 63 | (.rollback g)) 64 | 65 | (defn with-transaction* 66 | [graph f & {:keys [threaded? rollback?]}] 67 | {:pre [(get-feature graph "supportsTransactions")]} 68 | (let [tx (if threaded? (new-transaction graph) graph)] 69 | (try 70 | (let [result (f tx)] 71 | (if rollback? 72 | (rollback tx) 73 | (commit tx)) 74 | result) 75 | (catch Throwable t 76 | (try (rollback tx) (catch Exception _)) 77 | (throw t))))) 78 | 79 | ;; This approach is copied from clojure.java.jdbc. The ^:once metadata and use of fn* 80 | ;; is explained by Christophe Grand in this blog post: 81 | ;; http://clj-me.cgrand.net/2013/09/11/macros-closures-and-unexpected-object-retention/ 82 | (defmacro with-transaction 83 | "Evaluates body in the context of a transaction on the specified graph, which must 84 | support transactions. The binding provides the graph for the transaction and the 85 | name to which the transactional graph is bound for evaluation of the body. 86 | 87 | (with-transaction [tx graph] 88 | (vertex/create! tx) 89 | ...) 90 | 91 | If the graph supports threaded transactions, the binding may also specify that the 92 | body be executed in a threaded transaction. 93 | 94 | (with-transaction [tx graph :threaded? true] 95 | (vertex/create! tx) 96 | ...) 97 | 98 | Note that `commit` and `rollback` should not be called explicitly inside 99 | `with-transaction`. If you want to force a rollback, you must throw an 100 | exception or specify rollback in the `with-transaction` call: 101 | 102 | (with-transaction [tx graph :rollback? true] 103 | (vertex/create! tx) 104 | ...)" 105 | [binding & body] 106 | `(with-transaction* 107 | ~(second binding) 108 | (^{:once true} fn* [~(first binding)] ~@body) 109 | ~@(rest (rest binding)))) 110 | 111 | ;; When we move to Blueprints 2.5, this can be reimplemented using TransactionRetryHelper 112 | 113 | (defn with-transaction-retry* 114 | [graph f & {:keys [max-attempts wait-time threaded? rollback?]}] 115 | {:pre [(integer? max-attempts) (or (integer? wait-time) (ifn? wait-time))]} 116 | (let [wait-fn (if (integer? wait-time) (constantly wait-time) wait-time) 117 | retry (fn [attempt] 118 | (let [res (try 119 | (with-transaction* graph f :threaded? threaded? :rollback? rollback?) 120 | (catch Throwable t 121 | (if (< attempt max-attempts) 122 | ::retry 123 | (throw t))))] 124 | (if (= res ::retry) 125 | (let [ms (wait-fn attempt)] 126 | (Thread/sleep ms) 127 | (recur (inc attempt))) 128 | res)))] 129 | (retry 1))) 130 | 131 | (defmacro with-transaction-retry 132 | [binding & body] 133 | `(with-transaction-retry* 134 | ~(second binding) 135 | (^{:once true} fn* [~(first binding)] ~@body) 136 | ~@(rest (rest binding)))) 137 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/query_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.query-test 2 | (:require [clojurewerkz.archimedes.graph :as g] 3 | [clojurewerkz.archimedes.vertex :as v] 4 | [clojurewerkz.archimedes.edge :as e] 5 | [clojurewerkz.archimedes.query :as q]) 6 | (:use [clojure.test :only (deftest is)])) 7 | 8 | 9 | (deftest test-basic-vertices-query 10 | (let [graph (g/clean-tinkergraph) 11 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 12 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 13 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 14 | _ (e/connect-with-id! graph 103 a :friend b) 15 | _ (e/connect-with-id! graph 104 a :friend c) 16 | vs (q/find-vertices a 17 | (q/direction :out) 18 | (q/labels :friend))] 19 | (is (= 2 (count vs))) 20 | (is (= #{b c} (set vs))))) 21 | 22 | (deftest test-edge-count 23 | (let [graph (g/clean-tinkergraph) 24 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 25 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 26 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 27 | _ (e/connect-with-id! graph 103 a :friend b) 28 | _ (e/connect-with-id! graph 104 a :friend c) 29 | _ (e/connect-with-id! graph 105 a :remembers c) 30 | _ (e/connect-with-id! graph 106 c :remembers a) 31 | n (q/count a 32 | (q/direction :out) 33 | (q/labels :friend :remembers))] 34 | (is (= 3 n)))) 35 | 36 | (deftest test-edge-count-with-default-comparator 37 | (let [graph (g/clean-tinkergraph) 38 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 39 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 40 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 41 | _ (e/connect-with-id! graph 103 a :friend b {:age 28}) 42 | _ (e/connect-with-id! graph 104 a :friend c {:age 30}) 43 | n1 (q/count a 44 | (q/direction :out) 45 | (q/labels :friend) 46 | (q/has :age 28)) 47 | n2 (q/count a 48 | (q/direction :out) 49 | (q/labels :friend) 50 | (q/has :age 29)) 51 | n3 (q/count a 52 | (q/direction :out) 53 | (q/labels :hates) 54 | (q/has :age 28))] 55 | (is (= n1 1)) 56 | (is (= n2 0)) 57 | (is (= n3 0)))) 58 | 59 | (deftest test-edge-count-with-gte-comparator 60 | (let [graph (g/clean-tinkergraph) 61 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 62 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 63 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 64 | _ (e/connect-with-id! graph 103 a :friend b {:age 28}) 65 | _ (e/connect-with-id! graph 104 a :friend c {:age 30}) 66 | n1 (q/count a 67 | (q/direction :out) 68 | (q/labels :friend) 69 | (q/has :age >= 28)) 70 | n2 (q/count a 71 | (q/direction :out) 72 | (q/labels :friend) 73 | (q/has :age >= 29)) 74 | n3 (q/count a 75 | (q/direction :out) 76 | (q/labels :hates) 77 | (q/has :age >= 28))] 78 | (is (= n1 2)) 79 | (is (= n2 1)) 80 | (is (= n3 0)))) 81 | 82 | (deftest test-edge-count-with-lte-comparator 83 | (let [graph (g/clean-tinkergraph) 84 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 85 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 86 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 87 | _ (e/connect-with-id! graph 103 a :friend b {:age 28}) 88 | _ (e/connect-with-id! graph 104 a :friend c {:age 30}) 89 | n1 (q/count a 90 | (q/direction :out) 91 | (q/labels :friend) 92 | (q/has :age <= 28)) 93 | n2 (q/count a 94 | (q/direction :out) 95 | (q/labels :friend) 96 | (q/has :age <= 29)) 97 | n3 (q/count a 98 | (q/direction :out) 99 | (q/labels :hates) 100 | (q/has :age <= 28))] 101 | (is (= n1 1)) 102 | (is (= n2 1)) 103 | (is (= n3 0)))) 104 | 105 | (deftest test-has-propetry-key 106 | (let [graph (g/clean-tinkergraph) 107 | a (v/create-with-id! graph 100 {:name "Steven" :age 30}) 108 | b (v/create-with-id! graph 101 {:name "Alonso" :age 32}) 109 | c (v/create-with-id! graph 102 {:name "Thomas" :age 38}) 110 | d (v/create-with-id! graph 103 {:name "Claire" :age 26}) 111 | _ (e/connect-with-id! graph 104 a :friend b {:age 28}) 112 | _ (e/connect-with-id! graph 105 a :friend c {:age 30}) 113 | _ (e/connect-with-id! graph 106 a :friend d) 114 | n1 (q/count a 115 | (q/direction :out) 116 | (q/labels :friend)) 117 | n2 (q/count a 118 | (q/direction :out) 119 | (q/labels :friend) 120 | (q/has :age))] 121 | (is (= n1 3)) 122 | (is (= n2 2))) 123 | ) 124 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/vertex.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.vertex 2 | (:refer-clojure :exclude [keys vals assoc! dissoc! get]) 3 | (:import (com.tinkerpop.blueprints Vertex Direction Graph) 4 | (com.tinkerpop.blueprints.impls.tg TinkerGraph)) 5 | (:require [clojurewerkz.archimedes.graph :refer (*element-id-key*)] 6 | [clojurewerkz.archimedes.util :refer (keywords-to-str-array)] 7 | [clojurewerkz.archimedes.conversion :refer (to-edge-direction)] 8 | [clojurewerkz.archimedes.element :as ele] 9 | [potemkin :as po])) 10 | 11 | (po/import-fn ele/get) 12 | (po/import-fn ele/keys) 13 | (po/import-fn ele/vals) 14 | (po/import-fn ele/id-of) 15 | (po/import-fn ele/assoc!) 16 | (po/import-fn ele/merge!) 17 | (po/import-fn ele/dissoc!) 18 | (po/import-fn ele/update!) 19 | (po/import-fn ele/clear!) 20 | 21 | 22 | ;; 23 | ;; Transaction management 24 | ;; 25 | 26 | (defn refresh 27 | "Gets a vertex back from the database and refreshes it to be usable again." 28 | [g vertex] 29 | (.getVertex g vertex)) 30 | 31 | ;; 32 | ;; Removal methods 33 | ;; 34 | 35 | (defn remove! 36 | "Remove a vertex from the given graph." 37 | [g vertex] 38 | (.removeVertex ^Graph g vertex)) 39 | 40 | 41 | ;; 42 | ;;Information getters 43 | ;; 44 | (defn to-map 45 | "Returns a persistent map representing the vertex." 46 | [vertex] 47 | (->> (keys vertex) 48 | (map #(vector (keyword %) (get vertex %))) 49 | (into { *element-id-key* (id-of vertex)}))) 50 | 51 | ;;Finders 52 | (defn find-by-id 53 | "Retrieves nodes by id from the given graph." 54 | [g & ids] 55 | (if (= 1 (count ids)) 56 | (.getVertex g (first ids)) 57 | (seq (for [id ids] (.getVertex g id))))) 58 | 59 | (defn find-by-kv 60 | "Given a key and a value, returns the set of all vertices that 61 | sastify the pair." 62 | [g k v] 63 | (set (.getVertices g (name k) v))) 64 | 65 | (defn get-all-vertices 66 | "Returns all vertices." 67 | [g] 68 | (set (.getVertices g))) 69 | 70 | (defn edges-of 71 | "Returns edges that this vertex is part of with direction and with given labels" 72 | [^Vertex v direction & labels] 73 | (.getEdges v (to-edge-direction direction) (keywords-to-str-array labels))) 74 | 75 | (defn all-edges-of 76 | "Returns edges that this vertex is part of, with given labels" 77 | [^Vertex v & labels] 78 | (.getEdges v Direction/BOTH (keywords-to-str-array labels))) 79 | 80 | (defn outgoing-edges-of 81 | "Returns outgoing (outbound) edges that this vertex is part of, with given labels" 82 | [^Vertex v & labels] 83 | (.getEdges v Direction/OUT (keywords-to-str-array labels))) 84 | 85 | (defn incoming-edges-of 86 | "Returns incoming (inbound) edges that this vertex is part of, with given labels" 87 | [^Vertex v & labels] 88 | (.getEdges v Direction/IN (keywords-to-str-array labels))) 89 | 90 | (defn connected-vertices-of 91 | "Returns vertices connected to this vertex with a certain direction by the given labels" 92 | [^Vertex v direction & labels] 93 | (.getVertices v (to-edge-direction direction) (keywords-to-str-array labels))) 94 | 95 | (defn connected-out-vertices 96 | "Returns vertices connected to this vertex by an outbound edge with the given labels" 97 | [^Vertex v & labels] 98 | (.getVertices v Direction/OUT (keywords-to-str-array labels))) 99 | 100 | (defn connected-in-vertices 101 | "Returns vertices connected to this vertex by an inbound edge with the given labels" 102 | [^Vertex v & labels] 103 | (.getVertices v Direction/IN (keywords-to-str-array labels))) 104 | 105 | (defn all-connected-vertices 106 | "Returns vertices connected to this vertex with the given labels" 107 | [^Vertex v & labels] 108 | (.getVertices v Direction/BOTH (keywords-to-str-array labels))) 109 | 110 | ;; 111 | ;; Creation methods 112 | ;; 113 | 114 | (defn create! 115 | "Create a vertex, optionally with the given property map." 116 | ([g] 117 | (create! g {})) 118 | ([g m] 119 | (let [^Vertex new-vertex (.addVertex g nil)] 120 | (merge! new-vertex m)))) 121 | 122 | (defn create-with-id! 123 | "Create a vertex, optionally with the given property map." 124 | ([g id] 125 | (create-with-id! g id {})) 126 | ([g id m] 127 | (let [^Vertex new-vertex (.addVertex ^Graph g id)] 128 | (merge! new-vertex m)))) 129 | 130 | (defn upsert! 131 | "Given a key and a property map, upsert! either creates a new node 132 | with that property map or updates all nodes with the given key 133 | value pair to have the new properties specifiied by the map. Always 134 | returns the set of vertices that were just update or created." 135 | [g k m] 136 | (let [vertices (find-by-kv g (name k) (k m))] 137 | (if (empty? vertices) 138 | (set [(create! g m)]) 139 | (do 140 | (doseq [vertex vertices] (merge! vertex m)) 141 | vertices)))) 142 | 143 | (defn unique-upsert! 144 | "Like upsert!, but throws an error when more than one element is returned." 145 | [& args] 146 | (let [upserted (apply upsert! args)] 147 | (if (= 1 (count upserted)) 148 | (first upserted) 149 | (throw (Throwable. 150 | (str 151 | "Don't call unique-upsert! when there is more than one element returned.\n" 152 | "There were " (count upserted) " vertices returned.\n" 153 | "The arguments were: " args "\n")))))) 154 | 155 | (defn upsert-with-id! 156 | "Given a key and a property map, upsert! either creates a new node 157 | with that property map or updates all nodes with the given key 158 | value pair to have the new properties specifiied by the map. Always 159 | returns the set of vertices that were just update or created." 160 | [g id k m] 161 | (let [vertices (find-by-kv g (name k) (k m))] 162 | (if (empty? vertices) 163 | (set [(create-with-id! g id m)]) 164 | (do 165 | (doseq [vertex vertices] (merge! vertex m)) 166 | vertices)))) 167 | 168 | (defn unique-upsert-with-id! 169 | "Like upsert!, but throws an error when more than one element is returned." 170 | [& args] 171 | (let [upserted (apply upsert-with-id! args)] 172 | (if (= 1 (count upserted)) 173 | (first upserted) 174 | (throw (Throwable. 175 | (str 176 | "Don't call unique-upsert! when there is more than one element returned.\n" 177 | "There were " (count upserted) " vertices returned.\n" 178 | "The arguments were: " args "\n")))))) 179 | -------------------------------------------------------------------------------- /src/clojure/clojurewerkz/archimedes/edge.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.edge 2 | (:refer-clojure :exclude [keys vals assoc! dissoc! get]) 3 | (:import (com.tinkerpop.blueprints Vertex Edge Direction Graph) 4 | (com.tinkerpop.blueprints.impls.tg TinkerGraph)) 5 | (:require [clojurewerkz.archimedes.vertex :as v] 6 | [clojurewerkz.archimedes.graph :refer (*element-id-key* *edge-label-key*)] 7 | [clojurewerkz.archimedes.conversion :refer (to-edge-direction)] 8 | [clojurewerkz.archimedes.query :as q] 9 | [clojurewerkz.archimedes.element :as ele] 10 | [potemkin :as po])) 11 | 12 | (po/import-fn ele/get) 13 | (po/import-fn ele/keys) 14 | (po/import-fn ele/vals) 15 | (po/import-fn ele/id-of) 16 | (po/import-fn ele/assoc!) 17 | (po/import-fn ele/merge!) 18 | (po/import-fn ele/dissoc!) 19 | (po/import-fn ele/update!) 20 | (po/import-fn ele/clear!) 21 | 22 | ;; 23 | ;;Transaction management 24 | ;; 25 | 26 | (defn refresh 27 | "Goes and grabs the edge from the graph again. Useful for \"refreshing\" stale edges." 28 | [g ^Edge edge] 29 | (.getEdge g (.getId edge))) 30 | 31 | ;; 32 | ;; Removal methods 33 | ;; 34 | 35 | (defn remove! 36 | "Remove an edge." 37 | [g ^Edge edge] 38 | (.removeEdge g edge)) 39 | 40 | ;; 41 | ;; Information getters 42 | ;; 43 | 44 | (defn label-of 45 | "Get the label of the edge" 46 | [^Edge edge] 47 | (keyword (.getLabel edge))) 48 | 49 | (defn to-map 50 | "Returns a persisten map representing the edge." 51 | [^Edge edge] 52 | (->> (keys edge) 53 | (map #(vector (keyword %) (get edge %))) 54 | (into {*element-id-key* (id-of edge) *edge-label-key* (label-of edge)}))) 55 | 56 | (defn find-by-id 57 | "Retrieves edges by id from the graph." 58 | [g & ids] 59 | (if (= 1 (count ids)) 60 | (.getEdge g (first ids)) 61 | (seq (for [id ids] (.getEdge g id))))) 62 | 63 | (defn get-all-edges 64 | "Returns all edges." 65 | [g] 66 | (set (.getEdges g))) 67 | 68 | (defn ^Vertex get-vertex 69 | "Get the vertex of the edge in a certain direction." 70 | [^Edge e direction] 71 | (.getVertex e (to-edge-direction direction))) 72 | 73 | (defn ^Vertex head-vertex 74 | "Get the head vertex of the edge." 75 | [^Edge e] 76 | (.getVertex e Direction/IN)) 77 | 78 | (defn ^Vertex tail-vertex 79 | "Get the tail vertex of the edge." 80 | [^Edge e] 81 | (.getVertex e Direction/OUT)) 82 | 83 | (defn endpoints 84 | "Returns the endpoints of the edge in array with the order [starting-node,ending-node]." 85 | [^Edge edge] 86 | [(.getVertex edge Direction/OUT) 87 | (.getVertex edge Direction/IN)]) 88 | 89 | (defn edges-between 90 | "Returns a set of the edges between two vertices, direction considered." 91 | ([^Vertex v1 ^Vertex v2] 92 | (edges-between v1 nil v2)) 93 | ([^Vertex v1 label ^Vertex v2] 94 | ;; Source for these edge queries: 95 | ;; https://groups.google.com/forum/?fromgroups=#!topic/gremlin-users/R2RJxJc1BHI 96 | (let [^Edge edges (q/find-edges v1 97 | (q/direction :out) 98 | (q/labels label)) 99 | v2-id (.getId v2) 100 | edge-set (set (filter #(= v2-id (.getId (.getVertex % (to-edge-direction :in)))) edges))] 101 | (when (not (empty? edge-set)) 102 | edge-set)))) 103 | 104 | (defn connected? 105 | "Returns whether or not two vertices are connected. Optional third 106 | arguement specifying the label of the edge." 107 | ([^Vertex v1 ^Vertex v2] 108 | (connected? v1 nil v2)) 109 | ([^Vertex v1 label ^Vertex v2] 110 | (not (empty? (edges-between v1 label v2))))) 111 | 112 | ;; 113 | ;; Creation methods 114 | ;; 115 | 116 | (defn connect! 117 | "Connects two vertices with the given label, and, optionally, with the given properties." 118 | ([g ^Vertex v1 label ^Vertex v2] 119 | (connect! g v1 label v2 {})) 120 | ([g ^Vertex v1 label ^Vertex v2 data] 121 | (let [new-edge (.addEdge g nil v1 v2 ^String (name label))] 122 | (merge! new-edge data)))) 123 | 124 | (defn connect-with-id! 125 | "Connects two vertices with the given label, and, optionally, with the given properties." 126 | ([g id ^Vertex v1 label ^Vertex v2] 127 | (connect-with-id! g id v1 label v2 {})) 128 | ([g id ^Vertex v1 label ^Vertex v2 data] 129 | (let [new-edge (.addEdge g id v1 v2 ^String (name label))] 130 | (merge! new-edge data)))) 131 | 132 | (defn upconnect! 133 | "Upconnect takes all the edges between the given vertices with the 134 | given label and, if the data is provided, merges the data with the 135 | current properties of the edge. If no such edge exists, then an 136 | edge is created with the given data." 137 | ([g ^Vertex v1 label ^Vertex v2] 138 | (upconnect! g v1 label v2 {})) 139 | ([g ^Vertex v1 label ^Vertex v2 data] 140 | (if-let [^Edge edges (edges-between v1 label v2)] 141 | (do 142 | (doseq [^Edge edge edges] (merge! edge data)) 143 | edges) 144 | #{(connect! g v1 label v2 data)}))) 145 | 146 | (defn unique-upconnect! 147 | "Like upconnect!, but throws an error when more than element is returned." 148 | [& args] 149 | (let [upconnected (apply upconnect! args)] 150 | (if (= 1 (count upconnected)) 151 | (first upconnected) 152 | (throw (Throwable. 153 | (str 154 | "Don't call unique-upconnect! when there is more than one element returned.\n" 155 | "There were " (count upconnected) " edges returned.\n" 156 | "The arguments were: " args "\n")))))) 157 | 158 | (defn upconnect-with-id! 159 | "Upconnect takes all the edges between the given vertices with the 160 | given label and, if the data is provided, merges the data with the 161 | current properties of the edge. If no such edge exists, then an 162 | edge is created with the given data." 163 | ([g id ^Vertex v1 label ^Vertex v2] 164 | (upconnect-with-id! g id v1 label v2 {})) 165 | ([g id ^Vertex v1 label ^Vertex v2 data] 166 | (if-let [^Edge edges (edges-between v1 label v2)] 167 | (do 168 | (doseq [^Edge edge edges] (merge! edge data)) 169 | edges) 170 | #{(connect-with-id! g id v1 label v2 data)}))) 171 | 172 | (defn unique-upconnect-with-id! 173 | "Like upconnect!, but throws an error when more than element is returned." 174 | [& args] 175 | (let [upconnected (apply upconnect-with-id! args)] 176 | (if (= 1 (count upconnected)) 177 | (first upconnected) 178 | (throw (Throwable. 179 | (str 180 | "Don't call unique-upconnect! when there is more than one element returned.\n" 181 | "There were " (count upconnected) " edges returned.\n" 182 | "The arguments were: " args "\n")))))) 183 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/vertex_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.vertex-test 2 | (:use [clojure.test :only (deftest testing is)]) 3 | (:require [clojurewerkz.archimedes.graph :as g] 4 | [clojurewerkz.archimedes.vertex :as v] 5 | [clojurewerkz.archimedes.edge :as e])) 6 | 7 | (deftest test-create 8 | (let [graph (g/clean-tinkergraph) 9 | u (v/create! graph)] 10 | (is (= 1 (count (v/get-all-vertices graph)))))) 11 | 12 | (deftest test-delete 13 | (let [graph (g/clean-tinkergraph) 14 | u (v/create-with-id! graph 100 {:name "v1"})] 15 | (v/remove! graph u) 16 | (is (= nil (v/find-by-id graph 100))) 17 | (is (empty? (v/find-by-kv graph :name "v1"))))) 18 | 19 | (deftest test-simple-property-mutation 20 | (let [graph (g/clean-tinkergraph) 21 | u (v/create-with-id! graph 100 {:name "v1" :a 1 :b 1})] 22 | (v/assoc! u :b 2) 23 | (v/dissoc! u :a) 24 | (is (= 2 (v/get u :b))) 25 | (is (= nil (v/get u :a))) 26 | (is (= 10 (v/get u :a 10))) )) 27 | 28 | (deftest test-multiple-property-mutation 29 | (let [graph (g/clean-tinkergraph) 30 | u (v/create-with-id! graph 100 {:name "v1" :a 0 :b 2})] 31 | (v/merge! u {:a 1 :b 2 :c 3}) 32 | (is (= 1 (v/get u :a))) 33 | (is (= 2 (v/get u :b))) 34 | (is (= 3 (v/get u :c))))) 35 | 36 | (deftest test-to-map 37 | (let [graph (g/clean-tinkergraph) 38 | v1 (v/create-with-id! graph 100 {:name "v1" :a 1 :b 2 :c 3}) 39 | props (v/to-map v1)] 40 | (is (= 1 (props :a))) 41 | (is (= 2 (props :b))) 42 | (is (= 3 (props :c))))) 43 | 44 | (deftest test-to-map-id 45 | (let [id :ID] 46 | (try 47 | (g/set-element-id-key! id) 48 | (let [graph (g/clean-tinkergraph) 49 | v1 (v/create-with-id! graph 100 {:name "v1" :a 1 :b 2 :c 3}) 50 | props (v/to-map v1)] 51 | (is (= "100" (props id))) 52 | (is (= 1 (props :a))) 53 | (is (= 2 (props :b))) 54 | (is (= 3 (props :c)))) 55 | (finally 56 | (g/set-element-id-key! :__id__))))) 57 | 58 | (deftest test-find-by-id-single 59 | (let [graph (g/clean-tinkergraph) 60 | v1 (v/create-with-id! graph 100 {:prop 1}) 61 | v1-maybe (v/find-by-id graph 100)] 62 | (is (= 1 (v/get v1-maybe :prop))))) 63 | 64 | (deftest test-find-by-id-multiple 65 | (let [graph (g/clean-tinkergraph) 66 | v1 (v/create-with-id! graph 100 {:prop 1}) 67 | v2 (v/create-with-id! graph 101 {:prop 2}) 68 | v3 (v/create-with-id! graph 102 {:prop 3}) 69 | ids (map v/id-of [v1 v2 v3]) 70 | v-maybes (apply v/find-by-id graph ids)] 71 | (is (= (range 1 4) (map #(v/get % :prop) v-maybes))))) 72 | 73 | (deftest test-find-by-kv 74 | (let [graph (g/clean-tinkergraph) 75 | v1 (v/create-with-id! graph 100 {:age 1 :name "A"}) 76 | v2 (v/create-with-id! graph 101 {:age 2 :name "B"}) 77 | v3 (v/create-with-id! graph 102 {:age 2 :name "C"})] 78 | (is (= #{"A"} 79 | (set (map #(v/get % :name) (v/find-by-kv graph :age 1))))) 80 | (is (= #{"B" "C"} 81 | (set (map #(v/get % :name) (v/find-by-kv graph :age 2))))))) 82 | 83 | (deftest test-get-all-vertices 84 | (let [graph (g/clean-tinkergraph) 85 | v1 (v/create-with-id! graph 100 {:age 1 :name "A"}) 86 | v2 (v/create-with-id! graph 101 {:age 2 :name "B"}) 87 | v3 (v/create-with-id! graph 102 {:age 2 :name "C"})] 88 | (is (= #{v1 v2 v3} (v/get-all-vertices graph))))) 89 | 90 | (deftest test-adjacent-object-retriveal 91 | (let [graph (g/clean-tinkergraph) 92 | v1 (v/create-with-id! graph 100 {:age 1 :name "A"}) 93 | v2 (v/create-with-id! graph 101 {:age 2 :name "B"}) 94 | v3 (v/create-with-id! graph 102 {:age 2 :name "C"}) 95 | e1 (e/connect-with-id! graph 103 v1 :a v2) 96 | e2 (e/connect-with-id! graph 104 v2 :b v1) 97 | e3 (e/connect-with-id! graph 105 v1 :c v3)] 98 | (is (= (set (v/edges-of v1 :in)) #{e2})) 99 | (is (= (set (v/incoming-edges-of v1)) #{e2})) 100 | (is (= (set (v/connected-vertices-of v1 :in)) #{v2})) 101 | (is (= (set (v/connected-in-vertices v1)) #{v2})) 102 | 103 | (is (= (set (v/edges-of v1 :out)) #{e1 e3})) 104 | (is (= (set (v/outgoing-edges-of v1)) #{e1 e3})) 105 | (is (= (set (v/connected-vertices-of v1 :out)) #{v2 v3})) 106 | (is (= (set (v/connected-out-vertices v1)) #{v2 v3})) 107 | 108 | (is (= (set (v/edges-of v1 :both)) #{e1 e2 e3})) 109 | (is (= (set (v/all-edges-of v1)) #{e1 e2 e3})) 110 | (is (= (set (v/connected-vertices-of v1 :both)) #{v2 v3})) 111 | (is (= (set (v/all-connected-vertices v1)) #{v2 v3})) 112 | 113 | (is (= (set (v/edges-of v1 :both :a)) #{e1})) 114 | (is (= (set (v/all-edges-of v1 :a)) #{e1})) 115 | (is (= (set (v/connected-vertices-of v1 :both :a)) #{v2})) 116 | (is (= (set (v/all-connected-vertices v1 :a)) #{v2})) 117 | 118 | (is (= (set (v/edges-of v1 :both :a :b)) #{e1 e2})) 119 | (is (= (set (v/all-edges-of v1 :a :b)) #{e1 e2})) 120 | (is (= (set (v/connected-vertices-of v1 :both :a :b)) #{v2})) 121 | (is (= (set (v/all-connected-vertices v1 :a :b)) #{v2})) 122 | 123 | (is (= (set (v/edges-of v1 :both :a :b :d)) #{e1 e2})) 124 | (is (= (set (v/all-edges-of v1 :a :b :d)) #{e1 e2})) 125 | (is (= (set (v/connected-vertices-of v1 :both :a :b :d )) #{v2})) 126 | (is (= (set (v/all-connected-vertices v1 :a :b :d)) #{v2})))) 127 | 128 | (deftest test-upsert! 129 | (testing "upsert! with id" 130 | (let [graph (g/clean-tinkergraph) 131 | v1-a (v/upsert-with-id! graph 100 :first-name 132 | {:first-name "Zack" :last-name "Maril" :age 21}) 133 | v1-b (v/upsert-with-id! graph 101 :first-name 134 | {:first-name "Zack" :last-name "Maril" :age 22}) 135 | v2 (v/upsert-with-id! graph 102 :first-name 136 | {:first-name "Brooke" :last-name "Maril" :age 19})] 137 | (is (= 22 138 | (v/get (first v1-a) :age) 139 | (v/get (first v1-b) :age))) 140 | (v/upsert-with-id! graph 103 :last-name {:last-name "Maril" 141 | :heritage "Some German Folks"}) 142 | (is (= "Some German Folks" 143 | (v/get (first v1-a) :heritage) 144 | (v/get (first v1-b) :heritage) 145 | (v/get (first v2) :heritage))))) 146 | 147 | (testing "upsert! without id" 148 | (let [graph (g/clean-tinkergraph) 149 | v1-a (v/upsert! graph :first-name 150 | {:first-name "Zack" :last-name "Maril" :age 21}) 151 | v1-b (v/upsert! graph :first-name 152 | {:first-name "Zack" :last-name "Maril" :age 22}) 153 | v2 (v/upsert! graph :first-name 154 | {:first-name "Brooke" :last-name "Maril" :age 19})] 155 | (is (= 22 156 | (v/get (first v1-a) :age) 157 | (v/get (first v1-b) :age))) 158 | (v/upsert! graph :last-name {:last-name "Maril" 159 | :heritage "Some German Folks"}) 160 | (is (= "Some German Folks" 161 | (v/get (first v1-a) :heritage) 162 | (v/get (first v1-b) :heritage) 163 | (v/get (first v2) :heritage)))))) 164 | 165 | (deftest test-get-false-val 166 | (let [graph (g/clean-tinkergraph) 167 | v (v/create-with-id! graph 100 {:foo false})] 168 | (is (= (v/get v :foo) false)) 169 | (is (= (v/get v :foo 1) false)) 170 | (is (nil? (v/get v :bar))) 171 | (is (= (v/get v :bar 1) 1)))) 172 | -------------------------------------------------------------------------------- /test/clojurewerkz/archimedes/edge_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojurewerkz.archimedes.edge-test 2 | (:use [clojure.test :only [deftest testing is]]) 3 | (:require [clojurewerkz.archimedes.graph :as gr] 4 | [clojurewerkz.archimedes.edge :as e] 5 | [clojurewerkz.archimedes.vertex :as v])) 6 | 7 | (deftest test-delete 8 | (let [g (gr/clean-tinkergraph) 9 | u (v/create-with-id! g 100) 10 | w (v/create-with-id! g 101) 11 | a (e/connect-with-id! g 102 u :test w) 12 | a-id (e/id-of a)] 13 | (e/remove! g a) 14 | (is (= nil (e/find-by-id a-id))))) 15 | 16 | (deftest test-connect 17 | (let [g (gr/clean-tinkergraph) 18 | u (v/create! g) 19 | v (v/create! g) 20 | e (e/connect! g u :test v)] 21 | (is (e/connected? u v)) 22 | (is (e/connected? u :test v)))) 23 | 24 | (deftest test-simple-property-mutation 25 | (let [g (gr/clean-tinkergraph) 26 | v1 (v/create-with-id! g 100 {:name "v1"}) 27 | v2 (v/create-with-id! g 101 {:name "v2"}) 28 | edge (e/connect-with-id! g 102 v1 :test v2 {:a 1})] 29 | (e/assoc! edge :b 2) 30 | (e/dissoc! edge :a) 31 | (is (= 2 (e/get edge :b))) 32 | (is (= nil (e/get edge :a))))) 33 | 34 | (deftest test-multiple-property-mutation 35 | (let [g (gr/clean-tinkergraph) 36 | v1 (v/create-with-id! g 100 {:name "v1"}) 37 | v2 (v/create-with-id! g 101 {:name "v2"}) 38 | edge (e/connect-with-id! g 102 v1 :test v2 {:a 0})] 39 | (e/merge! edge {:a 1 :b 2 :c 3}) 40 | (is (= 1 (e/get edge :a))) 41 | (is (= 2 (e/get edge :b))) 42 | (is (= 3 (e/get edge :c))))) 43 | 44 | (deftest test-get-all-edges 45 | (let [g (gr/clean-tinkergraph) 46 | v1 (v/create-with-id! g 100 {:name "v1"}) 47 | v2 (v/create-with-id! g 101 {:name "v2"}) 48 | edge (e/connect-with-id! g 102 v1 :test v2 {:a 0}) 49 | edge (e/connect-with-id! g 103 v1 :test v2 {:a 1}) 50 | edge (e/connect-with-id! g 104 v1 :test v2 {:a 2})] 51 | (is (= 3 (count (e/get-all-edges g)))))) 52 | 53 | (deftest test-to-map 54 | (let [g (gr/clean-tinkergraph) 55 | v1 (v/create-with-id! g 100 {:name "v1"}) 56 | v2 (v/create-with-id! g 101 {:name "v2"}) 57 | edge (e/connect-with-id! g 102 v1 :test v2 {:a 1 :b 2 :c 3}) 58 | prop-map (e/to-map edge)] 59 | (is (= {:a 1 :b 2 :c 3} (dissoc prop-map :__id__ :__label__))))) 60 | 61 | (deftest test-to-map-id 62 | (let [id :ID label :LABEL] 63 | (try 64 | (gr/set-element-id-key! id) 65 | (gr/set-edge-label-key! label) 66 | (let [g (gr/clean-tinkergraph) 67 | v1 (v/create-with-id! g 100 {:name "v1"}) 68 | v2 (v/create-with-id! g 101 {:name "v2"}) 69 | edge (e/connect-with-id! g 102 v1 :test v2 {:a 1 :b 2 :c 3}) 70 | prop-map (e/to-map edge)] 71 | (is (= {:a 1 :b 2 :c 3 id "102" label :test} prop-map))) 72 | (finally 73 | (gr/set-element-id-key! :__id__) 74 | (gr/set-edge-label-key! :__label__))))) 75 | 76 | (deftest test-endpoints 77 | (let [g (gr/clean-tinkergraph) 78 | v1 (v/create-with-id! g 100 {:name "v1"}) 79 | v2 (v/create-with-id! g 101 {:name "v2"}) 80 | edge (e/connect-with-id! g 102 v1 :connexion v2)] 81 | (is (= ["v1" "v2"] (map #(e/get % :name) (e/endpoints edge)))))) 82 | 83 | (deftest test-get-vertex 84 | (let [g (gr/clean-tinkergraph) 85 | v1 (v/create-with-id! g 100 {:name "v1"}) 86 | v2 (v/create-with-id! g 101 {:name "v2"}) 87 | edge (e/connect-with-id! g 102 v1 :connexion v2)] 88 | (is (= v1 (e/get-vertex edge :out))) 89 | (is (= v2 (e/get-vertex edge :in))))) 90 | 91 | (deftest test-tail-vertex 92 | (let [g (gr/clean-tinkergraph) 93 | v1 (v/create-with-id! g 100 {:name "v1"}) 94 | v2 (v/create-with-id! g 101 {:name "v2"}) 95 | edge (e/connect-with-id! g 102 v1 :connexion v2)] 96 | (is (= v1 (e/tail-vertex edge))))) 97 | 98 | (deftest test-edges-between 99 | (let [g (gr/clean-tinkergraph) 100 | v1 (v/create-with-id! g 100 {:name "v1"}) 101 | v2 (v/create-with-id! g 101 {:name "v2"}) 102 | v3 (v/create-with-id! g 102 {:name "v3"}) 103 | e1 (e/connect-with-id! g 103 v1 :connexion v2) 104 | e2 (e/connect-with-id! g 104 v1 :testing v2) 105 | e3 (e/connect-with-id! g 105 v2 :connexion v1) 106 | e4 (e/connect-with-id! g 106 v2 :testing v1) 107 | e5 (e/connect-with-id! g 107 v1 :testing v3) 108 | e5 (e/connect-with-id! g 108 v2 :testing v3)] 109 | (is (= #{e1 e2} (e/edges-between v1 v2))) 110 | (is (= #{e1} (e/edges-between v1 :connexion v2))) 111 | (is (= nil (e/edges-between v1 :wrong v2))) 112 | (is (= nil (e/edges-between v3 :wrong v1))))) 113 | 114 | (deftest test-head-vertex 115 | (let [g (gr/clean-tinkergraph) 116 | v1 (v/create-with-id! g 100 {:name "v1"}) 117 | v2 (v/create-with-id! g 101 {:name "v2"}) 118 | edge (e/connect-with-id! g 102 v1 :connexion v2)] 119 | (is (= v2 (e/head-vertex edge))))) 120 | 121 | (deftest test-refresh 122 | (let [g (gr/clean-tinkergraph) 123 | v1 (v/create-with-id! g 100 {:name "v1"}) 124 | v2 (v/create-with-id! g 101 {:name "v2"}) 125 | edge (e/connect-with-id! g 102 v1 :connexion v2 ) 126 | fresh-edge (e/refresh g edge)] 127 | (is fresh-edge) 128 | (is (= (.getId edge) (.getId fresh-edge))) 129 | (is (= (e/to-map edge) (e/to-map fresh-edge))))) 130 | 131 | (deftest test-upconnect! 132 | (testing "Upconnecting once without data" 133 | (let [g (gr/clean-tinkergraph) 134 | v1 (v/create-with-id! g 100 {:name "v1"}) 135 | v2 (v/create-with-id! g 101 {:name "v2"}) 136 | edge (e/unique-upconnect-with-id! g 102 v1 :connexion v2)] 137 | (is (e/connected? v1 v2)) 138 | (is (e/connected? v1 :connexion v2)) 139 | (is (not (e/connected? v2 v1))) 140 | (is (= 1 (count (seq (.getEdges g))))))) 141 | (testing "Upconnecting once" 142 | (let [g (gr/clean-tinkergraph) 143 | v1 (v/create-with-id! g 100 {:name "v1"}) 144 | v2 (v/create-with-id! g 101 {:name "v2"}) 145 | edge (e/unique-upconnect-with-id! g 102 v1 :connexion v2 146 | {:name "the edge"})] 147 | (is (e/connected? v1 v2)) 148 | (is (e/connected? v1 :connexion v2)) 149 | (is (not (e/connected? v2 v1))) 150 | (is (= "the edge" (e/get edge :name))) 151 | (is (= 1 (count (seq (.getEdges g))))))) 152 | 153 | (testing "Upconnecting multiple times" 154 | (let [g (gr/clean-tinkergraph) 155 | v1 (v/create-with-id! g 100 {:name "v1"}) 156 | v2 (v/create-with-id! g 101 {:name "v2"}) 157 | edge (e/unique-upconnect-with-id! g 102 v1 :connexion v2 {:name "the edge"}) 158 | edge (e/unique-upconnect-with-id! g 103 v1 :connexion v2 {:a 1 :b 2}) 159 | edge (e/unique-upconnect-with-id! g 104 v1 :connexion v2 {:b 0})] 160 | (is (e/connected? v1 v2)) 161 | (is (e/connected? v1 :connexion v2)) 162 | (is (not (e/connected? v2 v1))) 163 | (is (= "the edge" (e/get edge :name))) 164 | (is (= 1 (e/get edge :a))) 165 | (is (= 0 (e/get edge :b))) 166 | (is (= 1 (count (seq (.getEdges g)))))))) 167 | 168 | (deftest test-get-false-val 169 | (let [graph (gr/clean-tinkergraph) 170 | v1 (v/create-with-id! graph 100) 171 | v2 (v/create-with-id! graph 101) 172 | e (e/connect-with-id! graph 102 v1 :connexion v2 {:foo false})] 173 | (is (= (e/get e :foo) false)) 174 | (is (= (e/get e :foo 1) false)) 175 | (is (nil? (e/get e :bar))) 176 | (is (= (e/get e :bar 1) 1)))) 177 | --------------------------------------------------------------------------------