1% DCTG based tree generation for GP
    2% Brian Ross
    3% January, 1999
    4
    5% generate_tree(TopGoal, TreeType, MaxDepth, UserArgs, Tree, Expr):
    6%	TopGoal - name of top of tree to generate
    7%	TreeType - either grow or full
    8%	MaxDepth - maximum depth of tree
    9%	UserArgs - list of user-specified args to use in top of rule
   10%	Tree - Resulting tree, in DCTG node structure
   11%	Expr - DCTG expression list equivalent of Tree 
   12%
   13% Generates a tree of Type and max Depth, with UserArgs used in head of rule.
   14% With the node structure of Tree, it should be possible to access all
   15% semantic rules. Any embedded Prolog in DCTG definition of rules is executed
   16% as tree is generated; this permits Expr to be constructed. This means 
   17% that user must ensure embedded Prolog goals will execute correctly.
   18% The node structure inserted into call has it's ID removed, to permit random
   19% selection. Any user arg structures in the tree structure are not used 
   20% afterwards. 'verification' must be called to account for them.
   21
   22generate_tree(TopGoal, TreeType, MaxDepth, UserArgs, Tree, Expr) :-
   23	fast:dctg_rule_info(TopGoal, _, RuleHead, _, _),
   24	RuleHead =.. [Name|Args],
   25	append(_, [node(X,Y,_),Expr,_], Args),
   26	Tree = node(X,Y,_),
   27	append(UserArgs, [Tree,Expr,[]], Args2), % enforce empty diff list
   28	RuleHead2 =.. [Name|Args2],
   29	!, % new
   30	once(gen_tree(RuleHead2, TreeType, MaxDepth)).
   31
   32% gen_tree(RuleHead, TreeType, Depth):
   33%	RuleHead - Head of rule at root of tree
   34%	TreeType - full or grow
   35%	Depth - current depth to make tree 
   36
   37gen_tree(RuleHead, TreeType, Depth) :-
   38	Depth2 is Depth - 1,
   39	% select_random_rule(TreeType, Depth2, RuleHead),
   40	select_random_rule(TreeType, Depth, RuleHead),
   41	clause(RuleHead, Body),
   42	process_goals(Body, TreeType, Depth2).
   43
   44% process_goals(Goals, TreeType, Depth):
   45%	Goals - goals to generate subtrees for
   46%	TreeType - grow or full
   47%	Depth - current depth to make tree
   48
   49process_goals((A,B), TreeType, Depth) :-
   50	!,
   51	process_goals(A, TreeType, Depth),
   52	process_goals(B, TreeType, Depth).
   53	% !.
   54process_goals(A, TreeType, Depth) :-
   55	(is_a_rule_call(A) ->
   56		gen_tree(A, TreeType, Depth)
   57		;
   58		call(A)).
   59
   60% select_random_rule(TreeType, MaxDepth, RuleHead):
   61%	TreeType - grow or full
   62%	MaxDepth - maximum depth of resulting tree
   63%	RuleHead - Head of selected rule
   64%
   65% Randomly select a rule for given RuleHead structure, based on type and 
   66% max depth. The RuleHead args are unified with head of rule to use.
   67% On backtracking, new selections are tried. Random selection done by 
   68% generating a shuffled list of rules to try, and each is tried in succession.
   69% Possible for this to fail, depending on MaxDepth value.
   70
   71select_random_rule(TreeType, MaxDepth, RuleHead) :-
   72	RuleHead =.. [RuleName|_],
   73	shuffle_rule_list(RuleName, TreeType, RuleList),
   74	member(ID, RuleList),   % may backtrack to here
   75	fast:dctg_rule_info(_, ID, RuleHead, MinDepth, _),
   76	MinDepth =< MaxDepth,   % otherwise exceeds Depth; forces backtracking
   77	!. % new: June 11/99
   78
   79% shuffle_rule_list(RuleName, Type, RuleList):
   80%	RuleName - name of rule to make list for
   81%	Type - grow or full
   82%	RuleList - shuffled list of rule ID's 
   83%
   84% Returns a shuffled list of rule ID's for given rule.
   85% Grow tree has terminal and nonterminal rules shuffled together.
   86% Full tree has nonterminals shuffled first, followed by terminals.
   87% Idea is that rules will be tried one after another from this list.
   88
   89shuffle_rule_list(RuleName, grow, RuleList) :-
   90	fast:dctg_id_table(RuleName, IDList, _, _),
   91	random_permutation(IDList, RuleList),
   92	!.
   93shuffle_rule_list(RuleName, full, RuleList) :-
   94	fast:dctg_id_table(RuleName, _, TermList, NontermList),
   95	random_permutation(TermList, T1),
   96	random_permutation(NontermList, T2),
   97	append(T2, T1, RuleList), % nonterms have precedence
   98	!