#! /usr/bin/swipl -q -G1g -L1g -T1g -t main -s
% (home)

% #! /usr/local/bin/lib/swipl-5.11.34/bin/x86_64-linux/swipl -q -G1g -L1g -T1g -t main -s
% (travail)


/* ========================================================================== */ 
/*                  CONVERT ALEPH FORMAT TO LEAR format (int)                 */
/*                  (les exemples LEAR sont les exemples ALEPH,               */
/*                   le background LEAR est le background ALEPH               */
/*                   aucune notion de cle)                                    */
/*                  Attention : utilities_lear9 et 10 ne sont pas adaptés !   */
/*               (les domaines de valeurs sont ceux apparaissant dans les     */
/*                exemples uniquement. Ils ne tiennent pas compte des valeurs */
/*                apparaissant dans la théorie du domaine)                    */
/* ========================================================================== */

:- op(850, xfy, and).

main :-
        catch(goal, E, (print_message(error, E), fail)),
        halt.

main :-
        halt(1).

goal :-
        get_arguments(File_train, File_bkg, File_lear),
	     convert(File_train, File_bkg, File_lear).
 
get_arguments(File_train, File_bkg, File_lear) :-
        current_prolog_flag(argv, Argv),
        append(_, [--|[File_train, File_bkg, File_lear]], Argv).

/* =========================== TRANSLATION OF EXAMPLES ====================== */

   /* create a file containing positive and negative incomplete examples 
      in a Lear format */
convert(
		   File_train,    % train examples
		   File_bkg, 	   % background knowledge
		   File_lear	   % name of the ouptut file (with lear format)
	    ) :- 
    active_modules,
    consult_data(File_train, File_bkg),
    aleph_to_lear(File_lear).  
 

	/* get all defined user predicates of the background knowledge */  
aleph_to_lear(File_lear) :-

   get_examples(LPos, LNeg),

   get_types_concept(LTypes_concept1),
   sort(LTypes_concept1, LTypes_concept),    % mandatory : do not discard
   get_mode_concept(Concept),
   write_lear_examples(File_lear, LPos, LNeg, Concept, LTypes_concept),
   
   get_head(Head_concept), 
   get_background(LBackground),
   write_lear_background(File_lear, Head_concept, LBackground).
  
/* ================== READ EXAMPLES AND BACKGROUND KNOWLEDGE ================ */  
    
get_examples(LPos, LNeg) :-
   get_head_concept(Concept),
   build_examples(Concept, pos, LPos),
   build_examples(Concept, neg, LNeg).  


	/* get the types of the arguments of the target concept */
get_types_concept(LTypes) :-
   get_head(Concept1),
   discard_plus_minus([Concept1], [Concept]),
   Concept =..[_|LTypes].


get_mode_concept(Concept) :-
   get_head(Concept1),
   discard_plus_minus([Concept1], [Concept]).


get_head(Concept) :-
  bkg:current_predicate(modeh/2),
  !,
  bkg:modeh(_, Concept).

get_head(Concept) :-
  bkg:modeh(Concept).

	/* get head examples and predicates used in hypotheses */
get_head_concept(Head_concept) :-
  get_head(Concept),
  functor(Concept, Name, Arity),
  functor(Head_concept, Name, Arity).


	/* build examples from heads and facts using LPredicates */
build_examples(Head_ex, Label, LEx) :-
   findall(Head_ex, Label:Head_ex, LEx).


	/* build the background knowledge */
get_background(LBackground) :-
   get_predicates(LPredicates),
   get_clauses(LPredicates, LBackground).

   
	/* get all predicates of the module bkg coming from the file FileName */
get_predicates(LPredicates) :-
   findall(
            Predicate, 
            current_predicate(bkg:Predicate), 
            LPredicates1
          ),
   discard_irrelevant_predicates(LPredicates1, LPredicates).

discard_irrelevant_predicates(LPredicates1, LPredicates) :-   
   (
      bkg:current_predicate(modeh/2)
      -> discard(modeh/2, LPredicates1, LPredicates2)
      ;  discard(modeh/1, LPredicates1, LPredicates2)
   ),
   discard(listing/1, LPredicates2, LPredicates3),
   discard(consult/1, LPredicates3, LPredicates4),
   discard(current_predicate/1, LPredicates4, LPredicates5),
   discard(types_identifiers/1, LPredicates5, LPredicates).


discard(Pred, LPred, LPred_out) :-
   select(Pred, LPred, LPred_out),
   !.

discard(_Pred, LPred_out, LPred_out).


	/* get clauses corresponding to the Predicates in the module bkg */
get_clauses([], []) :-
   !.

get_clauses([Pred|LPred], LClauses) :-
   get_clauses_one_pred(Pred, LClauses1),
   get_clauses(LPred, LClauses2),
   append(LClauses1, LClauses2, LClauses).


	/* get all clauses of the given Predicates in the module bkg */
get_clauses_one_pred(Pred/Arity, LClauses) :-
   functor(Predicate, Pred, Arity),
   findall(Predicate :- Body, clause(bkg:Predicate,Body), LClauses1),
   transform_clauses(LClauses1, LClauses).

 
	/* discard "true" in the clauses of the form 'Head :- true' */
transform_clauses([], []) :-
   !.

transform_clauses([Head :- true|LClauses], [Head|LClauses1]) :-
   !,
   transform_clauses(LClauses, LClauses1).

transform_clauses([Clause|LClauses], [Clause|LClauses1]) :-
      transform_clauses(LClauses, LClauses1).

/* ========================================================================== */

 	/* gather all modes in a list */
get_modes(LModes) :-
   get_the_modes(LModes1),
   discard_plus_minus(LModes1, LModes).

get_the_modes(LModes) :-
   bkg:current_predicate(modeb/2),
   !,
   findall(Mode, bkg:modeb(_, Mode), LModes).

get_the_modes(LModes) :-
   findall(Mode, bkg:modeb(Mode), LModes).


discard_plus_minus([], []) :-
   !.

discard_plus_minus([Mode|LModes], [Mode1|LModes1]) :-
   discard_plus_minus_one_mode(Mode, Mode1),
   discard_plus_minus(LModes, LModes1).


discard_plus_minus_one_mode(Mode, Mode1) :-
   Mode=..[Pred|LArgs],
   discard_plus_minus_args(LArgs, LArgs1),
   Mode1=..[Pred|LArgs1].

discard_plus_minus_args([], []) :-
   !.

discard_plus_minus_args([Arg|LArgs], [Arg1|LArgs1]) :-
   discard_plus_minus_one_arg(Arg, Arg1),
   discard_plus_minus_args(LArgs, LArgs1).

discard_plus_minus_one_arg(+Arg, Arg) :-
   !.

discard_plus_minus_one_arg(-Arg, Arg) :-
   !.

discard_plus_minus_one_arg(Arg, Arg).


	/* discard - from arguments */
discard_minus([], []) :-
   !.

discard_minus([Mode|LModes], [Mode1|LModes1]) :-
   discard_minus_one_mode(Mode, Mode1),
   discard_minus(LModes, LModes1).


discard_minus_one_mode(mode(Mode), mode(Mode1)) :-
   Mode=..[Pred|LArgs],
   discard_minus_args(LArgs, LArgs1),
   Mode1=..[Pred|LArgs1].

discard_minus_args([], []) :-
   !.

discard_minus_args([Arg|LArgs], [Arg1|LArgs1]) :-
   discard_minus_one_arg(Arg, Arg1),
   discard_minus_args(LArgs, LArgs1).


discard_minus_one_arg(-Arg, Arg) :-
   !.

discard_minus_one_arg(Arg, Arg).


	/* gather all types present in LModes in a list */
get_types([], []) :-
   !.

get_types([Mode|LModes], LTypes) :-
   Mode=..[_|LTypes1],
   get_types(LModes, LTypes2),
   append(LTypes1, LTypes2, LTypes).
   

/* ======================== WRITTING BACKGROUND KNOWLEDGE =================== */

write_lear_background(File, Target, LBackground) :-

   get_modes_from_background(LBackground, LBackground1, LModes),
   discard_minus(LModes, LModes1),
   discard_plus_minus([Target], [Target1]),

   atom_concat(File, '.int_bkg', File1),
   open(File1, write, Stream),

   write(Stream, ':- style_check(-discontiguous).'), 
   nl(Stream),
   nl(Stream),

   write_target(Target1, Stream),
   nl(Stream),
   nl(Stream),

   write_modes(LModes1, Stream),
   nl(Stream),
   nl(Stream),

   write_misc(Stream),
   nl(Stream),
   nl(Stream),

   write_background(LBackground1, Stream),
   nl(Stream),
   close(Stream).


	/* extracts the modes from the background knowledge */
get_modes_from_background([], [], []) :-
   !.

get_modes_from_background(
                          [modeb(_, Mode)|LBackground], 
                          LBackground1, 
                          [mode(Mode)|LModes]
                         ) :-
   !,
   get_modes_from_background(LBackground,  LBackground1, LModes).

get_modes_from_background(
                          [modeb(Mode)|LBackground], 
                          LBackground1, 
                          [mode(Mode)|LModes]
                         ) :-
   !,
   get_modes_from_background(LBackground,  LBackground1, LModes).

get_modes_from_background(
                          [Atom|LBackground], 
                          [Atom|LBackground1], 
                          LModes
                         ) :-
   get_modes_from_background(LBackground,  LBackground1, LModes).
           

   /* write pieces of information relative to the target concept */
write_target(Target, Stream) :-
   discard_plus_minus([Target], [Target1]),
   functor(Target, Name, Arity),
   functor(Target1, Name, Arity),
   fwrite_point_ln(Stream, target_relation(Target1)),
   fwrite_point_ln(Stream, target_mode(Target)).


	/* write the modes on the current stream */
write_modes([], _Stream) :-
   !.

write_modes([Mode|LModes], Stream) :-
	fwrite_point_ln(Stream, Mode),
   write_modes(LModes, Stream).


	/* write miscellenaous pieces of information */
write_misc(Stream) :-
   fwrite_point_ln(Stream, types_instantiable([])),
   nl(Stream),
   fwrite_point_ln(Stream, types_under_oi([])),
   nl(Stream),
   fwrite_point_ln(Stream, non_abducible_predicates([])),
   nl(Stream),
   fwrite_point_ln(Stream, irrelevant([])).

	
	/* write the background knowledge on the current stream */
write_background(LClauses, Stream) :-
   fwrite_ln(Stream, 'background_knowledge(['),
   write_clauses(LClauses, Stream),
   fwrite_point_ln(Stream, '])').


	/* write a list of clauses with the LEAR format on the current stream */
write_clauses([], _Stream) :-
   !.

write_clauses([Clause], Stream) :-
  !,
  write_one_clause(Clause, Stream).

write_clauses([Clause|LClauses], Stream) :-
   write_one_clause(Clause, Stream),
   fwrite_ln(Stream, ','),
   write_clauses(LClauses, Stream).

	/* write a clause with the LEAR format the current stream */
write_one_clause(:- Body, Stream) :-
   !,
   convert(Body, Body1),
   fwrite(Stream,' <- '),
   fwrite(Stream, Body1).

write_one_clause(Head :- Body, Stream) :-
   !,
   convert(Body, Body1),
   fwrite(Stream, Head),
   fwrite(Stream, ' <- '),
   fwrite(Stream, Body1).

write_one_clause(Head, Stream) :-
   fwrite(Stream, Head).


	/* convert elements separated with commas by elements separated by "and" */
convert(','(A,B), A and B1) :-
  !,
  convert(B, B1).

convert(A, A).

/* ==============================  WRITTING EXAMPLES ======================== */

write_lear_examples(
                     File,
                     LPos, 
                     LNeg,
                     Mode_head,
                     LTypes_concept
                     ) :- 

   atom_concat(File, '.int', File1),
   open(File1, write, Stream),

   write(Stream, ':- style_check(-discontiguous).'), 
   nl(Stream),

   reset_count(nb_examples),
   write_examples(pos, LPos, Mode_head, LTypes_concept, Stream),

   nl(Stream),
   nl(Stream),

   reset_count(nb_examples),
   write_examples(neg, LNeg, Mode_head, LTypes_concept, Stream),
   
   close(Stream).


write_examples(_Label, [], _Mode_head, _LTypes_concept, _Stream) :-
   !.

write_examples(Label, [Head|LHead], Mode_head, LTypes_concept, Stream) :-
   write_one_example(Label, Mode_head, Head, LTypes_concept, Stream),
   write_examples(Label, LHead, Mode_head, LTypes_concept, Stream).


/* write the current example in lea format */ 
write_one_example(Label, Mode_head, Head, LTypes_concept, Stream) :-
  get_count(nb_examples, N),
  fwrite(Stream, Label),
  write(Stream, '('),
  write(Stream, N),
  write(Stream,','),
  nl(Stream),
  fwrite_list(Stream, []),
  fwrite_point_ln(Stream, ')'),
  nl(Stream),
  fwrite_point_ln(Stream, target(N, Head)),
  write_domains(Stream, N, LTypes_concept, Mode_head, Head),
  nl(Stream),
  nl(Stream).
  
  
write_domains(Stream, N, LTypes_concept, Mode_head, Head) :-
  get_domains(LTypes_concept, Mode_head, Head, LDomains),
  write(Stream, 'domains('),
  write(Stream, N),
  write(Stream, ','),
  fwrite_list(Stream, LDomains),
  write(Stream, ').').
  

	/* get values of types in the example Ex */  
get_domains([], _Mode_head, _Head, []) :-
   !.
	
get_domains([Type|LTypes], Mode_head, Head, [Domain|LDomains]) :-
   get_values_type(Type, Mode_head, Head, LValues),
   sort(LValues, LValues1),
   not_empty(LValues1),
   !,
   Domain=..[Type|[LValues1]],
   get_domains(LTypes, Mode_head, Head, LDomains).
   
get_domains([_Type|LTypes], Mode_head, Head, LDomains) :-
    get_domains(LTypes, Mode_head, Head, LDomains).
         

	/* get all values of the given type in the example Ex */	
get_values_type(Type, Mode_head, Head, LValues) :-
   Mode_head =..[Pred|LArgs],
   get_indices(1, Type, LArgs, LIndices),
   length(LArgs, N),
   functor(Mode_head1, Pred, N), 
   get_values(LIndices, Mode_head1, Head, LValues).
   
   
	/* get indices in list L of occurrences of X */  
get_indices(_N, _X, [], []) :-
   !.
	
get_indices(N, X, [X|L], [N|LIndices]) :-
   !,
   N1 is N+1,
   get_indices(N1, X, L, LIndices).
   
get_indices(N, X, [_|L], LIndices) :-
   N1 is N+1,
   get_indices(N1, X, L, LIndices).
   

	/* get all values of arguments placed in positions given by LIndices */  
get_values([], _Mode, _Head, []) :-
   !.
	
get_values([Indice|LIndices], Mode, Head, LValues) :-
   findall(Value, (Mode=Head, arg(Indice, Mode, Value)), LValues1),
   get_values(LIndices, Mode, Head, LValues2),
   append(LValues1, LValues2, LValues).
     
write_atoms(_Stream, []) :-
   !.
   
write_atoms(Stream, [A|L]) :-   
  fwrite_point_ln(Stream, A),
  write_atoms(Stream, L).
  

/* ==================== ACTIVE MODULES and CONSULT DATA ===================== */
 
active_modules :-
   getenv('LEAR_DIR', Lear),
   atom_concat(Lear, '/file.pl', File),
   use_module(File),

   atom_concat(Lear, '/counter.pl', Counter),
   use_module(Counter),  

   atom_concat(Lear, '/list.pl', List),
   use_module(List),
   
   atom_concat(Lear, '/term.pl', Term),
   use_module(Term).


consult_data(File_train, File_bkg) :-
   		% consult positive examples
   atom_concat(File_train, '.f', File_train_pos),
   pos:consult(File_train_pos),
   
		% consult negative examples
   atom_concat(File_train, '.n', File_train_neg),
   neg:consult(File_train_neg),
  
		% consult background knowledge
   atom_concat(File_bkg, '.b', File_bkg1),
   bkg:consult(File_bkg1).
   
     
/* ============================== END LISTING =============================== */   
   
