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

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

/* ========================================================================== */
/*                                                                            */
/*  LEAR                : Relational learning of first order clauses          */
/*                        from positive ambiguous examples                    */
/*                                                                            */
/*  IMPORTANT           : set the variable environnement LEAR_DIR             */
/*                        with the path where LEAR is installed               */
/*                                                                            */
/* -------------------------------------------------------------------------- */
/*  Date                : 25/02/14                                            */
/* -------------------------------------------------------------------------- */
/*  Author              : Dominique BOUTHINON (db@lipn.univ-paris13.fr)       */            
/*                        LIPN Universite Paris 13 (France)                   */
/* -------------------------------------------------------------------------- */
/*  History:                                                                  */
/*   - ajout factorisation de tables                                          */
/*     (il est possible qu'un atome soit present dans toutes les possibilites */
/*      d'une meme table. ex) [[a,b],[a,c]] qu'on peut factoriser par         */
/*      [[a]] x [[b],[c]]. Mais attention : on perd le fait que a, b, et c    */
/*      sont lies                                                             */
/*      (25/02/14)												   */
/*   - add the completion of intentional examples according to the observed   */
/*     frequencies of known facts in the examples                             */
/*     (11/01/14)												   */
/*   - add the possibility to number the negative examples by starting        */
/*     by number 1 (this option is to deal with old files)                    */
/*     (12/04/2013)                                                           */
/*   - add the coverage factor and the possibility to take into account       */
/*     the coverage (versus compatibility) in the guidance function           */
/*     (12/04/2013)                                                           */
/*   - every example is represented by its sets of maximal and minimal        */
/*	    possibilities					                                 */
/*     (8/02/2013)                                                            */
/*   - stop the beam search taking into account the minimum acceptable number */
/*     of errors (option -Y)                                                  */
/*     (4/11/12)                                                              */	
/*   - possibility to accept conjunction with p% of error of negative ex      */
/*     (option -p)                                                            */
/*     (2/11/12)                                                              */		
/*  - Add the possibility to compute the extensional examples                 */
/*    using negation by failure (so there is no  ambiguity)                   */
/*    (29/10/12)                                                              */
/*  - We garantee that there is a solution once as seed compatible- with      */
/*    the negative examples is found.                                         */
/*    This implies changes in the specialization process                      */
/*    (23/10/12)                                                              */               
/*  - deep change of the compability+ relation (which becomes faster)         */
/*    (13/10/12)                                                              */
/*  - add true head of clauses (not a simulation by tables)                   */
/*    and have modified wrong compatibility relation                          */
/*    (13/07/12)                                                              */
/*  - option --force_oi : when it is true all variables of the seed are       */
/*    considered under OI, so the seed is less general, and the space search  */
/*    is smaller.                                                             */
/*    (16/06/12)                                                              */
/*  - option 'a' : possibility to choose between a simple guidance            */
/*    (ratio of well classed examples) or an average guidance (average of     */
/*      positive and negative guidances)                                      */
/*    (10/06/12)                                                              */
/*  - put again the checking of the seed again the negative examples          */
/*    (7/06/12)                                                               */
/*  - bias allowing to discard facts of examples that are not sufficiently    */
/*    linked to the arguments of the target predicate                         */
/*    (30/05/12)                                                              */
/*  - quand l'option linked est active, on peut ajouter des atoms non liés    */
/*    a l'hypothese courante, en créant un lien                               */
/*    (19/04/2012)                                                            */                                                 
/*  - train and test examples are no more in the same module                  */
/*      (22/10/11)                                                            */
/*  - wathever example file can be used as a test file.                       */
/*    (IMPORTANT : due to a swi prolog problem about module, always choose    */ 
/*     a name for the test file distinct than the name of the train file)     */              
/*     (22/10/11)                                                             */
/*  - possibility to use negation by failure to build extensional             */  
/*      complete examples (option -X)                                         */
/*    (12/10/11)                                                              */
/*  - possibility to learn from n train files and one test file               */
/*    (08/07/11)                                                              */   
/*  - possibility to build range-restricted hypotheses                        */
/*    (20/11/10)                                                              */
/*  - make a test file from an examples file                                  */
/*    (19/11/10)                                                              */
/*  - one distinguishes two constants having the same value but having        */
/*    two different types                                                     */
/*    (23/10/10)                                                              */
/*  - possibility to substitute a variable under OI with a constant           */
/*    (18/10/2010)                                                            */ 
/*  - add precision, recall and fmeasure (24/08/2010)                         */
/*  - separate names for file of examples and file of background              */
/*     (18/08/2010)                                                           */
/*  - seed : constant under OI in two distinct tables of the seed             */
/*     must be represented by the same variable :                             */
/*     ex) [[p(a)]] x [[q(a)]] => [[p(X)]] x [[q(X)]]                         */
/*  - clausal form of examples (21/01/10)                                     */
/*  - partial object identity based on types (26/02/09)                       */
/*  - test on non ambiguous examples.                                         */
/*  - Width of beam is dynamically enlarged when there is no solution.        */
/*  - modification of comp- and updates negative assumptions (16/02/2009)     */
/*  - discard positive examples taken as seeds, when they cover at least one  */
/*    negative example.                                                       */
/*    (22/04/2009)                                          			   */
/*  - partial object identity based on types                                  */
/*    (26/02/09)                                                              */
/*  - Width of beam is dynamically enlarged when there is no solution.        */
/*  - modification of comp- and updates negative assumptions                  */
/*    (16/02/2009)                                                            */
/* ========================================================================== */

 
/* ============================== DIRECTIVES ================================ */

:- 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)).

									% first called goal
:- initialization top.

/* ============================== PARAMETERS ================================ */

		     % number of additional tries to improve an acceptable hypothesis
nb_max_tries('1').

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

	/* top goal of the swipl script */
top :-
    swi_prolog_init,
    modules_initialization,
    command_lines_options,
    call_program,
    halt(0).


	/* set swi prolog options */
swi_prolog_init :-
   set_prolog_flag(autoload, true),
   set_prolog_flag(unknown,error),          % intended behaviour (do not modify)
   set_prolog_flag(verbose_load,false),     % load silently
   set_prolog_flag(debugger_print_options,
                   [quoted(true),max_depth(10),attributes(portray)]),
   set_prolog_flag(debug_on_error,true).

 
   /* modules called */            
modules_initialization :-
   getenv('LEAR_DIR', Lear),
   atom_concat(Lear, '/counter.pl', Count),
   use_module(Count),
   atom_concat(Lear, '/options.pl', Options),
   use_module(Options), 
   atom_concat(Lear, '/formated_writing.pl', Format),
   use_module(Format),
   atom_concat(Lear, '/lear10.pl', Lear10),
   use_module(Lear10),
   atom_concat(Lear, '/times.pl', Times),
   use_module(Times),
   atom_concat(Lear, '/utilities_lear11.pl', Utils),
   use_module(Utils),
   atom_concat(Lear, '/completion2.pl', Completion),
   use_module(Completion).
  
/* ================ check what program the user asked and run it ============ */

		% build extensional ambiguous examples
call_program :-
   current_option(examples, File_ex_int),
   file_name_ok(File_ex_int),
   !,
   current_option(background, File_bk_int),
   check_file(File_bk_int, '-B'),
   check_negation_by_failure_option(Negation),
   build_extensional_examples(File_ex_int, File_bk_int, Negation).
   
		% numbers intentional ambiguous examples
call_program :-
   current_option(numbers_negative_examples, File_int),
   file_name_ok(File_int),
   !,
   current_option(background, File_int_bkg),
   check_file(File_int_bkg, '-B'),
   current_option(output_file, File_out),
   check_file(File_out, '-o'),
   numbers_negative_intentional_examples(File_int, File_int_bkg, File_out). 

		% complete intentional ambiguous examples
call_program :-
   current_option(complete_examples, File_int),
   file_name_ok(File_int),
   !,
   current_option(background, File_bk_int),
   check_file(File_bk_int, '-B'),
   current_option(output_file, File_out),
   check_file(File_out, '-o'),
   complete_intentional_examples(File_int, File_bk_int, File_out). 

		% completion of intentional ambiguous examples
call_program :-
   current_option(completion_examples, File_int),
   file_name_ok(File_int),
   !,
   current_option(background, File_bk_int),
   check_file(File_bk_int, '-B'),
   current_option(output_file, File_out),
   check_file(File_out, '-o'),
   completion_intentional_examples(File_int, File_bk_int, File_out). 


		% learn
call_program :-
   check_options,
   call_learn,
   finish.

check_options :-
   check_acceptable_errors_option,
   check_stop_beam_search_option,
   check_guidance_option,
   check_force_oi_option,
   check_compatibility_weight_option.


check_compatibility_weight_option :-
   current_option(compatibility_weight, Fa),
   atom_number(Fa, F),
   check_range_option(compatibility_weight, F, 0, 1),
   learn:assert(compatibility_weight(F)).


check_acceptable_errors_option :-
   current_option(acceptable_errors, Pa),
   atom_number(Pa, P),
   learn:assert(acceptable_errors(P)).


check_stop_beam_search_option :-
   current_option(nb_max_tries, Na),
   atom_number(Na, N),
   learn:assert(nb_max_tries(N)).

        
check_guidance_option :-
   current_option(average_guidance, true),
   !,
   learn:assert(guidance(average)).


check_guidance_option :-
   learn:assert(guidance(simple)).


check_force_oi_option :-
   current_option(force_oi, true),
   !,
   learn:assert(force_oi(true)).

check_force_oi_option :-
   learn:assert(force_oi(false)).


check_negation_by_failure_option(true) :-
   current_option(negation_by_failure, true),
   !.

check_negation_by_failure_option(false).
              

	/* check if the Value of the Option is a number between Min and Max */
check_range_option(_Option, Value, Min, Max) :-
   Value >= Min,
   Value =< Max,
   !.

check_range_option(Option, Value, Min, Max) :-
   nl,
   writeln('!!!!!!!!!!'),
   write('the value '),
   write(Value),
   write(' given for the option '),
   write(Option),
   write(' is not valid. It must be between '),
   write(Min),
   write(' and '),
   writeln(Max),
   writeln('!!!!!!!!!!'),
   nl,
   fail.

           
        /* check if the user have entered a file name ('' if no file entered) */
file_name_ok('') :-
   !,
   fail.
   
file_name_ok(_).         
   
   
	   /* check the presence of a file */   
check_file(FileName, _Option) :-
   file_name_ok(FileName),
   !.
   
check_file(_FileName, Option)   :-
   write('this option is mandatory in this context : '),
   writeln(Option),
   !,
   fail.
    
   
check_positive_number(N, _Option) :-
   N > 0,
   !.
   
check_positive_number(N, Option) :-
   write('the option '),
   write(Option),
   write(' needs a positive number, you gave : '),
   writeln(N).


	/* retract asserted facts */
finish :-
   retractall(learn:guidance(_)),
   retractall(learn:force_oi(_)),
   retractall(learn:guidance(_)),
   retractall(learn:acceptable_errors(_)),
   retractall(learn:stop_beam_search(_)).
    

/* ==========================  call learning ================================ */
 

	/* learning with N train files and one test file */   
call_learn :-
   current_option(n_train_test, File_train),
   file_name_ok(File_train),
   !,
   current_option(test, File_test),
   check_file(File_test, '-u'),

   current_option(number, Na),
   atom_number(Na, N),
   check_positive_number(N, '-N'),

   get_basic_options(Verbose, Beam_width, L),
   learn:assert(verbosity(Verbose)), 
   learn:assert(level_discard(L)),
   n_train_test(File_train, File_test, N, Beam_width), 
   learn:retractall(verbosity(_)).   
           
call_learn :-
   current_option(file, File_ex),		% learn from examples with this file
   file_name_ok(File_ex),  
   !,
   call_learn(File_ex).   


call_learn(File_ex) :- 
    get_basic_options(Verbose, Beam_width, L),
    learn:assert(verbosity(Verbose)), 
    learn:assert(level_discard(L)),
    statistics(cputime, Time1),
    call_learning_process(Beam_width, File_ex),
    statistics(cputime, Time2),
    Duration is round(Time2-Time1),
    nl,
    write('elapsed time : '),
    display_duration(Duration),
    nl,
    learn:retractall(verbosity(_)).


				/* cross validation (inside swipl) or simple train-test */
call_learning_process(Beam_width, File_ex) :- 
       current_option(test, File_test),
       file_name_ok(File_test),
       !,
       current_option(cross_validation, Nb_folds1),
       atom_number(Nb_folds1, Nb_folds),
       choose_learning(Nb_folds, File_ex, File_test, Beam_width).
      

				/* simple one fold learn, without test */
call_learning_process(Beam_width, File_ex) :-  
       set_learn_mode(train),                                                          
       learn(File_ex, Beam_width, _), % by default one fold learn without test
       retract_learn_mode.       


choose_learning(1 , File_train, File_test, Beam_width) :-
   !,                                                  % just one fold
   current_option(excel, File_excel), 
   learn_test(File_train, File_test, File_excel, Beam_width).

choose_learning(Nb_folds, File_train, File_test, Beam_width) :-
    train_test_validation(File_train, File_test, Nb_folds, Beam_width).


/* ========================= OPTIONS HANDING ================================ */       

get_basic_options(Verbose, Beam_width, Level_discards) :-
    current_option(beam, Beam_width1),        % width of the beam 
    atom_number(Beam_width1, Beam_width),
    current_option(verbose, V1),              % verbosity
    atom_number(V1, Verbose),
    current_option(discard_facts, Level_discards). % level of links between
                                                   % atom of the seed and
                                                   % argument of the target   
    
command_lines_options :-

		  set_flag_option(
                        set_option(negation_by_failure, true), 
                        set_option(negation_by_failure, false),
                        [
                          short('N'), 
                          long('N'),
                          help('compute extensional examples using negation by failure (no ambiguity)')
                        ]
                       ), 

        set_flag_option(
                        set_option(negative_multi_tables, true), 
                        set_option(negative_multi_tables, false),
                        [
                          short(z), 
                          long(z),
                          help('to learn with negative multi_tables (not implemented yet)')
                        ]
                       ), 
                                
        set_flag_option(
                        set_option(linked_clauses, true), 
                        set_option(linked_clauses, false),
                        [
                          short(l), 
                          long(linked_clauses),
                          help('consider only linked clauses as hypotheses')
                        ]
                       ),

		   set_flag_option(
                        set_option(average_guidance, true), 
                        set_option(average_guidance, false),
                        [
                          short('a'), 
                          long(average_guidance),
                          help('guidance is the average between positive and negative guidances')
                        ]
                       ),
           
		  
		  set_flag_option(
                        set_option(force_oi, true), 
                        set_option(force_oi, true),
                        [
                          short('O'), 
                          long(force_oi),
                          help('all variables of the seed are considered under OI')
                        ]
                       ),	
               
        set_file_option(set_option(file), set_option(file,''),
                        [short(f),
								 long(file),
        help('learn from <fileName>.bkg (background) and <fileName>.pl (examples)')]),
         
        set_file_option(set_option(n_train_test), set_option(n_train_test,''),
                        [short(n),
                        long(n_train_test),
                        help('lear with n (see option -n) train files and one test file (see option -g)')]),  

		set_file_option(set_option(completion_examples), set_option(completion_examples,''),
                        [short('Y'),
                         long(complete_certain),
                         help('completion of the intentional file <fileName>.int using certain data (options -B and -o are mandatory)')]), 
         
        set_file_option(set_option(complete_examples), set_option(complete_examples,''),
                        [short('X'),
                         long(complete),
                         help('complete the intentional file <fileName>.int using negation by failure (options -B and -o are mandatory)')]), 

           
        set_file_option(set_option(numbers_negative_examples), set_option(numbers_negative_examples,''),
                        [short(m),
                         long(numbers),
                         help('numbers negative examples by starting by number 1 (options -B and -o are mandatory)')]),         


        set_file_option(set_option(examples), set_option(examples,''),
                        [short(e),
                         long(example),
                        help('build extensional examples from intentionsal ones contained in <fileName>.int')]),  
                        
         set_file_option(set_option(output_file), set_option(output_file,''),
                        [short(o),
                         long(output),
                        help('<fileName> is the name of the outputfile for the current operation')]),                  
        
        set_file_option(set_option(excel), set_option(excel,''),
                       [
                        short(g),
                        long(excel),
                        help('file containing results for excel')
                       ]),
      
        set_file_option(set_option(background), set_option(background,''),
                       [
                        short('B'),
                        long(background),
                        help('file containing background knowledge')
                       ]),
        
        set_file_option(set_option(test), set_option(test,''),
                       [
                        short(u),
                        long(test),
                        help('file containing complete test examples (see options -f et -n)')
                       ]),

	   	set_attribute_option(
                          set_option(compatibility_weight), 
					      set_option(compatibility_weight, '1'),
                        	 [
						      short('j'),
                              long(compatibility_weight),
						      help('weight of the contribution of the compatible but not covered positive examples ([0,1])')
                          ]
                         ),  	 

	    	set_attribute_option(
                          set_option(discard_facts), 
					           set_option(discard_facts, 0),
                        	 [
						short('D'),
						long(discard),
                        		help('discard facts of the seed that are not linked (at level at most D)')
                          ]
                         ),  	 
                   
        nb_max_tries(Max),

        set_attribute_option(
                        set_option(nb_max_tries), 
                        set_option(nb_max_tries, Max),
                        [
                          short('k'), 
                          long(nb_tries),
                          help(' stop the beam search after N tries to improve an acceptable best hypothesis ') ]
                       ),	

	     set_attribute_option(set_option(acceptable_errors), 
                             set_option(acceptable_errors, '0.0'),
                             [short(p),long(error),
                             help('accept that p% of the negative examples are not compatible with the hypothesis')]), 	
       
        set_attribute_option(set_option(min_coverage), set_option(min_coverage, '1.0'),
                             [short(d),long(min_coverage),
                             help('stop the beam search whenever a conjunction is comp- with E- and comp+ with d% of the remaining E+ ')]), 
             
        set_attribute_option(set_option(beam), set_option(beam, '5'),
                             [short(w),long(width),
                             help('beam of width <value> (3 by default)')]),   
                             
        set_attribute_option(set_option(verbose), set_option(verbose, '0'),
                             [short(v),long(verbose),
                             help('<value> is the verbosity level (0 (default), 1, 2 or 3)')]), 
                             
        set_attribute_option(set_option(cross_validation), set_option(cross_validation, '1'),
                             [short(c),long(cross),
                             help('<value> cross validation')]),                     
                                                 
         set_attribute_option(set_option(number), set_option(number, '1'),
                             [short('I'),long('I'),
                             help('an integer value (default 1)')]),                                
                                                                                                        
        set_help_header('Usage: lear [OPTIONS] ~2nDescription:~n'),
        parse_options(_).

/* ================================= END OF LISTING ========================= */
   
