2%******************************************************************************
    3%*
    4%*
    5%*  This file describes the learning operators of miles called by xmiles
    6%*  when a specific button is pressed 
    7%*
    8%*
    9%******************************************************************************
   10
   11 
   12
   13   
   14%******************************************************************************
   15%*
   16%*        groups(<list of groups>).
   17%*
   18%******************************************************************************
   19
   20groups([preprocess,g1,g2,gencon,lgg,refinement,evaluation,truncation]). 
   21
   22
   23
   24%******************************************************************************
   25%*
   26%*        groupdef(<groupname>,<buttonname-list>). 
   27%*
   28%******************************************************************************
   29
   30groupdef(preprocess,['argument types','clause heads','flatten kb','flatten rules',
   31	'unflatten kb']).
   32groupdef(g1,['g1 op','apply g1',identify,absorb,'inv derivate',
   33	'most spec v',saturate,'elem saturate']).
   34groupdef(g2,['intraconstruct 1','intraconstruct 2','g2 op','apply g2']).
   35groupdef(gencon,['learn constrained', 'learn foil', 'learn rul']).
   36groupdef(lgg,['gen msg',rlgg,lgg,'headed lgg','nr lgg',gti]).
   37groupdef(refinement,['unify vars','instantiate vars','add body lit','new predicate']).
   38groupdef(evaluation,['correct check','complete check','evaluate examples',fp,
   39	  'covered examples']).
   40groupdef(truncation,[reduce,'unconnected','redundant','flat redundant','unconnecting',
   41         'negation based','flat negation based','facts']).
   42         
   43
   44
   45
   46%******************************************************************************
   47%*
   48%*         operatordef(<buttonname>,<operatorname>,<in-out-pattern>,
   49%*	               <in-type-checks>,<out-display-functions>,
   50%*	               <refresh-list>,).  
   51%*
   52%******************************************************************************
   53
   54operatordef('argument types',argument_types,[],[],[],[rules]).
   55operatordef('clause heads',clause_heads,[],[],[],[rules]).
   56operatordef('flatten kb',flatten_kb,[],[],[],[rules]).
   57operatordef('flatten rules',flatten_rules,[],[],[],[rules]).
   58operatordef('unflatten kb',unflatten_kb,[],[],[],[rules]).
   59
   60operatordef('g1 op',g1_op,[xmarg1,xmarg2,xmout1],[isRule,isRule],
   61	    [resultAddRule],[]).
   62operatordef('apply g1',apply_g1,[xmarg1,xmout1],[isRule],
   63	    [resultAddRuleList],[]).
   64operatordef(identify,identify,[xmarg1,xmarg2,xmout1],[isExOrRule,true],
   65	    [resultAddRule],[]).
   66operatordef(absorb,absorb,[xmarg1,xmarg2,xmout1],[isExOrRule,isExOrRule],
   67	    [resultAddRule],[]).
   68
   69operatordef('inv derivate',inv_derivate,[xmarg1,xmout1],[isExOrRule],
   70	    [resultAddRule],[]).
   71operatordef('most spec v',most_spec_v,[xmarg1,xmarg2,xmout1],
   72	    [isExOrRule,isExOrRule],[resultAddRule],[]).
   73operatordef(saturate,saturate,[xmarg1,xmout1,xmoptdepth],[isExOrRule,isDepth],
   74	    [resultAddRule],[]).
   75operatordef('elem saturate',elem_saturate,[xmarg1,xmarg2,xmout1],
   76	    [isExOrRule,true],[resultAddRule],[]).
   77
   78operatordef('intraconstruct 1',intra_construct1,
   79	     [xmarg1,xmarg2,xmout1,xmout2,xmout3],
   80	     [isRule,isRule],[resultAddRule,resultAddRule,resultAddRule],[]).
   81operatordef('intraconstruct 2',intra_construct2,
   82	    [xmarg1,xmarg2,xmout1,xmout2,xmout3],
   83	    [isRule,isRule],[resultAddRule,resultAddRule,resultAddRule],[]).
   84operatordef('g2 op',g2_op,[xmarg1,xmarg2,xmout1,xmout2,xmout3],
   85	    [isRule,isRule],[resultAddRule,resultAddRule,resultAddRule],[]).
   86operatordef('apply g2',apply_g2,[xmarg1,xmarg2,xmout1,xmout2,xmout3],
   87	    [isRule,isRule],[resultAddRule,resultAddRule,resultAddRule],[]).
   88
   89operatordef('learn constrained', learn_constrained,[],[],[],[rules]).
   90operatordef('learn foil', learn_foil,[],[],[],[rules]).
   91operatordef('learn rul', learn_rul,[],[],[],[rules]).
   92
   93
   94operatordef('gen msg',gen_msg,[xmarg1,xmarg2,xmout1],[isRule,isRule],
   95	    [resultAddRule],[]).
   96operatordef(rlgg,rlgg,[xmarg1,xmarg2,xmout1],[isRule,isRule],[resultAddRule],[]).
   97operatordef(lgg,lgg,[xmarg1,xmarg2,xmout1],[isRule,isRule],[resultAddRule],[]).
   98operatordef('headed lgg',headed_lgg,[xmarg1,xmarg2,xmout1],[isRule,true],
   99	    [resultAddRule],[]).
  100operatordef('nr lgg',nr_lgg,[xmarg1,xmarg2,xmout1],[isRule,isRule],
  101	    [resultAddRule],[]).
  102operatordef(gti,gti,[xmarg1,xmarg2,xmout1],[isRule,isRule],
  103	    [resultAddRule],[]).
  104
  105operatordef('unify vars',refinement_unify_variables,[xmarg1,xmout1],
  106            [isRule],[resultAddSpec],[]).
  107operatordef('instantiate vars',refinement_instantiate_variables,[xmarg1,xmout1],
  108            [isRule],[resultAddSpec],[]).
  109operatordef('add body lit',refinement_add_body_literal,[xmarg1,xmout1],
  110            [isRule],[resultAddSpec],[]).
  111operatordef('new predicate',specialize_with_newpred,[xmarg1,xmout1],
  112            [isRule],[resultAddNewpreds],[]).
  113
  114operatordef('correct check',correct_chk,[],[],[],[]).
  115operatordef('complete check',complete_chk,[],[],[],[]).
  116operatordef('evaluate examples',eval_examples,[],[],[],[]).
  117operatordef(fp,fp,[xmout1],[],[resultSelectRules],[]).
  118operatordef('covered examples',all_covered_examples,[xmout1],[],[resultSelectExamples],[]).
  119
  120operatordef(reduce,reduce_complete,[xmarg1],[isRule],[],[rules]).
  121operatordef('unconnected',truncate_unconnected,[xmarg1],[isRule],[],[rules]).
  122operatordef('redundant',truncate_r,[xmarg1],[isRule],[],[rules]).
  123operatordef('flat redundant',truncate_flat_r,[xmarg1],[isRule],[],[rules]).
  124operatordef('unconnecting',truncate_unconnecting,[xmarg1],[isRule],[],[rules]).
  125operatordef('negation based',truncate_neg_based,[xmarg1],[isRule],[],[rules]).
  126operatordef('flat negation based',truncate_flat_neg_based,[xmarg1],[isRule],[],[rules]).
  127operatordef('facts',truncate_facts,[xmarg1],[isRule],[],[rules])