Non Monotonic Contexts. (#164)

* Implemented Non-Monotonic Formal Contexts.

* Implemented Minimized Derivation Functions.

* Name Refactoring.

* Implemented Non-monotonic Conditional.

* Implemented Computation of Typical Concepts.

* Refactored Implementation.

* Added Documentation.

* Image Fix.

doc/Non-Monotonic-Contexts.org

@@ -0,0 +1,82 @@
+#+property: header-args :wrap src text
+#+property: header-args:text :eval never
+
+* Extended Formal Contexts
+
+The publication ~Non-monotonic Extensions to Formal Concept Analysis via Object Preferences~ (10.48550/arXiv.2410.04184) introduces a variant of formal contexts, 
+that feature an ordering on the context's objects.
+Based on this approach, ~conexp-clj~ offers the ~Extended Context~ class:
+
+#+begin_src clojure :exports both
+(def test-objs #{1 2 3 4 5})
+(def test-attrs #{1 2 3 4 5})
+(def test-incidence #{[1 1] [1 2] [2 3] [2 4] [3 1] [3 3] [4 2] [4 4]})
+
+(def object-order =<)
+(def attribute-order #{[1 1] [2 2] [3 3] [4 4] [5 5] [1 2] [2 3] [1 3]})
+
+(def ectx (make-extended-context test-objs test-attrs test-incidence object-order attribute-order))
+#+end_src
+
+#+begin_src text
+  |1 2 3 4 5 
+--+----------
+1 |x x . . . 
+2 |. . x x . 
+3 |x . x . . 
+4 |. x . x . 
+5 |. . . . . 
+#+end_src
+
+An extended context takes the same parameters as a regular formal context. Additionally, it requires an partial order on the objects and attributes.
+Such an order may be provided explicitely as a set, or as a relation function. If no order on the objects and/or attributes is required it can be left empty by inputting ~#{}~ of ~nil~.
+
+The ~minimized-object-derivation~ of a set of objects from the extended context returns the set off all attributes that they have in common, but only those that are minimal with respect to the attribute order.
+The ~minimized-attribute-derivation~ workes analogously.
+
+#+begin_src clojure :exports both
+(minimized-object-derivation ectx #{1})
+(minimized-attribute-derivation ectx #{3})
+#+end_src
+
+#+begin_src text
+#{1}
+#{3}
+#+end_src
+
+The ~typical concepts~ of an extended context can be computed as well:
+
+#+begin_src clojure :exports both
+(concepts ectx)
+(typical-concepts ectx)
+#+end_src
+
+#+begin_src text
+([#{1 4 3 2 5} #{}]
+ [#{1 3} #{1}]
+ [#{} #{1 4 3 2 5}]
+ [#{3} #{1 3}]
+ [#{1} #{1 2}]
+ [#{4 2} #{4}]
+ [#{2} #{4 3}]
+ [#{4} #{4 2}]
+ [#{3 2} #{3}]
+ [#{1 4} #{2}])
+
+#{[#{3} #{1 3}]
+  [#{} #{1 4 3 2 5}]
+  [#{1} #{1 2}]
+  [#{4} #{4 2}]
+  [#{2} #{4 3}]}
+#+end_src
+
+They can be visualized in the drawing of the concept lattice by using the ~typical-concept-valuation~ function:
+
+#+begin_src clojure :exports both
+(def lat (concept-lattice ectx))
+(def valuation (typical-concept-valuation (typical-concepts ectx)))
+
+(draw-lattice lat :value-fn valuation)
+#+end_src
+
+[[./images/TypicalConcepts.PNG]]

src/main/clojure/conexp/fca/non_monotonic_contexts.clj

@@ -0,0 +1,121 @@
+(ns conexp.fca.non-monotonic-contexts
+  (:require [conexp.base :refer :all]
+            [conexp.fca.posets :refer :all]
+            [conexp.fca.posets :refer :all]
+            [conexp.fca.contexts :refer :all]
+            [clojure.set :as set]))
+
+;Based on the Publication: 
+;Non-monotonic Extensions to Formal Concept Analysis via Object Preferences
+;10.48550/arXiv.2410.04184
+
+
+;Based on Definition 8
+(defprotocol Extended-Context
+
+  (context [this] "Returns the underlying context.")
+
+  (object-order [this] "Returns the partial order on the context's objects.")
+  (attribute-order [this] "Returns the partial order on the context's attributes.")
+  (object-order-explicit [this] "Returns an explicit set representation of the object order.")
+  (attribute-order-explicit [this] "Returns an explicit set representation of the attribute order order.")
+)
+
+(deftype extended-context [ctx object-order attribute-order]
+
+  Object
+  (equals [this other]
+    (generic-equals [this other] extended-context [ctx object-order attribute-order]))
+  (hashCode [this]
+    (hash-combine-hash extended-context ctx object-order attribute-order))
+
+  Context
+  (objects [this] (objects ctx))
+  (attributes [this] (attributes ctx))
+  (incidence [this] (incidence ctx))
+
+  Extended-Context
+  (context [this] ctx)
+  (object-order [this] object-order)
+  (attribute-order [this] attribute-order)
+  (object-order-explicit [this] (relation-set (objects this) object-order))
+  (attribute-order-explicit [this] (relation-set (attributes this) attribute-order))
+)
+
+(defmethod print-method extended-context [ectx out]
+  (.write ^java.io.Writer out
+          ^String (context-to-string ectx))
+)
+
+
+(defn make-extended-context 
+  ([objs attrs incidence obj-order attr-order]
+   "Creates Extended Formal Context from Sets of Objects and Attributes, the Incidence Relation
+    and a Partial Order on the Objects and on the Attributes."
+   (make-extended-context (make-context objs attrs incidence) obj-order attr-order)
+   )
+  ([ctx obj-order attr-order]
+   "Creates Extended Formal Context from a Pre-existing Formal Context Partial Order 
+   on the Objects and on the Attributes. Empty Collections and Values of nil are Interpreted
+   as the Reflexive, but Otherwise Empty Order Relation."
+   (let [objs (objects ctx)
+         attrs (attributes ctx)
+         obj-order (if (or (nil? obj-order) 
+                           (and (coll? obj-order) 
+                                (empty? obj-order))) = obj-order);add reflexivity of order is empty
+         attr-order (if (or (nil? attr-order) 
+                            (and (coll? attr-order) 
+                                 (empty? attr-order))) = attr-order);add reflexivity of order is empty
+         obj-poset (make-poset objs (relation-function objs obj-order));convert to poset to verify ordering
+         attr-poset (make-poset attrs (relation-function attrs  attr-order))];convert to poset to verify ordering
+
+        (extended-context. ctx (relation-function objs obj-order) (relation-function attrs attr-order)))
+   )
+)
+
+;Based on Definition 9
+(defn minimized-object-derivation [ectx objs]
+  "Computes the Minimized Object Derivation of the Supplied Set of Objects on the 
+   Supplied Extended Formal Context."
+  (let [attr-order (attribute-order ectx)
+        derivation (object-derivation ectx objs)
+        minimal (fn [attr] (not-any? #(attr-order % attr) (disj derivation attr)))]
+    (into #{} (filter minimal derivation)))
+)
+
+(defn minimized-attribute-derivation [ectx attrs]
+  "Computes the Minimized Attribute Derivation of the Supplied Set of Attributes on the 
+   Supplied Extended Formal Context."
+  (let [obj-order (object-order ectx)
+        derivation (attribute-derivation ectx attrs)
+        minimal (fn [obj] (not-any? #(obj-order % obj) (disj derivation obj)))]
+    (into #{} (filter minimal derivation)))
+)
+
+;Theorem 1
+(defn minimized-return [ectx attrs]
+  "Implements the Minimized Return Operator."
+  (object-derivation ectx (minimized-attribute-derivation ectx attrs))
+)
+
+;Definition 12
+(defn respects? [ectx A B]
+  "Verifies Whether the Supplied Extended Formal Context Respects the Non-monotonic 
+   Conditional A -> ¬ B."
+  (= (set/intersection (minimized-attribute-derivation ectx A) (attribute-derivation ectx B)) #{})
+
+)
+
+;Definition 14
+(defn typical-concepts [ectx]
+  "Returns a Set of all Typical Concepts of an Extended Formal Context."
+  (set (map #(vector (attribute-derivation ectx (minimized-return ectx (second %)))
+                     (minimized-return  ectx (second %))) 
+            (concepts ectx)))
+)
+
+(defn typical-concept-valuation [tconcepts]
+  "Returns a Valuation Function to be Used for Visualizing the Typical Concepts when Drawing the Concept
+   Lattice of an Extended Formal Context."
+  #(if (.contains tconcepts %) "TYPICAL" "")
+)

src/main/clojure/conexp/fca/posets.clj

@@ -162,3 +162,15 @@
       (recur (union filter #{next-element})
              (union upper-neighbours (poset-upper-neighbours poset next-element))
              (first (difference upper-neighbours filter))))))
+
+(defn relation-set [base-set order]
+  "Produces an explicit set representation of the relation defined by the supplied order."
+  (if (coll? order) order
+                    (into #{} (filter #(order (first %) (second %)) (for [x base-set y base-set] [x y]))))
+)
+
+(defn relation-function [base-set order]
+  "Produces a membership function of the relation defined by the supplied set."
+  (if (fn? order) order
+                  #(.contains order [%1 %2]))
+)

src/test/clojure/conexp/fca/fuzzy/fca_test.clj

@@ -49,7 +49,6 @@
                                 0.2 0.9 0.7 0.5 1.0 0.6,
                                 1.0 1.0 0.8 1.0 1.0 0.5]))
 
-(println fctx)
 
 (deftest test-mv-to-fuzzy
 

src/test/clojure/conexp/fca/non_monotonic_context.clj

@@ -0,0 +1,64 @@
+(ns conexp.fca.non-monotonic-context-test
+  (:use conexp.base
+        conexp.fca.contexts
+        conexp.fca.non-monotonic-contexts)
+  (:use clojure.test))
+
+
+(def test-objs #{1 2 3 4 5})
+(def test-attrs #{1 2 3 4 5})
+(def test-incidence #{[1 1] [1 2] [2 3] [2 4] [3 1] [3 3] [4 2] [4 4]})
+(def test-ctx (make-context test-objs test-attrs test-incidence))
+
+(def ectx (make-extended-context test-ctx = 
+                                          #{[1 1] [2 2] [3 3] [4 4] [5 5] 
+                                            [1 2] [2 3] [1 3]}))
+
+
+(deftest test-context-creation
+
+  ;non-orders as argument
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx #{[1 1]} =)))
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx = #{[1 1]})))
+
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx #{[1 1] [2 2] [3 3] [4 4] [5 5] [1 2] [2 3]} =)))
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx = #{[1 1] [2 2] [3 3] [4 4] [5 5] [1 2] [2 3]})))
+
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx #{[1 1] [2 2] [3 3] [4 4] [5 5] [1 2] [2 1]} =)))
+  (is (thrown? IllegalArgumentException (make-extended-context test-ctx = #{[1 1] [2 2] [3 3] [4 4] [5 5] [1 2] [2 1]})))
+
+  ;empty orders as input
+  (is (make-extended-context test-ctx #{} =))
+  (is (make-extended-context test-ctx = nil))
+
+
+  (is (= (make-extended-context test-ctx = =)
+         (make-extended-context test-objs test-attrs test-incidence = =)))
+)
+
+(deftest test-order-conversion
+
+  (is (= (object-order ectx) =))
+
+  (is (= (object-order-explicit ectx) #{[2 2] [3 3] [1 1] [5 5] [4 4]}))
+  (is (= (attribute-order-explicit ectx) #{[2 2] [2 3] [3 3] [1 1] [1 3] [5 5] [4 4] [1 2]}))
+
+)
+
+(deftest minimized-derivation-test
+
+  (is (= (minimized-object-derivation ectx #{}) #{1 4 5}))
+  (is (= (minimized-object-derivation ectx #{1}) #{1}))
+  (is (= (minimized-object-derivation ectx #{2}) #{3 4}))
+
+  (is (= (minimized-attribute-derivation ectx #{}) #{1 2 3 4 5}))
+  (is (= (minimized-attribute-derivation ectx #{1 2}) #{1}))
+
+)
+
+(deftest test-conditional
+
+  (is (respects? ectx #{1 2} #{3 4}))
+  (is (respects? ectx #{3 4} #{1 2 5}))
+  (is (not (respects? ectx #{1} #{2})))
+)