<commit_before>:- module(
  bordat,
  [
    generate_hasse/1 % +ContextName:atom
  ]
).

/** <module> Bordat

@author <NAME>
@version 2015/10
*/

:- use_module(library(apply)).
:- use_module(library(fca/fca_concept)).
:- use_module(library(fca/fca_context)).
:- use_module(library(lists)).
:- use_module(library(ordsets)).

%! concept(?ContextName:atom, ?Concept:compound) is nondet.

:- dynamic(concept/2).

%! edge(?ContextName:atom, ?Parent:compound, ?Child:compound) is nondet.

:- dynamic(edge/3).

%! parent(?ContextName:atom, ?Parent:compound) is nondet.

:- dynamic(parent/2).





%! generate_hasse(+ContextName:atom) is det.

generate_hasse(ContextName):-
  retract_hasse(ContextName),
  context_attributes(ContextName, As),
  powerset(As, PowersetAs),
  generate_hasse(ContextName, As, PowersetAs).



%! generate_hasse(
%!   +ContextName:atom,
%!   +Attributes:ordset,
%!   +PowersetAttributes:ordset(ordset)
%! ) is det.

% Done!
generate_hasse(_, _, []):- !.
% New parent concept: calculate its child concepts.
generate_hasse(ContextName, As, [ParentAs|ParentsAs]):-
  % Make sure the given subset of attributes denotes a parent concept.
  PartialConcept = concept(_,ParentAs),
  concept(ContextName, PartialConcept, Parent),
  \+ parent(ContextName, Parent), !,
  assert(parent(ContextName, Parent)),

  generate_children(ContextName, As, ParentAs, Children1),

  % Exclude the parent itself from the children, if it appears.
  exclude(==(Parent), Children1, Children2),

  % Only children that were not previously generated
  % are asserted and added to the processing stack.
  exclude(concept(ContextName), Children2, NewChildren),
  maplist(assert_concept(ContextName), [Parent|NewChildren]),

  % For all children an edge with the parent is asserted.
  maplist(assert_edge(ContextName, Parent), Children2),

  generate_hasse(ContextName, As, ParentsAs).
% Not a new parent concept: simply skip.
generate_hasse(ContextName, As, [_|ParentsAs]):-
  generate_hasse(ContextName, As, ParentsAs).



%! generate_children(
%!   +ContextName:atom,
%!   +Attributes:ordset,
%!   +ParentAttributes:ordset,
%!   -Children:list(compound)
%! ) is det.

generate_children(ContextName, As, ParentAs, Children):-
  ord_subtract(As, ParentAs, NewAs),
  findall(
    Child,
    (
      member(NewA, NewAs),
      % Find the minimal extension to the parent's attribute set
      % that respects the complete pair property.
      ord_add_element(ParentAs, NewA, PartialChildAs),
      a2o(ContextName, PartialChildAs, ChildOs),
      o2a(ContextName, ChildOs, ChildAs),
      Child = concept(ChildOs,ChildAs)
    ),
    Children
  ).





% HELPERS %

%! assert_concept(+ContextName:atom, +Concept:compound) is det.

assert_concept(ContextName, Concept):-
  assertz(concept(ContextName, Concept)).



%! assert_edge(+ContextName:atom, +Parent:compound, +Child:compound) is det.

assert_edge(ContextName, Parent, Child):-
  assertz(edge(ContextName, Child, Parent)).



%! retract_hasse(+ContextName:atom) is det.

retract_hasse(ContextName):-
  retractall(concept(ContextName, _)),
  retractall(edge(ContextName, _, _)),
  retractall(parent(ContextName, _)).<commit_msg>CHANGED: Rewrote Bordat's algorithm to no longer use assertions.<commit_after>:- module(
  bordat,
  [
    generate_hasse/2 % +Context:compound
                     % -Hasse:ugraph
  ]
).

/** <module> Bordat

Bordat's algorithm for calculating FCA lattices.

@author <NAME>
@version 2015/10
*/

:- use_module(library(apply)).
:- use_module(library(fca/fca_concept)).
:- use_module(library(graph/s/s_graph)).
:- use_module(library(lambda)).
:- use_module(library(lists)).
:- use_module(library(set/set_ext)).





%! generate_hasse(+Context:compound, -Hasse:ugraph) is det.

generate_hasse(context(Os,As,I), G):-
  powerset(As, PowAs),
  generate_hasse(context(Os,As,I), [], Vs, [], Es, [], PowAs),
  s_graph_components(G, Vs, Es).


%! generate_hasse(
%!   +Context:compound,
%!   +Vertices:list(compound),
%!   -AllVertices:list(compound),
%!   +Edges:list(pair(compound)),
%!   -AllEdges:list(pair(compound)),
%!   +ParentHistory:ordset(compound),
%!   +Powerset:list(ordset)
%! ) is det.

generate_hasse(_, Vs, Vs, Es, Es, _, []):- !.
generate_hasse(context(Os,As,I), Vs1, Vs, Es1, Es, Parents, [SubAs|SubAss]):-
  concept(context(Os,As,I), concept(_,SubAs), concept(ParentOs,ParentAs)),
  \+ memberchk(concept(ParentOs,ParentAs), Parents), !,
  generate_children(context(Os,As,I), SubAs, Children1),
  exclude(==(concept(ParentOs,ParentAs)), Children1, Children2),
  exclude(\Concept^member(Concept, Vs1), Children2, Children3),
  % Preserve concepts [concept(ParentOs,ParentAs)|Children3].
  append(Vs1, [concept(ParentOs,ParentAs)|Children3], Vs2),
  % Preserve edges between concept(ParentOs,ParentAs) and Children3.
  maplist(pair(concept(ParentOs,ParentAs)), Children3, NewEs),
  append(Es1, NewEs, Es2),
  generate_hasse(
    context(Os,As,I),
    Vs2,
    Es2,
    [concept(ParentOs,ParentAs)|Parents],
    SubAss
  ).
generate_hasse(Context, Vs0, Vs, Es0, Es, Parents, [_|PowAs]):-
  generate_hasse(Context, Vs0, Vs, Es0, Es, Parents, PowAs).


generate_children(context(Os,As,I), SubAs, Children):-
  ord_subtract(As, SubAs, NewAs),
  findall(
    Child,
    (
      member(NewA, NewAs),
      % Find the minimal extension to the parent's attribute set
      % that respects the complete pair property.
      ord_add_element(SubAs, NewA, ChildAs0),
      a2o(context(Os,As,I), ChildAs0, ChildOs),
      o2a(context(Os,As,I), ChildOs, ChildAs),
      Child = concept(ChildOs,ChildAs)
    ),
    Children
  ).
{'fraction_non_alphanumeric': 0.15101091429593846, 'fraction_numerical': 0.008946144211844694, 'mean_word_length': 4.934182590233545, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6919104', 'n_tokens_mistral': 2043, 'n_tokens_neox': 1947, 'n_words': 379}