<commit_before>;; Copyright (c) <NAME>. 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 LICENSE 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 conexp.contrib.draw.nodes-and-connections
  "Namespace for representing nodes and their connections for drawing lattice diagrams."
  (:use [conexp.base :only (round, union, difference, -?>, def-)]
        conexp.contrib.draw.scenes)
  (:import [java.awt Color]
           [no.geosoft.cc.graphics GWindow GScene GObject GSegment
                                   GStyle GInteraction ZoomInteraction
                                   GText GPosition]))

;;; nodes and connections

(defn node?
  "Tests whether thing is a node of a lattice diagram or not."
  [thing]
  (and (instance? GObject thing)
       (= (:type @(.getUserData ^GObject thing)) :node)))

(defn connection?
  "Tests whether thing is a connection of a lattice diagram or not."
  [thing]
  (and (instance? GObject thing)
       (= (:type @(.getUserData ^GObject thing)) :connection)))

(defn position
  "Returns the position of a node in a lattice diagram."
  [^GObject node]
  (:position @(.getUserData node)))

(defn radius
  "Returns the radius of a node in a lattice diagram."
  [^GObject node]
  (:radius @(.getUserData node)))

(defn set-node-radius!
  "Sets radius of node."
  [^GObject node, radius]
  (dosync
   (alter (.getUserData node) assoc :radius radius)))

(defn get-name
  "Returns name of thing."
  [^GObject thing]
  (:name @(.getUserData thing)))

(defn lower-node
  "Returns for a connection conn the lower node in a lattice diagram."
  [^GObject conn]
  (:lower @(.getUserData conn)))

(defn upper-node
  "Returns for a connection conn the upper node in a lattice diagram."
  [^GObject conn]
  (:upper @(.getUserData conn)))

(defn upper-connections
  "Returns all upper connections for node in a lattice diagram."
  [^GObject node]
  (:upper @(.getUserData node)))

(defn lower-connections
  "Returns all lower connections of node in a lattice diagram."
  [^GObject node]
  (:lower @(.getUserData node)))

(defn upper-neighbors
  "Returns all upper neighbors of node in a lattice diagram."
  [node]
  (map upper-node (upper-connections node)))

(defn lower-neighbors
  "Returns all lower neighbors of node in a lattice diagram."
  [node]
  (map lower-node (lower-connections node)))


;;; create and connect nodes

(def- default-node-style
  "Default node style for lattice diagrams."
  (doto (GStyle.)
    (.setForegroundColor Color/BLACK)
    (.setBackgroundColor Color/WHITE)
    (.setLineWidth 1.0)))

(def- default-object-concept-style
  "Default style for nodes being an object concept."
  (doto (GStyle.)
    (.setBackgroundColor Color/BLACK)))

(def- default-attribute-concept-style
  "Default style for nodes being an attribute concept."
  (doto (GStyle.)
    (.setBackgroundColor Color/BLUE)))

(def- default-node-label-style
  "Default style for node labels."
  (doto (GStyle.)
    (.setBackgroundColor Color/WHITE)))

(defn- create-two-halfcircles
  "Creates points for two half circles, lower circle points first."
  [x y radius]
  (let [x       (double x),
        y       (double y),
        radius  (double radius),
        samples 100,
        angle   (/ Math/PI samples),
        [upper-points, lower-points] (loop [current-angle (double (- (/ Math/PI 2.0))),
                                            acc-samples 0,
                                            upper-points [],
                                            lower-points []]
                                       (if (> acc-samples samples)
                                         [upper-points, lower-points]
                                         (let [new-x (+ x (* radius (Math/sin current-angle))),
                                               new-y (+ y (* radius (Math/cos current-angle)))]
                                           (recur (double (+ current-angle angle))
                                                  (inc acc-samples)
                                                  (conj upper-points new-x new-y)
                                                  (conj lower-points new-x (+ y y (- new-y)))))))]
    [(into-array Double/TYPE lower-points), (into-array Double/TYPE upper-points)]))

(def default-node-radius
  "Initial node radius when drawing lattices."
  5.0)

(defn- add-node
  "Adds a node to scn at position [x y]."
  [^GScene scn, x, y, name, [upper-label lower-label]]
  (let [^GSegment upper-segment (GSegment.),
        ^GSegment lower-segment (GSegment.),
        object (proxy [GObject] []
                 (draw []
                   (let [upper-style (if (= 1 (-?> this upper-neighbors count))
                                       default-attribute-concept-style
                                       nil),
                         lower-style (if (= 1 (-?> this lower-neighbors count))
                                       default-object-concept-style
                                       nil),
                         [x y] (position this),
                         [l u] (create-two-halfcircles x y (radius this))]
                     (.setGeometryXy lower-segment l)
                     (.setGeometryXy upper-segment u)
                     (.setStyle lower-segment lower-style)
                     (.setStyle upper-segment upper-style))))
        style (GStyle.)]
    (doto object
      (.setStyle default-node-style)
      (.addSegment lower-segment)
      (.addSegment upper-segment)<commit_msg>Fixed spurious occurrence of -?><commit_after>;; Copyright (c) <NAME>. 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 LICENSE 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 conexp.contrib.draw.nodes-and-connections
  "Namespace for representing nodes and their connections for drawing lattice diagrams."
  (:use [conexp.base :only (round, union, difference, def-)]
        conexp.contrib.draw.scenes)
  (:import [java.awt Color]
           [no.geosoft.cc.graphics GWindow GScene GObject GSegment
                                   GStyle GInteraction ZoomInteraction
                                   GText GPosition]))

;;; nodes and connections

(defn node?
  "Tests whether thing is a node of a lattice diagram or not."
  [thing]
  (and (instance? GObject thing)
       (= (:type @(.getUserData ^GObject thing)) :node)))

(defn connection?
  "Tests whether thing is a connection of a lattice diagram or not."
  [thing]
  (and (instance? GObject thing)
       (= (:type @(.getUserData ^GObject thing)) :connection)))

(defn position
  "Returns the position of a node in a lattice diagram."
  [^GObject node]
  (:position @(.getUserData node)))

(defn radius
  "Returns the radius of a node in a lattice diagram."
  [^GObject node]
  (:radius @(.getUserData node)))

(defn set-node-radius!
  "Sets radius of node."
  [^GObject node, radius]
  (dosync
   (alter (.getUserData node) assoc :radius radius)))

(defn get-name
  "Returns name of thing."
  [^GObject thing]
  (:name @(.getUserData thing)))

(defn lower-node
  "Returns for a connection conn the lower node in a lattice diagram."
  [^GObject conn]
  (:lower @(.getUserData conn)))

(defn upper-node
  "Returns for a connection conn the upper node in a lattice diagram."
  [^GObject conn]
  (:upper @(.getUserData conn)))

(defn upper-connections
  "Returns all upper connections for node in a lattice diagram."
  [^GObject node]
  (:upper @(.getUserData node)))

(defn lower-connections
  "Returns all lower connections of node in a lattice diagram."
  [^GObject node]
  (:lower @(.getUserData node)))

(defn upper-neighbors
  "Returns all upper neighbors of node in a lattice diagram."
  [node]
  (map upper-node (upper-connections node)))

(defn lower-neighbors
  "Returns all lower neighbors of node in a lattice diagram."
  [node]
  (map lower-node (lower-connections node)))


;;; create and connect nodes

(def- default-node-style
  "Default node style for lattice diagrams."
  (doto (GStyle.)
    (.setForegroundColor Color/BLACK)
    (.setBackgroundColor Color/WHITE)
    (.setLineWidth 1.0)))

(def- default-object-concept-style
  "Default style for nodes being an object concept."
  (doto (GStyle.)
    (.setBackgroundColor Color/BLACK)))

(def- default-attribute-concept-style
  "Default style for nodes being an attribute concept."
  (doto (GStyle.)
    (.setBackgroundColor Color/BLUE)))

(def- default-node-label-style
  "Default style for node labels."
  (doto (GStyle.)
    (.setBackgroundColor Color/WHITE)))

(defn- create-two-halfcircles
  "Creates points for two half circles, lower circle points first."
  [x y radius]
  (let [x       (double x),
        y       (double y),
        radius  (double radius),
        samples 100,
        angle   (/ Math/PI samples),
        [upper-points, lower-points] (loop [current-angle (double (- (/ Math/PI 2.0))),
                                            acc-samples 0,
                                            upper-points [],
                                            lower-points []]
                                       (if (> acc-samples samples)
                                         [upper-points, lower-points]
                                         (let [new-x (+ x (* radius (Math/sin current-angle))),
                                               new-y (+ y (* radius (Math/cos current-angle)))]
                                           (recur (double (+ current-angle angle))
                                                  (inc acc-samples)
                                                  (conj upper-points new-x new-y)
                                                  (conj lower-points new-x (+ y y (- new-y)))))))]
    [(into-array Double/TYPE lower-points), (into-array Double/TYPE upper-points)]))

(def default-node-radius
  "Initial node radius when drawing lattices."
  5.0)

(defn- add-node
  "Adds a node to scn at position [x y]."
  [^GScene scn, x, y, name, [upper-label lower-label]]
  (let [^GSegment upper-segment (GSegment.),
        ^GSegment lower-segment (GSegment.),
        object (proxy [GObject] []
                 (draw []
                   (let [upper-style (if (= 1 (some-> this upper-neighbors count))
                                       default-attribute-concept-style
                                       nil),
                         lower-style (if (= 1 (some-> this lower-neighbors count))
                                       default-object-concept-style
                                       nil),
                         [x y] (position this),
                         [l u] (create-two-halfcircles x y (radius this))]
                     (.setGeometryXy lower-segment l)
                     (.setGeometryXy upper-segment u)
                     (.setStyle lower-segment lower-style)
                     (.setStyle upper-segment upper-style))))
        style (GStyle.)]
    (doto object
      (.setStyle default-node-style)
      (.addSegment lower-segment)
      (.addSegment upper-segment)
{'fraction_non_alphanumeric': 0.1113499570077386, 'fraction_numerical': 0.002751504729148753, 'mean_word_length': 1.9445569620253165, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 56, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4933040', 'n_tokens_mistral': 3261, 'n_tokens_neox': 3073, 'n_words': 1099}