<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.fca.misc
  "More on FCA."
  (:require [conexp.base :refer :all]
            [conexp.fca
             [contexts :refer :all]
             [exploration :refer :all]
             [implications :refer :all]]
            [conexp.util.graph :as graph]))

;;; Compatible Subcontexts

(defn compatible-subcontext?
  "Tests whether ctx-1 is a compatible subcontext of ctx-2."
  [ctx-1 ctx-2]
  (and (subcontext? ctx-1 ctx-2)
       (forall [[h m] (up-arrows ctx-2)]
         (=> (contains? (objects ctx-1) h)
             (contains? (attributes ctx-1) m)))
       (forall [[g n] (down-arrows ctx-2)]
         (=> (contains? (attributes ctx-1) n)
             (contains? (objects ctx-1) g)))))

(defn compatible-subcontexts
  "Returns all compatible subcontexts of ctx. ctx has to be reduced."
  [ctx]
  (if (not (context-reduced? ctx))
    (illegal-argument "Context given to compatible-subcontexts has to be reduced."))
  (let [up-arrows        (up-arrows ctx)
        down-arrows      (down-arrows ctx)
        subcontext-graph (graph/transitive-closure
                          (struct graph/directed-graph
                                  (disjoint-union (objects ctx) (attributes ctx))
                                  (fn [[x idx]]
                                    (condp = idx
                                      0 (for [[g m] up-arrows
                                              :when (= g x)]
                                          [m 1])
                                      1 (for [[g m] down-arrows
                                              :when (= m x)]
                                          [g 0])))))
        down-down        (set-of [g m] [m (attributes ctx)
                                        [g idx] (graph/get-neighbors subcontext-graph [m 1])
                                        :when (= idx 0)])
        compatible-ctx   (make-context (objects ctx)
                                       (attributes ctx)
                                       (fn [g m]
                                         (not (contains? down-down [g m]))))]
    (for [[G-H N] (concepts compatible-ctx)]
      (make-context-nc (difference (objects ctx) G-H) N (incidence ctx)))))

;;; Bonds<commit_msg>Remove dependency on c.u.graph for compatible subcontexts<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.fca.misc
  "More on FCA."
  (:require [conexp.base :refer :all]
            [conexp.fca
             [contexts :refer :all]
             [exploration :refer :all]
             [implications :refer :all]]))

;;; Compatible Subcontexts

(defn compatible-subcontext?
  "Tests whether ctx-1 is a compatible subcontext of ctx-2."
  [ctx-1 ctx-2]
  (and (subcontext? ctx-1 ctx-2)
       (forall [[h m] (up-arrows ctx-2)]
         (=> (contains? (objects ctx-1) h)
             (contains? (attributes ctx-1) m)))
       (forall [[g n] (down-arrows ctx-2)]
         (=> (contains? (attributes ctx-1) n)
             (contains? (objects ctx-1) g)))))

(defn compatible-subcontexts
  "Returns all compatible subcontexts of ctx. ctx has to be reduced."
  [ctx]
  (if (not (context-reduced? ctx))
    (illegal-argument "Context given to compatible-subcontexts has to be reduced."))
  (let [up-arrows         (up-arrows ctx)
        down-arrows       (down-arrows ctx)
        transitive-arrows (transitive-closure
                           (union (set-of [[g 0] [m 1]] | [g m] up-arrows)
                                  (set-of [[m 1] [g 0]] | [g m] down-arrows)))
        down-down         (set-of [g m] [[[m idx-m] [g idx-g]] transitive-arrows
                                         :when (and (= 1 idx-m) (= 0 idx-g))])
        compatible-ctx    (make-context (objects ctx)
                                        (attributes ctx)
                                        (fn [g m]
                                          (not (contains? down-down [g m]))))]
    (for [[G-H N] (concepts compatible-ctx)]
      (make-context-nc (difference (objects ctx) G-H) N (incidence ctx)))))

;;; Bonds
{'fraction_non_alphanumeric': 0.12079853330617234, 'fraction_numerical': 0.00896312894683235, 'mean_word_length': 1.629887520085699, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 31, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5883497', 'n_tokens_mistral': 1408, 'n_tokens_neox': 1354, 'n_words': 482}