2 people like it.
Like the snippet!
Formal Concept Analysis
Formal Concept Analysis (FCA) is a method to determine cohesive groupings of functions and data structures, especially in program comprehension research. For example, consider an object set, O = {1,2,3,4,5,6,7,8,9,10}, and an attribute set, A = {composite,even,odd,prime,square}, we can build a lattice table that holds the relations between O and A.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
|
module FCA =
// Define the Attribute type
type Attribute =
| Composite
| Even
| Odd
| Prime
| Square
// Create a set of attributes
let attributeSet = set [Composite; Even; Odd; Prime; Square]
// Create a set of objects
let objSet = set [1 .. 10]
// Filter out a composite object set
let composite objSet =
let factor n =
let rec find i =
if i>=n then false
elif (n % i = 0) then true
else find (i + 1)
find 2
objSet |> Set.filter(fun i -> factor i)
// Filter out an even object set
let even objSet =
objSet |> Set.filter(fun i -> i%2=0)
// Filter out an odd object set
let odd objSet =
objSet |> Set.filter(fun i -> i%2<>0)
// Filter out a prime object set
let prime objSet =
objSet |> composite |> Set.difference objSet |> Set.remove 1
// Filter out a square object set
let square objSet =
let findSqure n =
let rec find i =
if i > n then false
elif (n = i * i) then true
else find (i + 1)
find 1
objSet |> Set.filter(fun i -> findSqure i)
// Build a set of concept pairs
let conceptPairs attSet objSet =
attSet |> Set.map(fun attr ->
match attr with
| Composite as c -> (c, composite objSet)
| Even as e -> (e, even objSet)
| Odd as o -> (o, odd objSet)
| Prime as p -> (p, prime objSet)
| Square as s -> (s, square objSet)
)
// Helper
let transAttr attSet =
attSet |> Set.map(fun attr ->
match attr with
| Composite -> "C"
| Even -> "E"
| Odd -> "O"
| Prime -> "P"
| Square -> "S"
)
// Create a unmarked working table
let allocate (objSet: Set<int>) (attSet: Set<Attribute>) =
let row = objSet.Count
let col = attSet.Count
let tableLatt = Array2D.create (row+1) (col+1) " "
tableLatt
|> Array2D.iter(fun _ ->
objSet |> Set.toArray |> Array.iteri(fun i item->
tableLatt.[i+1, 0] <- string item)
attSet |> transAttr |> Set.toArray |> Array.iteri(fun i item ->
tableLatt.[0, i+1] <- item
)
)
tableLatt
// Construct the lattice table
let lattTable (objSet: Set<int>) (attSet: Set<Attribute>) =
let row = objSet.Count
let workingTable = allocate objSet attSet
let conceptPairsSet = conceptPairs attSet objSet
workingTable
|> Array2D.iteri(fun i _ _ ->
let objArr =
conceptPairsSet |> Set.toArray |> Array.map(fun (x, y) -> y) |> Array.map Set.toArray
objArr |> Array.iteri(fun ind arr ->
arr |> Array.iteri(fun indx _ ->
for i in 1 .. row do
if arr.[indx] = i then
workingTable.[i,ind+1] <- "X"
else
()
)))
workingTable
// Show the lattice table as the result, "X" indicates there is a concept
// e.g., 9 is Composite, Odd and Square number
printfn "%A" (lattTable objSet attributeSet)
(*
[[" "; "C"; "E"; "O"; "P"; "S"]
["1"; " "; " "; "X"; " "; "X"]
["2"; " "; "X"; " "; "X"; " "]
["3"; " "; " "; "X"; "X"; " "]
["4"; "X"; "X"; " "; " "; "X"]
["5"; " "; " "; "X"; "X"; " "]
["6"; "X"; "X"; " "; " "; " "]
["7"; " "; " "; "X"; "X"; " "]
["8"; "X"; "X"; " "; " "; " "]
["9"; "X"; " "; "X"; " "; "X"]
["10"; "X"; "X"; " "; " "; " "]]
val it : unit = ()
*)
|
type Attribute =
| Composite
| Even
| Odd
| Prime
| Square
Full name: Script.FCA.Attribute
union case Attribute.Composite: Attribute
union case Attribute.Even: Attribute
union case Attribute.Odd: Attribute
union case Attribute.Prime: Attribute
union case Attribute.Square: Attribute
val attributeSet : Set<Attribute>
Full name: Script.FCA.attributeSet
val set : elements:seq<'T> -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.set
val objSet : Set<int>
Full name: Script.FCA.objSet
val composite : objSet:Set<int> -> Set<int>
Full name: Script.FCA.composite
val objSet : Set<int>
val factor : (int -> bool)
val n : int
val find : (int -> bool)
val i : int
Multiple items
module Set
from Microsoft.FSharp.Collections
--------------------
type Set<'T (requires comparison)> =
interface IComparable
interface IEnumerable
interface IEnumerable<'T>
interface ICollection<'T>
new : elements:seq<'T> -> Set<'T>
member Add : value:'T -> Set<'T>
member Contains : value:'T -> bool
override Equals : obj -> bool
member IsProperSubsetOf : otherSet:Set<'T> -> bool
member IsProperSupersetOf : otherSet:Set<'T> -> bool
...
Full name: Microsoft.FSharp.Collections.Set<_>
--------------------
new : elements:seq<'T> -> Set<'T>
val filter : predicate:('T -> bool) -> set:Set<'T> -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.filter
val even : objSet:Set<int> -> Set<int>
Full name: Script.FCA.even
val odd : objSet:Set<int> -> Set<int>
Full name: Script.FCA.odd
val prime : objSet:Set<int> -> Set<int>
Full name: Script.FCA.prime
val difference : set1:Set<'T> -> set2:Set<'T> -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.difference
val remove : value:'T -> set:Set<'T> -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.remove
val square : objSet:Set<int> -> Set<int>
Full name: Script.FCA.square
val findSqure : (int -> bool)
val conceptPairs : attSet:Set<Attribute> -> objSet:Set<int> -> Set<Attribute * Set<int>>
Full name: Script.FCA.conceptPairs
val attSet : Set<Attribute>
val map : mapping:('T -> 'U) -> set:Set<'T> -> Set<'U> (requires comparison and comparison)
Full name: Microsoft.FSharp.Collections.Set.map
val attr : Attribute
val c : Attribute
val e : Attribute
val o : Attribute
val p : Attribute
val s : Attribute
val transAttr : attSet:Set<Attribute> -> Set<string>
Full name: Script.FCA.transAttr
val allocate : objSet:Set<int> -> attSet:Set<Attribute> -> string [,]
Full name: Script.FCA.allocate
Multiple items
val int : value:'T -> int (requires member op_Explicit)
Full name: Microsoft.FSharp.Core.Operators.int
--------------------
type int = int32
Full name: Microsoft.FSharp.Core.int
--------------------
type int<'Measure> = int
Full name: Microsoft.FSharp.Core.int<_>
val row : int
property Set.Count: int
val col : int
val tableLatt : string [,]
module Array2D
from Microsoft.FSharp.Collections
val create : length1:int -> length2:int -> value:'T -> 'T [,]
Full name: Microsoft.FSharp.Collections.Array2D.create
val iter : action:('T -> unit) -> array:'T [,] -> unit
Full name: Microsoft.FSharp.Collections.Array2D.iter
val toArray : set:Set<'T> -> 'T [] (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.toArray
module Array
from Microsoft.FSharp.Collections
val iteri : action:(int -> 'T -> unit) -> array:'T [] -> unit
Full name: Microsoft.FSharp.Collections.Array.iteri
val item : int
Multiple items
val string : value:'T -> string
Full name: Microsoft.FSharp.Core.Operators.string
--------------------
type string = System.String
Full name: Microsoft.FSharp.Core.string
val item : string
val lattTable : objSet:Set<int> -> attSet:Set<Attribute> -> string [,]
Full name: Script.FCA.lattTable
val workingTable : string [,]
val conceptPairsSet : Set<Attribute * Set<int>>
val iteri : action:(int -> int -> 'T -> unit) -> array:'T [,] -> unit
Full name: Microsoft.FSharp.Collections.Array2D.iteri
val objArr : int [] []
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []
Full name: Microsoft.FSharp.Collections.Array.map
val x : Attribute
val y : Set<int>
val ind : int
val arr : int []
val indx : int
val i : int32
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
More information