<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.algorithms.titanic
  (:use conexp.main))

(ns-doc
 "Implements the TITANIC algorithm. Note that this implementation is
 not tune for speed but for flexibility.")

;;; Pragmatics

(defmacro- set-val!
  "Sets (via set!) the value for key in map to val."
  [map key val]
  `(set! ~map (assoc ~map ~key ~val)))


;;; TITANIC Implementation

(defvar- closure nil
  "Holds the closures of sets. To be rebound.")
(defvar- minimum nil
  "Computes the minimum of weights in a given sequence of weights. To
  be rebound.")
(defvar- set-weight nil
  "Holds the weights of sets. To be rebound.")

(defn- subset-weight
  "Returns the minimum of the weights of all proper subsets of X."
  [max-weight X]
  (minimum (conj (map #(get set-weight (disj X %)) X)
                 max-weight)))

(defn- titanic-closure
  "Computes the closure of X by the weights of its subsets. The
  following restrictions apply:

    - keys is the sequence of already computed key sets and is orderd
      by weights ascending,
    - X is a member of keys.
  "
  [X base-set keys candidates]
  (let [X-weight (set-weight X),
        keys     (map #(vector % (set-weight %)) keys)]
    (loop [Y        (apply union X (map #(closure (disj X %)) X)),
           elements (difference base-set Y)]
      (if-not (empty? elements)
        (let [m    (first elements),
              add? (if-let [s (set-weight (conj X m))]
                     (= s X-weight)
                     (not (first (for [[K weight] keys,
                                       :while (not= weight X-weight)
                                       :when (and (contains? K m)
                                                  (subset? (disj K m) X))]
                                   K))))]
          (recur (if add? (conj Y m) Y)
                 (rest elements)))
        Y))))

(defn- titanic-generate
  "Computes the next candidate set."
  [base-set key-set]
  (set-of next [A key-set,
                m (difference base-set A),
                :let [next (conj A m)]
                :when (forall [x A]
                        (contains? key-set (disj next x)))]))

(defn titanic
  "Implements the titanic algorithm. weigh must return for a
  collection of sets a hash-map mapping every set to its weight, with
  max-weight being the maximal weight possbile. weight-minimum is a
  function of one argument being a sequence of weights and returning
  the minimal of those."
  [base-set weigh max-weight weight-minimum]
  (binding [closure       {},
            set-weight    (weigh [#{}]),
            subset-weight (partial subset-weight max-weight),
            minimum       weight-minimum]

    (loop [key-set    #{#{}},
           candidates (set-of #{m} [m base-set]),
           keys       [#{}]]
      (set! set-weight (into set-weight (weigh candidates)))
      (doseq [X key-set]
        (set-val! closure X (titanic-closure X base-set keys candidates)))
      (let [next-key-set (set-of X [X candidates,
                                    :when (not= (subset-weight X)
                                                (get set-weight X))])]
        (if-not (empty? next-key-set)
          (recur next-key-set
                 (titanic-generate base-set next-key-set)
                 (sort (fn [a b]
                         (= (get set-weight a)
                            (weight-minimum [(get set-weight a) (get set-weight b)])))
                       (concat next-key-set keys)))
          (distinct (map closure keys)))))))

;;;

(defn- supports
  "Returns a function of one argument being a collection of sets of attributes,
  returning a hash-map from those sets to their supports in the given
  context, if they have at least minsupp elements. Otherwise they are
  associated with -1."
  [context minsupp]
  (let [num-of-objects (count (objects context)),
        minnum (* minsupp num-of-objects)]
    (fn [coll]
      (into {} (for [atts coll]
                 [atts (let [num (count (attribute-derivation context atts))]
                         (if (< num minnum)
                           -1
                           (/ num num-of-objects)))])))))

(defn titanic-context-intents
  "Computes the intents of the given context via TITANIC."
  [context]
  (titanic (attributes context)
           (supports context 0)
           1.0
           #(apply min %)))

(defn titanic-iceberg-intent-set
  "Computes the iceberg intent set for given context and minimal
  support minsupp via TITANIC."
  [context minsupp]
  (let [intents (titanic (attributes context)
                         (supports context minsupp)
                         1.0
                         #(apply min %))]
    (if (<= (* (count (objects context)) minsupp)
            (count (attribute-derivation context (attributes context))))
      intents
      (remove #{(attributes context)} intents))))

;;;

nil
<commit_msg>Some minor tweaks for TITANIC<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.algorithms.titanic
  (:use conexp.main))

(ns-doc
 "Implements the TITANIC algorithm. Note that this implementation is
 not tune for speed but for flexibility.")

;;; Pragmatics

(defmacro- set-val!
  "Sets (via set!) the value for key in map to val."
  [map key val]
  `(set! ~map (assoc ~map ~key ~val)))


;;; TITANIC Implementation

(defvar- closure nil
  "Holds the closures of sets. To be rebound.")
(defvar- minimum nil
  "Computes the minimum of weights in a given sequence of weights. To
  be rebound.")
(defvar- set-weight nil
  "Holds the weights of sets. To be rebound.")

(defn- subset-weight
  "Returns the minimum of the weights of all proper subsets of X."
  [max-weight X]
  (minimum (conj (map #(get set-weight (disj X %)) X)
                 max-weight)))

(defn- titanic-closure
  "Computes the closure of X by the weights of its subsets. The
  following restrictions apply:

    - keys is the sequence of already computed key sets and is orderd
      by weights ascending,
    - X is a member of keys.
  "
  [X base-set keys candidates]
  (let [X-weight (set-weight X),
        keys     (take-while #(not= (set-weight %) X-weight) keys)]
    (loop [Y        (apply union X (map #(closure (disj X %)) X)),
           elements (difference base-set Y)]
      (if-not (empty? elements)
        (let [m    (first elements),
              X+m  (conj X m),
              add? (if (contains? candidates X+m)
                     (= (set-weight X+m) X-weight)
                     (not (first (for [K keys,
                                       :when (and (contains? K m)
                                                  (subset? K X+m))]
                                   K))))]
          (recur (if add? (conj Y m) Y)
                 (rest elements)))
        Y))))

(defn- titanic-generate
  "Computes the next candidate set."
  [base-set key-set]
  (set-of next [A key-set,
                m (difference base-set A),
                :let [next (conj A m)]
                :when (forall [x A]
                        (contains? key-set (disj next x)))]))

(defn titanic
  "Implements the titanic algorithm. weigh must return for a
  collection of sets a hash-map mapping every set to its weight, with
  max-weight being the maximal weight possbile. weight-minimum is a
  function of one argument being a sequence of weights and returning
  the minimal of those."
  [base-set weigh max-weight weight-minimum]
  (binding [closure       {},
            set-weight    (weigh [#{}]),
            subset-weight (partial subset-weight max-weight),
            minimum       weight-minimum]

    (loop [key-set    #{#{}},
           candidates (set-of #{m} [m base-set]),
           keys       [#{}]]
      (set! set-weight (into set-weight (weigh candidates)))
      (doseq [X key-set]
        (set-val! closure X (titanic-closure X base-set keys candidates)))
      (let [next-key-set (set-of X [X candidates,
                                    :when (not= (subset-weight X)
                                                (get set-weight X))])]
        (if-not (empty? next-key-set)
          (recur next-key-set
                 (titanic-generate base-set next-key-set)
                 (sort (fn [a b]
                         (= (get set-weight a)
                            (weight-minimum [(get set-weight a) (get set-weight b)])))
                       (concat next-key-set keys)))
          (distinct (map closure keys)))))))

;;;

(defn- supports
  "Returns a function of one argument being a collection of sets of attributes,
  returning a hash-map from those sets to their supports in the given
  context, if they have at least minsupp elements. Otherwise they are
  associated with -1."
  [context minsupp]
  (let [num-of-objects (count (objects context)),
        minnum (* minsupp num-of-objects)]
    (fn [coll]
      (into {} (for [atts coll]
                 [atts (let [num (count (attribute-derivation context atts))]
                         (if (< num minnum)
                           -1
                           (/ num num-of-objects)))])))))

(defn titanic-context-intents
  "Computes the intents of the given context via TITANIC."
  [context]
  (titanic (attributes context)
           (supports context 0)
           1.0
           #(apply min %)))

(defn titanic-iceberg-intent-set
  "Computes the iceberg intent set for given context and minimal
  support minsupp via TITANIC."
  [context minsupp]
  (let [intents (titanic (attributes context)
                         (supports context minsupp)
                         1.0
                         #(apply min %))]
    (if (<= (* (count (objects context)) minsupp)
            (count (attribute-derivation context (attributes context))))
      intents
      (remove #{(attributes context)} intents))))

;;;

nil

{'fraction_non_alphanumeric': 0.1097972972972973, 'fraction_numerical': 0.0020645645645645644, 'mean_word_length': 1.914137270987148, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 17, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4614587', 'n_tokens_mistral': 3122, 'n_tokens_neox': 3003, 'n_words': 1173}