#! /usr/bin/swipl
% (home + travail)

% #! /usr/local/bin/swipl
% (magi)

/* ========================================================================== */ 
/*                        DISCARD INTENTIONAL NOISED COMPLETE EXAMPLES        */
/*					 (the incompatibility is checked only against	   */
/*                         positive litteral (atoms)                          */	
/*                        Dominique BOUTHINON (db@lipn.univ-paris13.fr)       */
/*                        10/02/14                                            */  
/* ========================================================================== */

:- set_prolog_flag(verbose, silent).
												% stacks
:- set_prolog_stack(local,  limit(10**9)).  	% 1 Go
:- set_prolog_stack(global, limit(10**9)).	
:- set_prolog_stack(trail,  limit(10**9)).


:- initialization goal.

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

goal :-
        gtrace,
        get_arguments(File_int, Background_file, File_int2),
	   discard_noise(File_int, Background_file, File_int2).
 
get_arguments(File_int, Background_file, File_int2) :-
        current_prolog_flag(argv, Argv),
        append(_, [File_int, Background_file, File_int2], Argv).

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

   /* create a file containing positive and negative examples */
discard_noise(
               File_int,          % file (int) containing noised  
                                  % intensional examples
               Background_file,   % file (int_bkg) containing 
                                  % background knowledge
               File_int2          % name of the output file (int) containing 
                                  % non noised intentional examples
             ) :- 
    
   writeln('discard noise is running...'),

   active_modules,
   initialization_op,

   atom_concat(Background_file,'.int_bkg', Background_file1),
   bk:consult(Background_file1),
   get_the_examples(File_int, LPos, LNeg),

   init,
  
   writeln('discarding noised examples...'),
   discard_noised_examples(LPos, LNeg, LPos1, LNeg1),

   writeln('writing files...'),
   write_files(File_int2, LPos1, LNeg1),
   writeln('finished'),
   halt(0).


       /* declare the needed operators in background knowledge file */
initialization_op :-
        bk:(op(900, xfy, <=)),
        bk:(op(900, xfy, <-)),
        bk:(op(900, fx, <-)),
        bk:(op(850, xfy, or)),
        bk:(op(850, xfy, and)).


        /* needed modules */
active_modules :-
   getenv('LEAR_DIR', Lear),
   atom_concat(Lear, '/intentional_data.pl', Int_data),
   use_module(Int_data),
   atom_concat(Lear, '/file.pl', File),
   use_module(File),
   atom_concat(Lear, '/utilities_lear11.pl', Utils),
   use_module(Utils),
   atom_concat(Lear, '/formated_writing.pl', Format),
   use_module(Format),
   atom_concat(Lear, '/domains.pl', Domains),
   use_module(Domains),
   atom_concat(Lear, '/manage_examples2.pl', Manage),
   use_module(Manage),
   atom_concat(Lear, '/compatibility5.pl', Comp),
   use_module(Comp).


init :-
   set_learn_mode(train),
   get_types(LTypes),
   bk:assert(types(LTypes)),

   bk:types_instantiable(LTypes_instantiable),
   subtract(LTypes, LTypes_instantiable, LTypes_not_instantiable),
   bk:assert(types_not_instantiable(LTypes_not_instantiable)),
 
   build_list_types_under_oi,
   set_types_not_under_oi,
   build_list_types_not_under_oi,
                     
   findall(Atom, (bk:mode(Atom) ; bk:target_mode(Atom)), LAtoms), 
   discard_plus_atoms(LAtoms, LAtoms1),
   build_atoms_types(LAtoms1).


/* ========================= DISCARD NOISED EXAMPLES ======================== */  

discard_noised_examples(LPos, LNeg, LPos_comp, LNeg_comp) :-
   check_compatibility(LPos, LNeg, LPosA, LNegA),
   discard_the_noised_examples(LPosA, LNegA, LPos_comp, LNeg_comp).
   

discard_the_noised_examples(LPos, LNeg, LPos_comp_out, LNeg_comp_out) :-

   split_compatible_examples(LPos, LPos_comp, LPos_not_comp),
   split_compatible_examples(LNeg, LNeg_comp, LNeg_not_comp),

   incompatibility(LPos_comp, LPos_not_comp,
                   LNeg_comp, LNeg_not_comp,
                   LPos_comp_out, LNeg_comp_out).


	/* no longer incompatibility */
incompatibility(LPos_comp, [], LNeg_comp, [], LPos_comp, LNeg_comp) :-
   !.

	/* there are incompatibilities */
incompatibility(LPos_comp, LPos_not_comp,
                LNeg_comp, LNeg_not_comp,
                LPos_comp_out, LNeg_comp_out) :-

   get_max_incompatibility(LPos_not_comp, 0, [], Max_pos, LMax_pos),
   get_max_incompatibility(LNeg_not_comp, 0, [], Max_neg, LMax_neg),

   (
     Max_neg >= Max_pos
      -> discard_max_incompatible_examples(LMax_neg, 
                                           LNeg_not_comp,  LPos_not_comp, 
                                           LNeg_not_comp1, LPos_not_comp1)
      ;  discard_max_incompatible_examples(LMax_pos, 
                                           LPos_not_comp,  LNeg_not_comp, 
                                           LPos_not_comp1, LNeg_not_comp1)
   ),

   discard_the_noised_examples(LPos_not_comp1, LNeg_not_comp1, 
                               LPos_comp1, LNeg_comp1),

   append(LPos_comp, LPos_comp1, LPos_comp_out),
   append(LNeg_comp, LNeg_comp1, LNeg_comp_out).



   /* discard examples having the maximal number of incompatibilities */

discard_max_incompatible_examples(_LNum, [], LExB, [], LExB) :-
   !.

discard_max_incompatible_examples(
                   LNum, 
                   [ex(Num, _Ex, _Target, _Domains, _Lnot_comp)|LExA],
                   LExB, 
                   LExA1, 
                   LExB1
                                 ) :-
   member(Num, LNum),
   !,
   update_examples(LExB, Num, LExB2),
   discard_max_incompatible_examples(LNum, LExA, LExB2, LExA1, LExB1).

discard_max_incompatible_examples(
                   LNum, 
                   [Ex|LExA],
                   LExB, 
                   [Ex|LExA1], 
                   LExB1
                                 ) :-
   discard_max_incompatible_examples(LNum, LExA, LExB, LExA1, LExB1).

   
	/* discard Num inside the list of incompatibilities of each example */
update_examples([], _Num1, []) :-
   !.

update_examples(
                [ex(Num, Ex, Domains, Target, Lnot_comp)|LEx], 
                 Num1, 
                [ex(Num, Ex, Domains, Target, Lnot_comp1)|LEx1]) :-
   select(Num1, Lnot_comp, Lnot_comp1),
   !,
   update_examples(LEx, Num1, LEx1).

update_examples(
                [Ex|LEx], 
                 Num1, 
                [Ex|LEx1]) :-
   update_examples(LEx, Num1, LEx1).

	
	/* get the examples being incompatible with the max number of examples
      of the other label */

get_max_incompatibility([], Max, LMax, Max, LMax) :-
   !.

get_max_incompatibility([ex(Num, _Ex, _Domains, _Target, Lnot_comp)|LEx], 
                         Max_so_far, LMax_so_far,
                         Max, LMax) :-
   length(Lnot_comp, N),
   check_max(LEx, Num, N, Max_so_far, LMax_so_far, Max, LMax).


	/* */
check_max(LEx, Num, N, Max_so_far, _LMax_so_far, Max, LMax) :-
   N > Max_so_far,
   !,
   get_max_incompatibility(LEx, N, [Num], Max, LMax).

check_max(LEx, Num, N, Max_so_far, LMax_so_far, Max, LMax) :-
   N >= Max_so_far,
   !,
   get_max_incompatibility(LEx, N, [Num|LMax_so_far], Max, LMax).

check_max(LEx, _Num, _N, Max_so_far, LMax_so_far, Max, LMax) :-
   get_max_incompatibility(LEx, Max_so_far, LMax_so_far, Max, LMax).


	/* return the list of incompatibilities of the current example */
get_incompatibilities(ex(_Num, _Body, _Domains, _Head, Lnot_comp), Lnot_comp).


	/* split the set of examples between examples having no incompatibility
      and examples having incompatibilities */

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

split_compatible_examples([Ex|LEx], [Ex|LEx_comp], LEx_not_comp) :-
   get_incompatibilities(Ex, []),
   !,                       
   split_compatible_examples(LEx, LEx_comp, LEx_not_comp).

split_compatible_examples([Ex|LEx], LEx_comp, [Ex|LEx_not_comp]) :-
   split_compatible_examples(LEx, LEx_comp, LEx_not_comp).

 
/* ===== CHECK THE COMPATIBLITY BETWEEN POSITIVE AND NEGATIVE EXAMPLES ====== */ 

check_compatibility([], LNeg_out, [], LNeg_out) :-
   !.

check_compatibility([Pos|LPos], LNeg, [Pos1|LPos_out], LNeg_out) :-
   Pos = ex(Num, Body, _Domains, Head, _Lnot_comp),
   writeln(Num),
   discard_negative_literals(Body, Body_no_neg),
   Clause = [Head|Body_no_neg],
   put_ex_tables(Clause, Clause_t), 
   variabilize_example(not_instantiable, Clause_t, [], VClause_t),
   put_tables_ex(VClause_t, VClause),
   VClause = [VHead|VBody],
   VClause_duo = (VHead, VBody),
   
   check_compatibility_one_example(LNeg, Pos, VClause_duo, Pos1, LNeg1),
   check_compatibility(LPos, LNeg1, LPos_out, LNeg_out).


	/* check the compatibility between the variabilize positive example 
      VPos against negative ones */
check_compatibility_one_example([], Pos_out, _VPos, Pos_out, []) :-
   !.

	% VPos is compatible- with the current negative example
check_compatibility_one_example(
     [ex(Num_neg, Body_neg, Domains_neg, Head_neg, Lnot_comp_neg)|LNeg], 
     Pos, 
     VPos,
     Pos_out, 
     [ex(Num_neg, Body_neg, Domains_neg, Head_neg, Lnot_comp_neg)|LNeg_out] 
                                ) :-
    discard_negative_literals(Body_neg, Body_neg_atoms),
    compatible_neg(neg, VPos, Num_neg, Head_neg, [Body_neg_atoms]),
    !,
    check_compatibility_one_example(LNeg, Pos, VPos, Pos_out, LNeg_out).

   % VPos is not compatible- with the current negative example
check_compatibility_one_example(
     [ex(Num_neg, Body_neg, Domains_neg, Head_neg, Lnot_comp_neg)|LNeg], 
     ex(Num_pos, Body_pos, Domains_pos, Head_pos, L_not_comp_pos), 
     VPos,
     Pos_out, 
     [ex(Num_neg, Body_neg, Domains_neg, Head_neg, 
         [Num_pos|Lnot_comp_neg])|LNeg_out] 
                                ) :-
    write(' --- '),
    writeln(Num_neg),
    Pos1 = ex(Num_pos, Body_pos, Domains_pos, Head_pos, 
              [Num_neg|L_not_comp_pos]), 
    check_compatibility_one_example(LNeg, Pos1, VPos, Pos_out, LNeg_out).


	/* put an example into a table format */
put_ex_tables([], []) :-
   !.

put_ex_tables([X|L], [[[X]]|L1]) :-
   put_ex_tables(L, L1).

	/* put an example in table format in a classic format */
put_tables_ex([], []) :-
   !.

put_tables_ex([[[X]]|L], [X|L1]) :-
   put_tables_ex(L, L1).


	/* discard the negative literals of a list of literals */
discard_negative_literals([], []) :-
   !.

discard_negative_literals([neg(_Atom)|Lliterals], LAtoms) :-
   !,
   discard_negative_literals(Lliterals, LAtoms).

discard_negative_literals([Atom|Lliterals], [Atom|LAtoms]) :-
   discard_negative_literals(Lliterals, LAtoms).

/* =========================== GET THE EXAMPLES ============================= */

get_the_examples(File_int, LPos, LNeg) :-

   atom_concat(File_int, '.int', File_int1),
   train:consult(File_int1),

   get_positive_examples(LPos),
   get_negative_examples(LNeg).


get_positive_examples(LPos) :-
   findall(
           ex(N, Ex, Domains, Target, []), 
           (
             train:pos(N,Ex),  
             train:domains(N, pos, Domains),
             train:target(N, pos, Target)
           ),
           LPos
           ).
   
get_negative_examples(LNeg) :-
  findall(
           ex(N, Ex, Domains, Target, []), 
           (
             train:neg(N,Ex),  
             train:domains(N, neg, Domains),
             train:target(N, neg, Target)
           ),
           LNeg
           ).

/* ========================= WRITE THE RESULTING FILE ======================= */

write_files(File, LPos, LNeg) :-

   atom_concat(File, '.int', File_out),
   open(File_out, write, Out),

   good_format(LPos, LPos1),
   good_format(LNeg, LNeg1),
 
   write(Out, ':- style_check(-discontiguous).'),
   nl(Out),

         	/* write a list of intentional ambiguous examples */
   write_intentional_examples_domains_targets(1, LPos1, pos, Out),
   write_intentional_examples_domains_targets(1, LNeg1, neg, Out),
                      
   close(Out).


/* translate examples in a good writing format */
good_format([], []) :-
   !.

good_format([ex(_N, Body, Domains, Head, [])|LEx], 
            [(Body, Domains, Head)|LEx1]) :-
   good_format(LEx, LEx1).
                
/* ============================== END OF LISTING ============================ */   
