Fuzzy (#161)

* Recovered fuzzy code

* Adjusted File Structure.

* Fixed Namespaces.

* Started Implementing Tests.

* Attempted Fuzzy Set Test.

* Started Reimplementing Functions.

* Continued Refactoring Fuzzy FCA Functions.

* Finished Refactoring Fuzzy FCA Implementation.

---------

Co-authored-by: De Narm <[email protected]>

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

@@ -0,0 +1,154 @@
+;; Copyright ⓒ the conexp-clj developers; 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.fuzzy.fca
+  "Basic definitions for Fuzzy FCA"
+  (:use conexp.base
+        conexp.fca.contexts
+        conexp.fca.many-valued-contexts
+        [conexp.fca.fuzzy sets]))
+
+
+(deftype Fuzzy-Context [objects attributes incidence]
+    Object
+  (equals [this other]
+    (generic-equals [this other] Fuzzy-Context [objects attributes incidence]))
+  (hashCode [this]
+    (hash-combine-hash Fuzzy-Context objects attributes incidence))
+
+  conexp.fca.contexts/Context
+  (objects [this] objects)
+  (attributes [this] attributes)
+  (incidence [this] incidence))
+
+(defn mv->fuzzy-context-nc
+  "Converts a many-valued-context to a fuzzy context, without checking."
+  [mv-ctx]
+  (Fuzzy-Context. (objects mv-ctx) (attributes mv-ctx) (make-fuzzy-set (incidence mv-ctx)))
+  )
+
+(defmethod print-method Fuzzy-Context
+  [ctx out]
+  (.write ^java.io.Writer out
+          ^String (mv-context-to-string (make-mv-context (objects ctx)
+                                                         (attributes ctx)
+                                                         (fn [a b] ((incidence ctx) [a b])))))
+  )
+
+(defmulti make-fuzzy-context
+  "Creates a fuzzy context from the given attributes. A fuzzy context
+  is nothing else than a Many-Valued Context with real entries between
+  0 and 1."
+  {:arglists '([objects attributes incidence])}
+  (fn [& args]
+    (vec (map clojure-type args))))
+
+(defmethod make-fuzzy-context [clojure-coll clojure-coll clojure-fn]
+  [objects attributes truth-function]
+  (let [mv-ctx (make-mv-context (set objects)
+                                (set attributes)
+                                truth-function)]
+    (when-not (forall [v (vals (incidence mv-ctx))] (and (number? v) (<= 0 v 1)))
+      (illegal-argument "Given function does not return real values between 0 and 1."))
+    (mv->fuzzy-context-nc mv-ctx)))
+
+(defmethod make-fuzzy-context [clojure-coll clojure-coll clojure-coll]
+  [objects attributes values]
+  (let [mv-ctx (make-mv-context-from-matrix objects attributes values)]
+    (when-not (forall [v (vals (incidence mv-ctx))] (and (number? v) (<= 0 v 1)))
+      (illegal-argument "Given value table does not contain of real values between 0 and 1."))
+    (mv->fuzzy-context-nc mv-ctx)))
+
+(defn make-fuzzy-context-from-matrix
+  "Creates a fuzzy context from the given (number of) objects, (number
+  of) attributes and the value table, which must contain only real
+  values between 0 and 1."
+  [objects attributes values]
+  (make-fuzzy-context objects attributes values))
+
+(defn- fuzzy-operators [norm]
+  "Returns fuzzy operations based on the supplied norm, that are required for more complex fuzzy operations."
+  (let [t-norm (first norm)
+        residuum (second norm)
+        f-and #(t-norm %1 (residuum %1 %2))
+        f-or #(f-and (residuum (residuum %1 %2) %2)
+                     (residuum (residuum %2 %1) %1))
+        f-neg #(residuum % 0)]
+    [t-norm residuum f-and f-or f-neg])
+  )
+
+(defn fuzzy-object-derivation
+  "Accepts a fuzzy context and a fuzzy set of objects.
+   Computes the fuzzy object derivation of the supplied objects in the supplied fuzzy context."
+  ([fctx fobjs norm]
+    (fuzzy-object-derivation fctx fobjs norm identity))
+
+  ([fctx fobjs norm hedge]
+    (let [[t-norm residuum f-and f-or f-neg] (fuzzy-operators norm)
+          inz (incidence fctx)]
+      (make-fuzzy-set (into {} (for [attr (attributes fctx)]
+                                  [attr
+                                  (reduce f-and 1 (for [obj (keys fobjs)] (residuum (hedge (fobjs obj)) (inz [obj attr]))))])))))
+  )
+
+(defn fuzzy-attribute-derivation
+  "Accepts a fuzzy context and a fuzzy set of attributes.
+   Computes the fuzzy object derivation of the supplied attributes in the supplied fuzzy context."
+  ([fctx fattrs norm]
+   (fuzzy-attribute-derivation fctx fattrs norm identity))
+
+  ([fctx fattrs norm hedge]
+   (let [[t-norm residuum f-and f-or f-neg] (fuzzy-operators norm)
+         inz (incidence fctx)]
+     (make-fuzzy-set (into {} (for [obj (attributes fctx)]
+                                [obj
+                                (reduce f-and 1 (for [attr (keys fattrs)] (residuum (hedge (fattrs attr)) (inz [obj attr]))))])))))
+  )
+
+(defn globalization-hedge [x]
+  "Globalization hedge function."
+  (if (= x 1) 1 0)
+  )
+
+(defn fuzzy-subset-degree
+  "Returns the degree to which fset1 is a subset of fset2. Applies hedge to the truth
+  value of an element being in fset1, if given."
+  ([fset1 fset2 norm]
+   (fuzzy-subset-degree fset1 fset2 norm identity))
+
+  ([fset1 fset2 norm hedge]
+   (let [[t-norm residuum f-and f-or f-neg] (fuzzy-operators norm)]
+     (reduce #(f-and %1 (residuum (hedge (fset1 %2))
+                                  (fset2 %2)))
+             1
+             (keys fset1))))
+  )
+
+(defn validity
+  "Returns the degree to which the implication *fset1* ==> *fset2* is true in the
+  supplied fuzzy context. *fset1* and *fset2* are fuzzy subsets of the attributes of
+  the supplied fuzzy context."
+  ([fctx fset1 fset2 norm]
+   (validity fctx fset1 fset2 norm identity))
+  ([fctx fset1 fset2 norm hedge]
+   (fuzzy-subset-degree (make-fuzzy-set fset2)
+                        (fuzzy-object-derivation fctx
+                                                 (fuzzy-attribute-derivation fctx (make-fuzzy-set fset1) norm)
+                                                 norm
+                                                 hedge)
+                  norm)))
+
+;Pairs of t-norms and residuum
+(def lukasiewicz-norm [#(max 0 (+ %1 %2 -1)) 
+                       #(min 1 (+ 1 (- %1) %2))])
+
+(def goedel-norm [#(min %1 %2) 
+                  #(if (<= %1 %2) 1 %2)])
+
+(def product-norm [#(* %1 %2)
+                   #(if (<= %1 %2) 1 (/ %2 %1))])

src/main/clojure/conexp/fca/fuzzy/sets.clj

@@ -0,0 +1,160 @@
+;; Copyright ⓒ the conexp-clj developers; 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.fuzzy.sets
+  "Basic definitions for fuzzy sets"
+  (:use conexp.base)
+  (:require [clojure.math.combinatorics :as comb]
+            [clojure.set :as set]))
+
+
+(deftype Fuzzy-Set [^clojure.lang.APersistentMap hashmap]
+
+  Object
+  (equals [this other]
+    (generic-equals [this other] Fuzzy-Set [hashmap]))
+  (hashCode [this]
+    (hash-combine-hash Fuzzy-Set hashmap))
+  (toString [this]
+    (str hashmap))
+
+  clojure.lang.ISeq
+  (first [this]
+    (first hashmap))
+  (next [this]
+    (next hashmap))
+  (more [this]
+    (if-let [n (next hashmap)]
+      n
+      ()))
+  (cons [this [k v]]
+    (when-not (and (number? v) (<= 0 v 1))
+      (illegal-argument "Fuzzy sets only support real values in [0,1]"))
+    (if (zero? v)
+      (Fuzzy-Set. (dissoc hashmap k))
+      (Fuzzy-Set. (assoc hashmap k v))))
+  (seq [this]
+    (seq hashmap))
+  (count [this]
+    (count hashmap))
+  (empty [this]
+    (Fuzzy-Set. {}))
+  (equiv [this other]
+    (.equals this other))
+
+  clojure.lang.IFn
+  (invoke [this thing]
+    (let [result (hashmap thing)]
+      (or result 0)))
+  (applyTo [this ^clojure.lang.ISeq seq]
+    (if (= 1 (count seq))
+      (.applyTo hashmap seq)
+      (illegal-argument "Cannot apply fuzzy sets to non-singleton sequences.")))
+
+  clojure.lang.Associative
+  (containsKey [this o]
+    true)
+  (entryAt [this o]
+    (.entryAt hashmap o))
+  (assoc [this k v]
+    (.cons this [k v]))
+
+  clojure.lang.ILookup
+  (valAt [this o]
+    (get hashmap o 0))
+  (valAt [this o not-found]
+    (get hashmap o not-found)))
+
+(defmethod print-method Fuzzy-Set [set out]
+  (.write ^java.io.Writer out
+          ^String (str "#F" set)))
+
+(defmulti make-fuzzy-set
+  "Constructs a fuzzy set from a given collection."
+  clojure-type)
+
+(defmethod make-fuzzy-set :default
+  [thing]
+  (illegal-argument "Don't know how to create a fuzzy set from " thing "."))
+
+(defmethod make-fuzzy-set clojure-map
+  [hashmap]
+  (assert (forall [v (vals hashmap)]
+            (and (number? v) (<= 0 v 1))))
+  (Fuzzy-Set. (select-keys hashmap (remove #(zero? (hashmap %)) (keys hashmap)))))
+
+(defmethod make-fuzzy-set Fuzzy-Set
+  [fuzzy-set]
+  fuzzy-set)
+
+(defmethod make-fuzzy-set clojure-set
+  [set]
+  (Fuzzy-Set. (map-by-fn (constantly 1) set)))
+
+(defmethod make-fuzzy-set clojure-coll
+  [coll]
+  (make-fuzzy-set (set coll)))
+
+(defmethod make-fuzzy-set clojure-vec
+  [vec]
+  (make-fuzzy-set (set vec)))
+
+(defn fuzzy-set-to-hashmap [fuzzy-set]
+  "Returns a Hashmap Mapping each Element in the Fzuuy Set to its Membership Degree."
+  (.hashmap ^Fuzzy-Set fuzzy-set))
+
+(defn fuzzy-set? [thing]
+  "Tests whether the argument is a fuzzy set."
+  (instance? Fuzzy-Set thing))
+
+;Set Operations
+(defn fuzzy-intersection [a b]
+  "Computes the intersection of fuzzy sets."
+  (let [a-entries (set (map first a))
+        b-entries (set (map first b))
+        entries (set/union a-entries b-entries)]
+    (make-fuzzy-set (into {} (for [x entries] [x (min (a x) (b x))]))))
+)
+
+(defn fuzzy-union [a b]
+  "Computes the union of fuzzy sets."
+  (let [a-entries (set (map first a))
+        b-entries (set (map first b))
+        entries (set/union a-entries b-entries)]
+    (make-fuzzy-set (into {} (for [x entries] [x (max (a x) (b x))]))))
+)
+
+(defn fuzzy-difference [a b]
+  "Computes the difference of fuzzy sets."
+  (let [a-entries (set (map first a))
+        b-entries (set (map first b))
+        entries (set/union a-entries b-entries)]
+    (make-fuzzy-set (into {} (for [x entries] [x (max 0 (- (a x) (b x)))]))))
+)
+
+(defn fuzzy-subsets [mvalues fset]
+  "Receives a collection of membership degrees and a fuzzy set as arguments.
+   Returns all fuzzy subsets of the supplies fuzzy sets that are generated by
+   combining each element with each membership degree lesser or equal to its 
+   original membership degree in the supplied fuzzy set."
+  (let [mvalues (sort mvalues),
+        fset (seq (make-fuzzy-set fset)),
+        max-values (vec (map second fset)),
+        crisp-base (map first fset)]
+    (map #(make-fuzzy-set (zipmap crisp-base %))
+         (apply comb/cartesian-product
+                (for [i (range (count fset))]
+                  (take-while #(<= % (nth max-values i)) mvalues)))))
+)
+
+(defn fuzzy-subset? [fset1 fset2]
+  "Verifies whether *fset1* is a fuzzy subset of *fset2*."
+  (forall [k (keys (fuzzy-set-to-hashmap fset1))]
+    (<= (fset1 k)
+        (fset2 k)))
+)