1% ------------------------------------------------
    2% October 2001
    3% Author: Brian Ross
    4% Dept. of Computer Science, Brock University
    5
    6?- dynamic seed_P/2.    7?- dynamic recog_flag/1.    8
    9% GP Control Parameters
   10% ---------------------------
   11% fitness_func_P(F) 	- F is file name containing fitness function.
   12%			  Should have a function called evaluator/2. It sets
   13%			  standardized fitness scores.
   14% dctg_file_P(F) 	- F is file name containing DCTG grammar 
   15% population_size_P(I,N) - size (initial, final) of GP population 
   16%			 - final is culled from initial
   17% cull_method_P(T)       - T=tournament or elite
   18% max_runs_P(R,Type,Gen) - total number R of runs; max generations Gen per run
   19%			  Type = limit: run to R, even if soln found
   20%			  Type = solution: run to R, but stop when soln
   21% prob_grow_P		- during ramped init population gen, this is 
   22%			  probability a 'grow' tree is attempted
   23% prob_crossover_P 	- probability of crossover mating 
   24%			  prob mutation = 1 - prob cross
   25% reprod_P(T) 		- # tries for crossover
   26% prob_internal_crossover_P - probability that crossover happens on an internal
   27%			  node in 1 parent; set to 'no' otherwise
   28% prob_terminal_mutation_P - probability that mutation is on a terminal node; 
   29%			   set to 'no' otherwise
   30% max_depth_P(I,C)	- I = max depth of initial generated indiv's, 
   31%			  C = maximum depth permitted in offspring
   32%		  Make sure I is large enough, or else generation will stall.
   33% error_tolerance_P	- wrt evaluation, tolerance for correct solns.
   34% tournament_size_P(S,R) - # entries in tournament selection S and 
   35%			  replacement R
   36% lamarckian_P(P, K, Select, ProbCross) - do Lamarkian evol on 
   37%			  P % of population, 
   38%			  K = # iterations for best-first search
   39%			  Select = {best, worst, random} selection 
   40%			  If P=1.0, then Select is irrelevant.
   41%			  ProbCross is prob crossover (vs mutation)
   42% unique_population_P(no) - no/yes: children added to popn should be unique 
   43%			  (doesn't affect genesis population however)
   44% trace_limit_P(U,T)	- stops interpretation when this many unique/total
   45%			  traces have been obtained (turn off = (0,0) )
   46%			  if arg 1 = deterministic, then only 1 soln
   47% rep_limit_P(X)	- if >0, X is max recursion depth for ! repetition
   48%			  0 = unlimited repetition
   49% simplify_P(yes)	- if 'yes', then offspring are simplified
   50%			  before added to population
   51% seed_P(X,Y)		- if X = default, then default random cycle
   52%		  if X = random, then system timer used to initialize 
   53%		  (Y set by program to seeds used, for reinit later)
   54%                 X=manual means Y = (A, B, C) are seed integers 1...30,000
   55:- dynamic(debug_set_P/1).   56% debug_set_P(yes): for additional debug printing, if implemented
   57% popn_dump_P(no)	- if yes, then population dumped at end of each gen
   58% gen_type_P(T)		- generation type: T = steadystate, separate
   59% evaluator_reset_P(P, G)- if G=no, ignore; else call P every G-th generation
   60% reprod_verif_P(T)	- if yes, then each reproduced Tree has its DCTG code
   61%			  executed, to verify it wrt embedded Prolog code; 
   62% user_args_P(_)	- list of user args for executing dctg calls 
   63%			  make sure it has # members of what DCTG expects!
   64% dctg_root_P(Root)	- root nonterminal of DCTG 
   65% dctg_override_P(Term, Nonterm). - user override of terminal, nonterminal 
   66%			  designation for rules; done for entire nonterm set
   67% mutation_range_P(R)	- range to mutate SRE numeric values
   68% sre_mintestcnt_P(M)   - minimum count for test set entries
   69% gen_set_size_P(S)	- initial size of generated grammar test set
   70% min_grammar_prob_P(P) - minimum prob for grammar recognition to continue
   71% min_skip_prob_P(P).	- min prob for skipping to continue
   72% unique_guards_P(yes)  - if yes, guards in choice are unique; otherwise not.
   73% elite_migrate_P(N, R)	- if gen_type=separate, then N best individuals 
   74%		  migrate to next generation; if R=yes, then reeval fitness
   75% negsetsize_P(S) 	- number negative examples to generate
   76% eval_with_ID_P(T)	- T=yes then include expr ID in call to evaluator
   77%			  	else don't include
   78
   79
   80wd_P('/pack/narsese/prolog/sre_dna/').
   81
   82fitness_func_P('reg_gram_1.pl').
   83dctg_file_P('sre3.pl').
   84
   85population_size_P(750, 500).	% <-- 750, 500
   86cull_method_P(elite).		% <-- tournament
   87max_runs_P(1, solution, 50).	% <-- 5, solution, 35
   88prob_grow_P(0.50).		% <-- 0.25
   89prob_crossover_P(0.9).        % <-- 0.90
   90reprod_P(3). 			% <-- 3
   91prob_internal_crossover_P(0.90). % <-- 0.90 or no
   92prob_terminal_mutation_P(0.75). % <-- 0.75 or no
   93max_depth_P(10, 17).		% <-- 6, 17
   94error_tolerance_P(0).		% <-- 0.000001
   95tournament_size_P(4, 4).	% <-- 2, 3
   96lamarckian_P(0.0,10, best, 0.1). % <-- 0.25, 10, best, 0.20; (0.0,...) = off
   97% lamarckian_P(0.25, 10, best, 0.20). 
   98unique_population_P(yes).	% <-- no
   99trace_limit_P(0, 0).		% <-- (40, 90) 
  100rep_limit_P(2).			% <-- 3
  101max_string_length_P(20).	% <-- 10
  102seed_P(random, (_,_,_)).	% <-- random, (_,_,_)
  103popn_dump_P(no).			% <-- no	
  104gen_type_P(steadystate).	% <-- steadystate
  105evaluator_reset_P(generate_testset,100).	% <-- no
  106reprod_verif_P(no).		% <-- yes
  107user_args_P([]).			% <-- eg. [], [_] or [_|_] if arity 0, 1 or 2
  108dctg_root_P(expr).		%
  109dctg_override_P([], []).	% <-- [], []
  110mutation_range_P(0.1). 		% <-- was 0.025
  111sre_mintestcnt_P(2).		% <-- 2
  112gen_set_size_P(1000).		% <-- 250
  113min_grammar_prob_P(1.0e-4).	% <-- 1.0e-4
  114min_skip_prob_P(1.0e-4).	% <-- 1.0e-4
  115unique_guards_P(no).		% <-- yes
  116elite_migrate_P(0, no).		% <-- 10
  117negsetsize_P(30).			% <-- 75
  118eval_with_ID_P(no).		% <-- no