graph.clj

(ns hypergraph.core
  "A clojure library for dealing with undirected (hyper)graphs."
  (:gen-class)
  (:use (clojure set)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defrecord Graph [vertices edges])

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def simple-graph
  (Graph. #{:a :b :c :d :e} #{#{:a :b} #{:a :c} #{:b :d} #{:c :d} #{:d :e}}))

(def complete-graph
  (Graph.
    #{:a :b :c :d :e}
    #{#{:a :b} #{:a :c} #{:a :d} #{:a :e}
      #{:b :c} #{:b :d} #{:b :e}
      #{:c :d} #{:c :e}
      #{:d :e}}))

(def disconnected-graph
  (Graph. #{:a :b :c :d :e} #{#{:a :b}, #{:c :d}, #{:d :e}}))

(def hyper-graph
  (Graph. #{:a :b :c :d :e :f} #{#{:a :b :c} #{:c :d} #{:e :f}}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defrecord Terrain [type number-token])

(defn hills [number-token] (Terrain. :hills number-token))
(defn pasture [number-token] (Terrain. :pasture number-token))
(defn mountains [number-token] (Terrain. :mountains number-token))
(defn fields [number-token] (Terrain. :fields number-token))
(defn forest [number-token] (Terrain. :forest number-token))
(defn desert [] (Terrain. :desert nil))

(def settlers-of-catan-terrain-map
  (Graph.
    #{(forest 11) (pasture 12) (fields 9) (hills 4) (mountains 6)}
    #{#{(forest 11) (pasture 12) (mountains 6)}
      #{(forest 11) (hills 4) (mountains 6)}
      #{(pasture 12) (fields 9)}}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn find-adjacent-vertices
  "Finds all vertices that adjacent to a given vertex."
  [graph vertex]
  (let [edges-with-vertex (filter #(contains? % vertex) (:edges graph))]
    (disj (reduce union edges-with-vertex) vertex)))

(defn are-adjacent?
  "Tells whether two vertices are adjacent."
  [graph a b]
  (contains? (find-adjacent-vertices graph a) b))

(defn add-vertex
  "Adds a vertex to the graph."
  [graph vertex]
  (Graph. (conj (:vertices graph) vertex)
          (:edges graph)))

(defn add-edge
  "Adds an edge to the graph."
  [graph edge]
  (Graph. (union (:vertices graph) edge)
          (conj (:edges graph) edge)))

(defn remove-vertex
  "Removes a vertex from the graph."
  [graph vertex]
  (Graph. (disj (:vertices graph) vertex)
          (set (remove empty? (map #(disj % vertex) (:edges graph))))))

(defn remove-edge
  "Removes an edge from the graph."
  [graph edge]
  (Graph. (:vertices graph) (disj (:edges graph) edge)))

(defn is-complete?
  "Tells whether a graph is complete."
  [graph]
  (every? #(= (find-adjacent-vertices graph %) (disj (:vertices graph) %))
          (:vertices graph)))

(defn find-connected-component
  "Finds the connected component for a given vertex."
  [graph vertex]
  (let [adjacent-vertices (find-adjacent-vertices graph vertex)]
    (conj (reduce union
      (map #(find-connected-component (remove-vertex graph vertex) %)
           adjacent-vertices))
      vertex)))

(defn find-connected-components
  "Finds all connected components in a graph."
  [graph]
  (keys (group-by #(find-connected-component graph %) (:vertices graph))))

(defn is-connected?
  "Tells whether a graph is connected."
  [graph]
  (= (count (find-connected-components graph)) 1))

(defn has-path?
  "Tells whether there is a path between two vertices."
  [graph a b]
  (contains? (find-connected-component graph a) b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn -main [& args]
  (doseq [result
    { :find-adjacent-vertices (find-adjacent-vertices simple-graph :a)
      :are-adjacent? (are-adjacent? simple-graph :a :e)
      :remove-edge (remove-edge simple-graph #{:a :b})
      :remove-vertex (remove-vertex (remove-vertex simple-graph :d) :e)
      :add-vertex (add-vertex simple-graph :number-token)
      :add-edge (add-edge simple-graph #{:number-token :y})
      :has-path? (has-path? simple-graph :a :e)
      :is-complete? (is-complete? complete-graph)
      :find-connected-components (find-connected-components hyper-graph)
      :is-connected? (is-connected? disconnected-graph)
      :map (find-adjacent-vertices settlers-of-catan-terrain-map (mountains 6))
    }]
    (println "-->" result)))