1?- dynamic testset/2.    2
    3% Experiment: evolve a SRE to conform with this stoch. regular grammar
    4% (from Carrasco & Forcado 96)
    5% 
    6%   S -> a S  (0.2) 
    7%   S -> b A  (0.8) 
    8%   A -> a B  (0.7) 
    9%   A -> b S  (0.3) 
   10%   B -> a A  (0.4) 
   11%   B -> b B  (0.1) 
   12%   B -> []   (0.5)
   13%
   14% Fitness: 
   15% - Mine expression K times, and compare distribution with test set. 
   16% - maximum string length enforced
   17% - chi-square 2-bin test to compare distributions
   18
   19
   20evaluator(Expr, Fitness) :-
   21	testset(_, TestSet),
   22	gen_set_size_P(Size),
   23	mine(Expr, Size, MineSet),
   24	%sre_mintestcnt_P(MC), % new
   25	tabulate_set(MineSet, 0, _, MineSet2),
   26	chisquare_b(MineSet2, TestSet, Size, 0.0, Fitness),
   27	% chisquare_2bins(MineSet2, TestSet, 0.0, Fitness),
   28	!.
   29
   30mine(_, 0, []) :- !.
   31mine(Expr, K, [String|Rest]) :-
   32	Expr^^raw_generate(String, 0, _),
   33	K2 is K-1,
   34	mine(Expr, K2, Rest),
   35	!.
   36
   37normalize(_, [], []) :- !.
   38normalize(Size, [(A,C)|R], [(A,P)|R2]) :-
   39	P is C/Size,
   40	normalize(Size, R, R2),
   41	!.
   42
   43chisquare_b(_, [], _, Fit, Fit) :- !.
   44chisquare_b(MineSet, [(Test,Prob)|Rest], Sum, FitSoFar, Fitness) :-
   45	member_remove((Test,Count2), MineSet, MineSet2),	
   46	X is Prob*Sum,
   47	T is Count2-X,
   48	Fit2 is FitSoFar + ((T*T)/X),
   49	chisquare_b(MineSet2, Rest, Sum, Fit2, Fitness),
   50	!.
   51chisquare_b(MineSet, [(_,Prob)|Rest], Sum, FitSoFar, Fitness) :-
   52	Fit2 is FitSoFar + (Prob*Sum),
   53	chisquare_b(MineSet, Rest, Sum, Fit2, Fitness),
   54	!.
   55
   56member_remove(X, [X|Y], Y) :- !.
   57member_remove(X, [Y|Z], [Y|W]) :- member_remove(X, Z, W).
   58
   59count_and_remove(_, [], [], 0) :- !.
   60count_and_remove(A, [A|R], S, Count) :-
   61	!,
   62	count_and_remove(A, R, S, Count2),
   63	Count is Count2+1.
   64count_and_remove(A, [B|R], [B|S], Count) :-
   65	!,
   66	count_and_remove(A, R, S, Count).
   67
   68% This should be called once per GP generation.
   69
   70generate_testset :-
   71	(retract(testset(_,_)) ; true),
   72	gen_set_size_P(Size),
   73	gen_set(Size, S), % was 250
   74	sre_mintestcnt_P(MC),
   75	tabulate_set(S, MC, Sum, T),
   76	normalize(Sum, T, T2),
   77	assert(testset(Sum, T2)),
   78	!.
   79
   80gen_set(0, []).
   81gen_set(K, [S|R]) :-
   82	K > 0,
   83	repeat,
   84	max_string_length_P(Max),
   85	gen_string(s, 0, Max, S),
   86	K2 is K-1,
   87	!,
   88	gen_set(K2, R).
   89
   90gen_string(NonTerm, Len, Max, String) :-
   91	Len =< Max,
   92	(production(NonTerm, Out, NextNonTerm) ->
   93		Len2 is Len+1,
   94		gen_string(NextNonTerm, Len2, Max, R),
   95		String = [Out|R]
   96		;
   97		String = []).
   98
   99
  100% production(NonTerm, Output, NextNonTerm).
  101
  102production(s, a, s) :- maybe(0.2).
  103production(s, b, a).
  104production(a, a, b) :- maybe(0.7).
  105production(a, b, s).
  106production(b, a, a) :- maybe(0.4).
  107production(b, b, b) :- maybe(0.167).
  108
  109% pre-filter and count test set, rather than repeatedly process
  110% it during fitness evaluation of population. User can specify minimum
  111% count for processing.
  112
  113tabulate_set([], _, 0, []).
  114tabulate_set([A|R], Min, Sum, [(A,C2)|S]) :-
  115	once(count_and_remove(A, R, R2, C)),
  116	C2 is C+1,
  117	C2 > Min,
  118	!,
  119	tabulate_set(R2, Min, Sum2, S),
  120	Sum is Sum2 + C2.
  121tabulate_set([_|R], Min, Sum, S) :-
  122	!,
  123	tabulate_set(R, Min, Sum, S).
  124
  125:- multifile(chisquare/4).  126:- dynamic(chisquare/4).  127temp_test(Fitness) :-
  128	generate_tree(expr, full, 12, _, Tree1, _),
  129	write('Mining 1... '),
  130	mine(Tree1, 500, MineSet1),
  131	repeat,
  132	generate_tree(expr, full, 12, _, Tree2, _),
  133	nl,
  134	write('Mining 2... '),
  135	mine(Tree2, 500, MineSet2),
  136	nl,
  137	write('chi square...'),
  138	chisquare(MineSet1, MineSet2, 0.0, Fitness),
  139	nl,
  140	Tree1^^construct(Expr1),
  141	Tree2^^construct(Expr2),
  142	write('Expr 1:'),
  143	sre_pp(Expr1),
  144	write('Expr 2:'),
  145	sre_pp(Expr2).
  146
  147/*
  148test_chi(F) :-
  149	generate_testset,
  150	testset(_,A),
  151	generate_testset,
  152	testset(_,B),
  153	chisquare(A,B,0,F).
  154*/
  155
  156
  157chisquare_2bins([], [], Fit, Fit) :- !.
  158chisquare_2bins([(_,Count)|Rest], [], FitSoFar, Fit) :- 
  159	Fit2 is FitSoFar + Count,
  160	chisquare_2bins(Rest, [], Fit2, Fit),
  161	!.
  162chisquare_2bins(MineSet, [(Test,Count)|Rest], FitSoFar, Fitness) :-
  163	member_remove((Test,Count2), MineSet, MineSet2),	
  164	T is (Count2-Count),
  165	Fit2 is FitSoFar + ((T*T)/(Count+Count2)),
  166	chisquare_2bins(MineSet2, Rest, Fit2, Fitness),
  167	!.
  168chisquare_2bins(MineSet, [(_,Count)|Rest], FitSoFar, Fitness) :-
  169	Fit2 is FitSoFar + Count,
  170	chisquare_2bins(MineSet, Rest, Fit2, Fitness),
  171	!