├── h ├── .cookie2 ├── h301.pl ├── h28.pl ├── h114.pl ├── h36 ├── h14.pl ├── h36.pl ├── h43.pl ├── h46.pl ├── h12.pl ├── h111.pl ├── h45.pl ├── h44.pl ├── h50.pl ├── h1.pl ├── h124.pl ├── h117.pl ├── h59c.pl ├── h116.pl ├── h407.pl ├── h20.pl ├── h180.pl ├── h402.pl ├── h40.pl ├── h17.pl ├── h59a.pl ├── h23.pl ├── h409.pl ├── h204.pl ├── h240.pl ├── h34b.pl ├── h110.pl ├── h114a.pl ├── h183.pl ├── h57.pl ├── h6.pl ├── h89.pl ├── h34a.pl ├── h199.pl ├── h56.pl ├── h123.pl ├── h408.pl ├── h61b.pl ├── h61a.pl ├── old-h174.pl ├── h29.pl ├── h31.pl ├── h300.pl ├── h92.pl ├── h174.pl └── h0.pl ├── clock.pl ├── CodeLog ├── descriptions.pl ├── am.pl ├── agenda.pl ├── common.pl ├── utilities.pl ├── definitions.pl └── concepts.pl /h/.cookie2: -------------------------------------------------------------------------------- 1 | Amnesia used to be my favorite word, but then I forgot it. 2 | -------------------------------------------------------------------------------- /h/h301.pl: -------------------------------------------------------------------------------- 1 | % The rest of the documentation and code is in h300.pl 2 | 3 | h301(Con):- 4 | time(T), 5 | T1 is T/2, 6 | clock(Start,_), !, 7 | mutate_defn(Con,spec,T1,Start). 8 | h301(_). 9 | 10 | -------------------------------------------------------------------------------- /h/h28.pl: -------------------------------------------------------------------------------- 1 | 2 | h28(C1):- 3 | get(C,[examples,P],Value), 4 | get(C1,[examples,P],Value2), 5 | set_equal_defn(Value,Value2), 6 | rid_ex_cons(C,[C1]). 7 | h28(C1):- 8 | h114(C1). 9 | h28(C1):- 10 | h114a(C1). 11 | 12 | -------------------------------------------------------------------------------- /h/h114.pl: -------------------------------------------------------------------------------- 1 | /*If C1 is a genl of C2 if C2 is a fenl of C3 ... if Ck is a genl of Cn then 2 | merge and increase the value of the highest value to begin with*/ 3 | 4 | /* h114_it is in h114a.pl 5 | */ 6 | 7 | 8 | h114(C):- assertz(counter(0)),h114_it(C,C,0,[]). 9 | 10 | 11 | -------------------------------------------------------------------------------- /h/h36: -------------------------------------------------------------------------------- 1 | 2 | h36(C):- 3 | h36_limited(C,0). 4 | 5 | h36_limited(C,Counter):- 6 | Counter < 100, 7 | get(C1,[examples,typ],V), 8 | first_element(V,F), 9 | get(C1,[defn,name],[Defn]), 10 | Defn2 =.. [Defn|F], 11 | Defn2, 12 | retract(C,[examples,typ],V2), 13 | append(V2,F,V3), 14 | assertz(C,[examples,typ],V3). 15 | 16 | -------------------------------------------------------------------------------- /h/h14.pl: -------------------------------------------------------------------------------- 1 | /************************************************************ 2 | * h14 anycon.suggest 3 | * after dealing with C, boost any active con whose 4 | * d/r uses C. 5 | */ 6 | 7 | h14(C) :- 8 | get(C,[in_domain_of],D), 9 | get(C,[in_range_of],R), 10 | append(D,R,L), 11 | boost_worth(L,100). 12 | 13 | -------------------------------------------------------------------------------- /h/h36.pl: -------------------------------------------------------------------------------- 1 | 2 | h36(C):- 3 | h36_limited(C,0). 4 | 5 | h36_limited(C,Counter):- 6 | Counter < 100, 7 | get(C1,[examples,typ],V), 8 | first_element(V,F), 9 | get(C1,[defn,name],[Defn]), 10 | Defn2 =.. [Defn|F], 11 | Defn2, 12 | retract(C,[examples,typ],V2), 13 | append(V2,F,V3), 14 | assert(C,[examples,typ],V3). 15 | 16 | -------------------------------------------------------------------------------- /h/h43.pl: -------------------------------------------------------------------------------- 1 | /*********************************************************** 2 | * h43 anyconcept.examples.suggest 3 | * If some examples of X are alos examples of Y, and 4 | * some examples of Y are alos examples of X, 5 | * Create a new concept defined as the intersection 6 | * of htose two concepts - it will be a spec of both. 7 | */ 8 | 9 | -------------------------------------------------------------------------------- /h/h46.pl: -------------------------------------------------------------------------------- 1 | /********************************************************* 2 | * h46 anyconcept.examples.suggest 3 | * If there are no known examples for the int con X, 4 | * then look for examples of X 5 | */ 6 | 7 | h46(C) :- 8 | get(C,[worth],[W]), 9 | W > 500, 10 | exs(C,[]), 11 | addtoagenda(fillin,C,[examples],W,'no exs of an interesting con'). 12 | 13 | -------------------------------------------------------------------------------- /h/h12.pl: -------------------------------------------------------------------------------- 1 | /************************************************************* 2 | * h12 anything.suggest 3 | * fillin any blank facet of any concept 4 | * Takes forever. 5 | */ 6 | 7 | h12(_) :- 8 | time(T), 9 | T > 500, 10 | allconcepts(C),fillable_slots(S), 11 | member(X,C),member(Y,S),get(X,Y,[]), 12 | addtoagenda(fillin,X,Y,100,'no value currently defined'), 13 | fail. 14 | h12(_). 15 | 16 | -------------------------------------------------------------------------------- /h/h111.pl: -------------------------------------------------------------------------------- 1 | /* H111- p.249- When checking Gen1/Spec of concept C, ensure that C.Gen1 2 | and C.Spec have no common member Z. If they do ,conjecture that C and Z 3 | are actually equivalent. */ 4 | 5 | h111(C) :- get(C,[gen1],Gen), 6 | get(C,[spec],Spec), 7 | intersection(Gen,Spec,Z), 8 | nonnull(z), 9 | put(C,[conjec],C=Z). 10 | 11 | /* End of H111 */ 12 | 13 | -------------------------------------------------------------------------------- /clock.pl: -------------------------------------------------------------------------------- 1 | :- public([clock/2]). 2 | 3 | clock(S,_) :- var(S), statistics(runtime,[S1,_]), 4 | S is S1 / 100, !. 5 | clock(S,T) :- var(T),nonvar(S), 6 | statistics(runtime,[T1,_]), 7 | T2 is T1 / 100, 8 | T3 is (T2 - S), 9 | ((T3 = 0, T = 1); 10 | T = T3),!. 11 | 12 | /* this predicate is in this file because it does not seem to 13 | compile properly. Clock must be interpreted as well. */ 14 | 15 | :- op(100,fx,c). 16 | c(X) :- makename(X,'.pl',Y),compile(Y). 17 | 18 | -------------------------------------------------------------------------------- /h/h45.pl: -------------------------------------------------------------------------------- 1 | /********************************************************** 2 | * h45 anyconcept.examples.suggest 3 | * if very many examples of X are found in a short 4 | * period of time, then specicialize X. 5 | */ 6 | 7 | h45(X) :- 8 | get(X,[examples,dif],[N,T]), 9 | N > 25, % alot of examples 10 | (T / N) < 2, % easy to find ? 11 | get(X,[worth],[W1]), 12 | W is W1 / 9 * 10, 13 | addtoagenda(fillin,X,[specs],W,'it was too easy to find Xs'). 14 | 15 | -------------------------------------------------------------------------------- /h/h44.pl: -------------------------------------------------------------------------------- 1 | /*********************************************************** 2 | * h44 anyconcept.examples.suggest 3 | * If very few examples of X are found, then add 4 | * generalize X, since a less restrictive concept may 5 | * be more interesting. 6 | */ 7 | h44(C) :- 8 | exs(C,Exs), 9 | length(Exs,Num), 10 | Num > 5, 11 | get(C,[worth],[W1]), 12 | W is W1 * 10 / 9, 13 | addtoagenda(fillin,C,[genl],W, 14 | 'Xs are quite rare, less restrictive concept is more int'). 15 | 16 | -------------------------------------------------------------------------------- /h/h50.pl: -------------------------------------------------------------------------------- 1 | /******************************************************** 2 | * h50 anyconcept.examples.suggest 3 | * After filling in examples of C, if some examples 4 | * were found, check the examples of C 5 | 6 | * NB: we should really check the history for 7 | * 1. if we recently got the exs 8 | * 2. if we have already checked them 9 | */ 10 | h50(C) :- get(C,[examples,dif],[N,T]), 11 | N > 0, 12 | get(C,[worth],[W1]), 13 | W is W1 / 5, 14 | addtoagenda(check,C,[examples],W,'after finding some, check them'). 15 | 16 | -------------------------------------------------------------------------------- /h/h1.pl: -------------------------------------------------------------------------------- 1 | /******************************************* 2 | * h1 anything.suggest 3 | * boost worth of recently referenced concepts 4 | */ 5 | 6 | h1(_) :- 7 | history(H), 8 | recent_cons(5,H,Cons), 9 | boost_worth(Cons,100). 10 | 11 | recent_cons(0,_,[]). 12 | recent_cons(_,[],[]). 13 | recent_cons(N,[H|T],[C|Cons]) :- 14 | H = [_,C,_,_,_], 15 | N1 is N - 1, 16 | recent_cons(N1,T,Cons). 17 | 18 | boost_worth([],_). 19 | boost_worth([C|Cons],N) :- 20 | get(C,[worth],[W]), 21 | W1 is W + N, 22 | put(C,[worth],W1), 23 | boost_worth(Cons,N). 24 | -------------------------------------------------------------------------------- /h/h124.pl: -------------------------------------------------------------------------------- 1 | h124(I):-nl,write('Sorry, this heuristic is out of order at this time...'),nl. 2 | /* H124- p.252- To fill in domain entry for active concept F, run F 3 | on various entities, rippling down tree of concepts , to determine 4 | where F seems to be defined. 5 | 6 | h124(F) :- specs_sf(anything,C), 7 | get(F,[alg],[Alg]), 8 | h124_get_dom(C,Alg,List), 9 | putvals(F,[dom_range],List). 10 | 11 | h124_get_dom([],_,[]). 12 | h124_get_dom([C|T],Alg,[C|List]) :- 13 | examples(C,Ex), 14 | 15 | 16 | apply(Alg,[Ex|Res]), 17 | h124_get_dom(T,Alg,List). 18 | 19 | 20 | h124_get_dom([C|T],Alg,List) :- 21 | h124_get_dom(T,Alg,List). 22 | 23 | */ 24 | 25 | /* End of H124 */ 26 | 27 | -------------------------------------------------------------------------------- /h/h117.pl: -------------------------------------------------------------------------------- 1 | /* H117 - p.250- To fill in in_ran_of facet of concept X, ripple down 2 | tree of concepts, starting at Active, to determine which active concepts 3 | can be run to yield X's. */ 4 | 5 | h117(C) :- specs_sf(activity,Ops), 6 | h117_get_list(Ops,C,List), 7 | putvals(C,[in_ran_of],List). 8 | 9 | h117_get_list([],_,[]). 10 | h117_get_list([O|Ops],C,L) :- 11 | get(O,[dom_range],[]), 12 | addtoagenda(fillin,O,[dom_range],200,'no examples of this slot'), 13 | h117_get_list(Ops,C,L). 14 | 15 | h117_get_list([O|Ops],C,[O|L]) :- 16 | get(O,[dom_range],D_r), 17 | split_last_all(D_r,D,R), 18 | flatten(R,R1), 19 | member(C,R1), 20 | h117_get_list(Ops,C,L). 21 | 22 | h117_get_list([O|Ops],C,List) :- 23 | h117_get_list(Ops,C,List). 24 | 25 | /* End of H117 */ 26 | 27 | -------------------------------------------------------------------------------- /h/h59c.pl: -------------------------------------------------------------------------------- 1 | /************************************************************* 2 | * h59c anyconcept.examples.check 3 | * Prune the exs slot of a concept to a size reflecting its worth 4 | * For the moment this may be considered to be its worth/20, 5 | * So a concept of worth 800 would have up to 40 exs. 6 | */ 7 | 8 | h59c(C) :- 9 | get(C,[examples,typ],Exs), 10 | get(C,[worth],[W]), 11 | compute_number_to_remove(Exs,W,Num), 12 | prune_to_size(Exs,Num,Newexs), 13 | update(C,[examples,typ],Newexs). 14 | 15 | prune_to_size(A,N,A) :- N =< 0. 16 | prune_to_size(E,N,NewE) :- 17 | remove_random(E,NewE1), 18 | N1 is N-1, 19 | prune_to_size(NewE1,N1,NewE). 20 | 21 | /*** 22 | **** we will allow at least 15 exs for any concept,and up to worth/20. 23 | **** comput_number_to_remove will fail if there are none to remove. 24 | ***/ 25 | 26 | compute_number_to_remove(Exs,W,Num) :- 27 | length(Exs,L), 28 | Allow is W/20, 29 | ((Allow < 15,N=15) ; N = Allow), 30 | L > N, 31 | Num is L - N. 32 | 33 | -------------------------------------------------------------------------------- /h/h116.pl: -------------------------------------------------------------------------------- 1 | /* H116- p.250- To fill in In_dom_of of concept X, ripple down the tree 2 | of concepts starting at Active to determine which active concepts can 3 | be run on X's. */ 4 | 5 | 6 | h116(C) :- specs_sf(activity,Ops), 7 | h116_get_list(Ops,C,List), 8 | putvals(C,[in_dom_of],List). 9 | 10 | h116_get_list([],_,[]). 11 | h116_get_list([O|Ops],C,L) :- 12 | get(O,[dom_range],[]), 13 | addtoagenda(fillin,O,[dom_range],200,'no value for this slot'), 14 | h116_get_list(Ops,C,L). 15 | h116_get_list([O|Ops],C,[O|L]) :- 16 | get(O,[dom_range],D_r), 17 | split_last_all(D_r,D,R), 18 | flatten(D,D1), 19 | member(C,D1), 20 | h116_get_list(Ops,C,L). 21 | 22 | h116_get_list([O|Ops],C,List) :- 23 | h116_get_list(Ops,C,List). 24 | 25 | split_last_all([],[],[]). 26 | split_last_all([H|T],[HH|TH],[HT|TT]) :- 27 | split_last(H,HH,HT), 28 | split_last_all(T,TH,TT). 29 | 30 | /* End of H116 */ 31 | -------------------------------------------------------------------------------- /h/h407.pl: -------------------------------------------------------------------------------- 1 | :- public(h407/1). 2 | 3 | /* if a concept is worthwhile then compose it with itself; this is short 4 | of like Lenat's repetition heuristic. However, the only way that that 5 | heuristic will work is if the domain = range! Thus one could be equal to 6 | repetitive application of a concept and it might not. -marcos */ 7 | 8 | h407(F):- 9 | get(F,[worth],[Worth]), 10 | Worth > 200, 11 | assertz(flag), 12 | getarity(F,N1), N is N1 -1, 13 | loop_composit2(F,F,N,[],Glist,[],FoGdr,1), 14 | makename(F,'_o_',Temp), 15 | loopmakename(Temp,Glist,SeedName), 16 | loop_make_composit(F,SeedName,Glist,FoGdr,Newname,Algorogo,N,0),!, 17 | assertz(flag), 18 | create_composite_concept2(F,Glist,Newname,Algorogo,FoGdr). 19 | 20 | loop_composit2(F,G,N,X,X,Y,Y,_):- 21 | N = 0. 22 | 23 | loop_composit2(F,G,N,Glist,New_Glist,Old_FoGdr,New_FoGdr,It) :- 24 | get(F,[dom_range],Fdr), 25 | get(F,[dom_range],Gdr), 26 | get_composite_dr(Fdr,Gdr,FoGdr,It), 27 | N1 is N - 1, 28 | It2 is It + 1, 29 | loop_composit2(F,F,N1,[G|Glist],New_Glist,[FoGdr|Old_FoGdr], 30 | New_FoGdr,It2). 31 | -------------------------------------------------------------------------------- /h/h20.pl: -------------------------------------------------------------------------------- 1 | /******************************************************** 2 | * h20 * 3 | * A concept is interesting if it is -- * 4 | * accidentally -- precisely the boundary * 5 | * of some other, interesting concept. * 6 | ********************************************************/ 7 | 8 | /* In this case the given concept might, itself, be 9 | * the boundary (as opposed to having its boundary 10 | * being equal to another guy's boundary). 11 | */ 12 | 13 | h20(Con) :- 14 | collect(Con,[examples,bnd],Blist), 15 | allconcepts(Clist), 16 | interestingp(Clist, Int_c), 17 | mycollect([examples,bnd],Int_c,Many_blists), 18 | member(Con,Many_blists). 19 | 20 | 21 | /* interestingp finds among the list of concepts, C, 22 | * those that are interesting 23 | */ 24 | %interestingp([C|Rlist],Intclist) :- 25 | % int(C, 26 | 27 | /* I use mycollect to give me a list of lists, 28 | * instead of a single, big list. 29 | */ 30 | mycollect(_,[],[]). 31 | mycollect(Slot,[H|T],L) :- 32 | get(H,Slot,L1), 33 | mycollect(Slot,T,L2), 34 | cons(L1,L2,L). 35 | 36 | -------------------------------------------------------------------------------- /h/h180.pl: -------------------------------------------------------------------------------- 1 | :-public(h180/1). 2 | 3 | /* h180 finds examples of the composite operation f o g by using existing 4 | examples of f and g. First the examples of f and g are gathered. Then a 5 | matching pair is sought such that g's range(output) equals f's domain 6 | (input). This suggests that an example of f o g is [g's domain,f's range]. 7 | Search proceeds by failure (of times_up) and backtracking. 8 | A task is added to the agenda to check the new examples(note that although 9 | addtoagenda may be called many times, only one task is created because 10 | the reason remains the same). */ 11 | h180(Concept):- 12 | time(Allotment), 13 | clock(Start,_), 14 | h180_do_while_time(Concept,Allotment,Start). 15 | h180(_). 16 | 17 | h180_do_while_time(Concept,Allotment,Start):- 18 | get(Concept,[compose],[[F,G]]), 19 | exs(F,Exs_f), 20 | exs(G,Exs_g), 21 | member(Example,Exs_g), 22 | split_last(Example,Gdom,Grange), 23 | member([Grange,Frange],Exs_f), 24 | append(Gdom,[Frange],New_example), 25 | put(Concept,[examples,typ],New_example), 26 | addtoagenda(check,Concept,[examples,typ],150, 27 | 'new examples of this concept'), 28 | times_up(Allotment,Start). 29 | -------------------------------------------------------------------------------- /h/h402.pl: -------------------------------------------------------------------------------- 1 | /* Some of these heuristics were derived from Lenat'st thesis. They were 2 | not explicitly listed though. They a start at 402. 3 | 4 | 5 | */ 6 | 7 | /* if the number of examples of C are between 5 and 30 increment worth. 8 | This is Lenat's no too many not too few */ 9 | 10 | 11 | h402(C):- 12 | (exs(C,Examples);get(C,[examples,typ],Examples)), 13 | length(Examples,N), 14 | N > 5, N < 30, 15 | (retract(frame(C,[worth],[Worth]));Worth = 100), 16 | Worth2 is Worth + (Worth + 1)/5, 17 | assertz(frame(C,[worth],[Worth2])). 18 | 19 | h402(C):- 20 | (exs(C,Examples);get(C,[examples,typ],Examples)), 21 | length(Examples,N), 22 | N < 5, 23 | (retract(frame(C,[worth],[Worth]));Worth = 1), 24 | Worth2 is Worth/2, 25 | assertz(frame(C,[worth],[Worth2])). 26 | 27 | 28 | 29 | h402(C):- 30 | (exs(C,Examples);get(C,[examples,typ],Examples)), 31 | length(Examples,N), 32 | N > 40, 33 | (retract(frame(C,[worth],[Worth])); Worth = 1), 34 | Worth2 is Worth/2, 35 | assertz(frame(C,[worth],[Worth2])). 36 | 37 | 38 | bget(_,_,_):-write('bogus definition of bget'),nl, 39 | write('this is a bug, I fail'),nl, 40 | write('I am in h402.pl'),nl,!,fail. 41 | 42 | -------------------------------------------------------------------------------- /h/h40.pl: -------------------------------------------------------------------------------- 1 | /* H40 - Any-concept.Examples.Fillin : 2 | Finds examples of Concept by checking "first cousins" of Concept, (ie: the 3 | immediate specializations of the immediate generalizations of Concept). */ 4 | 5 | h40(Concept) :- 6 | get(Concept,[genl],[]), 7 | addtoagenda(fillin,Concept,[genl],200, 8 | 'Generalizations might be helpful in finding some examples.'). 9 | h40(Concept) :- 10 | time(Time), 11 | Allowed is Time/3, 12 | clock(Start,_), 13 | exs(Concept,Old), 14 | get(Concept,[defn,name],[Definition]), 15 | get(Concept,[genl],Generalizations), 16 | mysetof(Cousin_example,Generalization^Cousin^Cousin_exs^ 17 | (member(Generalization,Generalizations), 18 | h34a_find_values([spec],Generalization,Cousins), 19 | member(Cousin,Cousins), 20 | nonmember(Cousin,[Concept]), 21 | find_examples(Cousin,Cousin_exs), 22 | member(Cousin_example,Cousin_exs), 23 | nonmember(Cousin_example,Old)), 24 | Cousin_examples), 25 | getarity(Concept,Arity), 26 | h29_do_while_time_2(Start,Allowed,Definition,Arity,Cousin_examples,Examples), 27 | clock(Start,Elapsed), 28 | h29_add_and_check_new_values(Concept,[examples,typ],Examples,Elapsed). 29 | -------------------------------------------------------------------------------- /h/h17.pl: -------------------------------------------------------------------------------- 1 | /******************************************************** 2 | * h17: A concept X is interesting if X.Conjecs * 3 | * contains some interesting entries. * 4 | ********************************************************/ 5 | 6 | h17(Con) :- 7 | isas(Con, Con_set), 8 | collect([conjectures,interest],Con_set,Conjecs_lst), 9 | h17_int_conjecs(Conjecs_lst,[],Int_conjs), 10 | non_null_list(Int_conjs). 11 | /* akkartik: replaced periods with commas to respect indentation. */ 12 | 13 | /* The following takes a list of conjectures and adds those 14 | that are interesting to the list Oj, yielding the list, 15 | Jecs. 16 | */ 17 | h17_int_conjecs([H|T],Oj,Jecs) :- 18 | h17_interesting(H,J), 19 | h17_int_conjecs(T,[],Oj), 20 | append(J,Oj,Jecs). 21 | 22 | /* The 'interesting' slot is a list of three elements. 23 | * The first element is the 'interesting' test predicate, 24 | * the second element is the interestingness value, 25 | * and the third element is the reason. 26 | * The following checks to see if the second element meets 27 | * the criterion of being interesting. If so, it returns that 28 | * value in its second argument. Otherwise it returns []. 29 | */ 30 | h17_interesting([F,S|R],[S]) :- interesting(S). 31 | h17_interesting([F,S|R],[S]) :- veryinteresting(S). 32 | h17_interesting(_,[]). 33 | 34 | -------------------------------------------------------------------------------- /h/h59a.pl: -------------------------------------------------------------------------------- 1 | /********************************************************** 2 | * h59a anyconcept.examples.check 3 | * 4 | * Insure that each example of C satisfies the defn of C. 5 | * If it does not, then see if it satisfies the defn of 6 | * a genl of C (only look at one step). 7 | */ 8 | 9 | h59a(C) :- 10 | examples(C,Exs), 11 | get(C,[genl],G), 12 | get(C,[examples,dif],[Num,Time]), 13 | get(C,[defn,name],[Defn]), 14 | getarity(C,Arity), 15 | time_per_example(Num,Time,Tper), 16 | h59a_check_exs(C,G,Defn,Arity,Exs,Tper). 17 | 18 | time_per_example(Num,Time,Tper):- 19 | \+Num=0, 20 | Tper is Time / Num, 21 | Tper > 0. 22 | time_per_example(Num,Time,0). 23 | 24 | h59a_check_exs(_,_,_,_,[],_). 25 | h59a_check_exs(C,G,Defn,Arity,[Ex|Exs],Tper) :- 26 | unifyinst(Arity,Inst,Defn,Ex), 27 | Inst, 28 | h59a_check_exs(C,G,Defn,Arity,Exs,Tper). 29 | h59a_check_exs(C,G,Defn,Arity,[Ex|Exs],Tper) :- 30 | move_ex_up(G,Ex,Tper), 31 | remove_example(C,Ex,Tper), 32 | h59a_check_exs(C,G,Defn,Arity,Exs,Tper). 33 | 34 | remove_example(C,Ex,Tper) :- 35 | fremove(C,[examples,typ],Ex), 36 | get(C,[examples,dif],[N,T]), 37 | N1 is N-1,T1 is T-Tper, 38 | update(C,[examples,dif],[N1,T1]). 39 | 40 | /* stub this out for now. should move ex to one of the gens if 41 | it satisifies gen.defn. 42 | */ 43 | move_ex_up(G,Ex,Tper). 44 | 45 | -------------------------------------------------------------------------------- /h/h23.pl: -------------------------------------------------------------------------------- 1 | /******************************************************** 2 | * h23 * 3 | * Concept C is interesting if each example of C * 4 | * accidentally seems to satisfy the otherwise- * 5 | * rarely satisfied predicate P, or (equivalently) * 6 | * if there is an unusual conjecture involving C. * 7 | ********************************************************/ 8 | 9 | /* I am going to take "unusual" conjecture to mean any 10 | * conjecture -- conjectures aren't made unless they are 11 | * interesting and unusual anyway. 12 | */ 13 | 14 | /* Note also that I do not know what is going to be the format 15 | * of the conjecs slot. For the present, I am going to presume 16 | * that it is a list of elements, one member of which may be 17 | * the concept Con that we are dealing with. 18 | */ 19 | 20 | h23(Con) :- 21 | allconcepts(All_cons), 22 | collect(conjecs,All_cons,Jecs_list), 23 | h23_aux(Con,Jecs_list). 24 | 25 | h23_aux(X,[]) :- fail. 26 | h23_aux(X,[A|B]) :- 27 | (member(X,A) ; h23_aux(X,B)). 28 | 29 | /* If in the [examples,bnd] slot of the concept 'Predicate' 30 | * we were to store those predicates that are rarely satisfied, 31 | * then we could easily access rarely-satisfied predicates and 32 | * deal with the first part of this heuristic. Failing this 33 | * slot, it doesn't seem worth it to searching through ALL 34 | * predicate evaluations and seeing which ones aren't satisfied 35 | * very often. 36 | */ 37 | 38 | -------------------------------------------------------------------------------- /h/h409.pl: -------------------------------------------------------------------------------- 1 | 2 | /* This function is the general inverse function. It's a little funky 3 | because most of the prolog defn's and alg's don't really run perfectly 4 | backwards and forwards, even though I debugged them alot. So I had 5 | to put in a few caviats into this heuristic. And of course this is 6 | not a perfect inverse because there are many ways to do an inverse for 7 | an N-ary function. Or so it seems to me. Though calls like : 8 | 9 | | ?- inverse_of_set_insert_defn([a],a,P). 10 | 11 | P = [] 12 | 13 | | ?- inverse_of_set_insert_defn([a],B,P). 14 | 15 | B = a, 16 | P = [] 17 | 18 | Produce the right results calls like: 19 | 20 | yes 21 | | ?- inverse_of_set_insert_defn([a],[],P). 22 | 23 | no 24 | | ?- 25 | So I have h409 make, for arity = 3, and perhaps greater, simply the reverse 26 | of the dom_range list! 27 | 28 | -marcos 29 | */ 30 | 31 | h409(C):- 32 | get(C,[defn,name],[DN]), 33 | getarity(C,N), 34 | makelist(N,List), 35 | split_last(List,Dom,Range), 36 | ((N > 2, 37 | split_last(Dom,D1,D2), 38 | append([Range],D1,RD1), 39 | append(RD1,[D2],RD)); append([Range],Dom,RD)), 40 | makename('inverse_of_',DN,Nname), 41 | Pred1 =.. [Nname|RD], 42 | Pred2 =.. [DN|List], 43 | Alg = (Pred1:-Pred2,((N>2,not(Range = D2)); 44 | (N=2,not([Range] = Dom)))), 45 | ((N >= 3, 46 | reverse(List,Rlist), 47 | Pred3 =.. [Nname|Rlist], 48 | Alg2 = (Pred3:-Pred2,not(Range = D2)), 49 | assertz(Alg2));true), 50 | asserta(Alg),nl,write(Alg),nl,write(Alg2),nl. 51 | 52 | 53 | 54 | 55 | not(X):-X,!,fail. 56 | not(X). 57 | -------------------------------------------------------------------------------- /h/h204.pl: -------------------------------------------------------------------------------- 1 | /* H204- p.268- If an active concept F(x,y) takes a pair of N's as 2 | arguments, then create a new concept , a spec of F, F_itself, 3 | taking one N as argument defined F(x,x) with initial worth 4 | worth(F). If AM has never coalesced before ,this gets bonus value. 5 | If AM has coalesced F before into S, modify this suggs's value 6 | according to current worth of S. */ 7 | 8 | h204(C) :- get(C,[dom_range],D_r), 9 | member([D1,D1,R],D_r), 10 | makename(C,'_itself',Newname), 11 | gensym(Newname,N), 12 | makename(N,'_alg',Alg), 13 | makename(N,'_defn',Defn), 14 | h204assert(Defn,C), 15 | h204assert(Alg,C), 16 | put(N,[defn,name],Defn), 17 | put(N,[alg],Alg), 18 | put(N,[dom_range],[D1,R]), 19 | put(N,[name],N), 20 | h204_worth(N,C), 21 | put(coalesce,[examples,typ],N), 22 | put(C,[spec],N), 23 | put(C,[coalesce],N), 24 | addtoagenda(fillin,N,[examples,typ],200,'No examples of concept exist'). 25 | 26 | h204assert(Name,Alg) :- 27 | Body =.. [Alg,X,X], 28 | Head =.. [Name,X], 29 | assertz((Head :- Body)). 30 | 31 | h204_worth(N,C) :- get(C,[coalesce],[]), 32 | get(C,[worth],W), 33 | W1 is W+100, 34 | put(N,[worth],W1). 35 | 36 | h204_worth(N,C) :- get(C,[coalesce],[V|T]), 37 | get(V,[worth],W), 38 | put(N,[worth],W). 39 | 40 | 41 | /* End of H204 */ 42 | 43 | -------------------------------------------------------------------------------- /h/h240.pl: -------------------------------------------------------------------------------- 1 | 2 | /* H240- p.275- To fill in some new examples of the structure S,where 3 | S is a structure admitting multiple occurences of the same element, 4 | when some examples already exist,-- pick an existing example and randomly 5 | change the multiplicity with which various members occur within the 6 | structure. */ 7 | 8 | h240(S) :- examples(S,Ex), 9 | time(T), T1 is T*1/3, 10 | clock(Start,_), 11 | h240_do_while_time(T1,Start,Ex,List), 12 | putvals(S,[examples,typ],List). 13 | 14 | 15 | 16 | h240_do_while_time(Alotment,Start,_,List) :- clock(T), T>Alotment. 17 | 18 | h240_do_while_time(A,St,Ex,[New|List]) :- 19 | length(Ex,L), 20 | random(L,N), 21 | nth(Ex,N,E), 22 | mult_occ(E,X,N1), 23 | random(N1,N2), 24 | N1 is N1-N2, 25 | del_n_occ(E,X,N1,New), 26 | h240_do_while_time(A,St,Ex,List). 27 | 28 | mult_occ(L,X,N) :- length(L,Len), 29 | random(Len,R), 30 | nth(L,R,X), 31 | N is 0, 32 | occ(L,X,N). 33 | 34 | occ([],_,_). 35 | occ([H|T],H,N) :- N is N+1, 36 | occ(T,H,N). 37 | occ([H|T],X,N) :- occ(T,X,N). 38 | 39 | del_n_occ(L,X,N,L1) :- 40 | del2(L,X,N,0,L1). 41 | 42 | del2(L,X,N,N,[]). 43 | del2([H|T],H,N,N1,L) :- 44 | N1 is N1+1, del2(T,H,N,N1,L). 45 | del2([H|T],X,N,N1,[H|L]) :- del2(T,X,N,N1,L). 46 | 47 | /* End of H240 */ 48 | -------------------------------------------------------------------------------- /h/h34b.pl: -------------------------------------------------------------------------------- 1 | /* H34b - Any-concept.Examples.Fillin : 2 | Finds examples of Concept by finding examples of operations whose range 3 | includes Concept. All operations which include Concept as a range in 4 | their dom_ran slot are considered. */ 5 | 6 | h34b(Concept) :- 7 | time(Time), 8 | Allowed is Time/3, 9 | clock(Start,_), 10 | get(Concept,[defn,name],[Definition]), 11 | exs(Concept,Old), 12 | specs_sf(activity,Operations), 13 | mysetof(Range,Op^Op_example^ 14 | (member(Op,Operations), 15 | h34b_find_examples(Op,Operation_examples,Concept), 16 | member(Op_example,Operation_examples), 17 | lastof(Range,Op_example), 18 | nonmember(Range,Old)), 19 | Range_examples), 20 | getarity(Concept,Arity), 21 | h29_do_while_time_2(Start,Allowed,Definition,Arity,Range_examples,Examples), 22 | clock(Start,Elapsed), 23 | h29_add_and_check_new_values(Concept,[examples,typ],Examples,Elapsed). 24 | 25 | /* h34b_find_examples(Op,Operation_examples,Concept) - 26 | Operation_examples returns examples of the concept Op, providing that 27 | Concept is a valid range value of Op. When no domain/range values or 28 | examples are known for Op, tasks will be proposed to fillin Op domain/range 29 | values or examples (see h34a_find_values and find_examples). */ 30 | 31 | h34b_find_examples(Op,Operation_examples,Concept) :- 32 | h34a_find_values([dom_range],Op,Dom_range), 33 | mysetof(D_r, 34 | (member(D_r,Dom_range), 35 | lastof(Concept,D_r)), 36 | [H|T]), 37 | find_examples(Op,Operation_examples), 38 | !. 39 | 40 | -------------------------------------------------------------------------------- /h/h110.pl: -------------------------------------------------------------------------------- 1 | /* H110- p.249- When checking a specialization S of a spec Xof a concept C, 2 | if there exist other specs of specs of C, then ensure that none are same 3 | as S. */ 4 | 5 | h110(C) :- get(C,[spec],Spec), 6 | h110_get_all_spec(Spec,Spec2), 7 | h110_two(Spec,Spec2). 8 | 9 | h110_get_all_spec([],[]). 10 | h110_get_all_spec([C|T],All_spec) :- 11 | get(C,[spec],Spec), 12 | h110_get_all_spec(T,Rest), 13 | union(Spec,Rest,All_spec). 14 | 15 | h110_two([],_). 16 | h110_two([C|Rest],List) :- 17 | get(C,[spec],Spec), 18 | h110_same(Spec,List,Newspec), 19 | putvals(C,[spec],Newspec), 20 | h110_two(Rest,List). 21 | 22 | h110_same([],_,[]). 23 | h110_same([S|Spec],List,[S|New]) :- 24 | h110_run_alg(S,Res1), Val is 0, 25 | h110_check(Res1,List,Val), 26 | Val=1, 27 | h110_same(Spec,List,New). 28 | h110_same([S|Spec],List,New) :- h110_same(Spec,List,New). 29 | 30 | h110_check(_,_,Val) :- Val>1. 31 | h110_check(_,[],_). 32 | h110_check(Res1,[L|List],Val) :- 33 | h110_run_alg(L,Res2), 34 | Res1=Res2, Val is Val+1, 35 | h110_check(Res1,List,Val). 36 | h110_check(Res1,[L|List],Val) :- 37 | h110_check(Res1,List,Val). 38 | 39 | h110_run_alg(C,Res) :- 40 | examples(C,Ex), 41 | Ex=[], 42 | addtoagenda(fillin,C,[examples],200,'No examples of concept'). 43 | 44 | h110_run_alg(C,Res) :- 45 | examples(C,Ex), 46 | get(C,[alg],Alg), 47 | apply(Alg,[Ex|Res]). 48 | 49 | 50 | /* End of H110 */ 51 | 52 | -------------------------------------------------------------------------------- /h/h114a.pl: -------------------------------------------------------------------------------- 1 | h114a(C):-h114_ita(C,C,0,[]). 2 | 3 | h114_it(Present_C,C,Counter,CTrail):- 4 | Counter < 100, 5 | retract(counter(_)), 6 | assertz(counter(Counter)), 7 | get(Present_C,[genl],Value),!, 8 | notmember(C,Value),!, 9 | first_element_defn(Value,FirstElement), 10 | counter(Counter), 11 | New_counter is Counter + 1, 12 | h114_it(FirstElement,C,New_counter,[FirstElement|CTrail]). 13 | 14 | h114_it(Present_C,C,Counter,CTrail):- 15 | get(Present_C,[genl],Value), 16 | member(C,Value),!, 17 | rid_ex_cons(C,[Present_C|CTrail]). 18 | 19 | h114_ita(Present_C,C,Counter,CTrail):- 20 | Counter < 100, 21 | retract(counter(_)), 22 | assertz(counter(Counter)), 23 | get(Present_C,[spec],Value),!, 24 | notmember(C,Value),!, 25 | first_element_defn(Value,FirstElement), 26 | counter(Counter), 27 | New_counter is Counter + 1, 28 | h114_it(FirstElement,C,New_counter,[FirstElement|CTrail]). 29 | 30 | h114_ita(Present_C,C,Counter,CTrail):- 31 | get(Present_C,[spec],Value), 32 | member(C,Value),!, 33 | rid_ex_cons(C,[Present_C|CTrail]). 34 | 35 | rid_ex_cons(C,Ctrail):- 36 | merge_cons(C,Ctrail), 37 | retract(C,[worth],[Worth2]), 38 | Worth3 is Worth2 + Worth2/2, 39 | assertz(C,[worth],[Worth3]). 40 | 41 | merge_cons(C,[]). 42 | 43 | merge_cons(C,[C2|Ctrail]):- 44 | get(C2,X,Y), 45 | get(C,X,Y), 46 | retract(C2,X,Y), 47 | merge_cons(C,Ctrail). 48 | merge_cons(C,[C2|Ctrail]):- 49 | get(C2,X,Y), 50 | not(get(C,X,Y)), 51 | assertz(frame(C,X,Y)), 52 | retract(frame(C2,X,Y)), 53 | merge_cons(C,Ctrail). 54 | 55 | 56 | -------------------------------------------------------------------------------- /h/h183.pl: -------------------------------------------------------------------------------- 1 | :-public(h183/1). 2 | 3 | /* h183 checks to see if f o g (or actually ANY concept) might be the same as 4 | another concept by comparing their examples. Neighboring concepts are 5 | tested in order of increasing distance from the concept in the concept tree 6 | (as long as time remains). When a presumed equivalence is detected, a 7 | conjecture is asserted. Search progresses by failure (of times_up) and 8 | bactracking. */ 9 | h183(Concept):- 10 | time(Allotment), 11 | clock(Start,_), 12 | h183_do_while_time(Concept,Allotment,Start). 13 | h183(_). 14 | 15 | h183_do_while_time(Concept,Allotment,Start):- 16 | equivalent_concepts(Concept,Other_concept), 17 | assert_conjectures(Concept,Other_concept), 18 | times_up(Allotment,Start). 19 | 20 | /* equivalent_concepts finds a neighbor to the concept being tested and 21 | compares their example lists. This is done by intersecting the lists and 22 | then comparing the length of the result to the lengths of the original 23 | lists to see if all lengths are the same. If the concepts have the same 24 | examples, they are conjectured to be equivalent. */ 25 | equivalent_concepts(Concept,Other_concept):- 26 | neighborconcept(Concept,Other_concept), 27 | exs(Concept,Exs1), 28 | exs(Other_concept,Exs2), 29 | intersection(Exs1,Exs2,Int), 30 | length(Exs1,L1), 31 | length(Exs2,L2), 32 | length(Int,L1), 33 | length(Int,L2). 34 | 35 | assert_conjectures(Concept,Same_concept):- 36 | put(Concept,[conjecs],[equal,Concept,Same_concept]), 37 | put(Same_concept,[conjecs],[equal,Same_concept,Concept]), 38 | nl,nl, 39 | write('I have conjectured that '), 40 | write(Concept),write(' and '),write(Same_concept),nl, 41 | write(' are really the same.'),nl. 42 | 43 | -------------------------------------------------------------------------------- /h/h57.pl: -------------------------------------------------------------------------------- 1 | /* H57 - Any-concept.Examples.Check : 2 | If any specialization of Concept has many typical examples, all of which 3 | are also examples of Concept, then add to the concecture slot of Concept 4 | that Concept and that specialization are equivalent, (ie: that Concept is 5 | no more generalized than the "specialization"), and propose tasks to test 6 | this conjecture on the boundary examples of the specialization and to see 7 | if the specialization might be equivalent to one of its specializations. */ 8 | 9 | h57(Concept) :- 10 | time(Time), 11 | Allowed is Time/3, 12 | clock(Start,_), 13 | h34a_find_values([spec],Concept,Specs), 14 | h56_exs_typ(Concept,Typicals), 15 | length(Typicals,Length), 16 | !, 17 | Length > 10, 18 | % prevents calls to unknown clauses from suspending am. 19 | % unknown(Old,fail), 20 | h57_do_while_time(Start,Allowed,Concept,Typicals,Specs) 21 | % , unknown(fail,Old) 22 | . 23 | h57(Concept). 24 | 25 | h57_do_while_time(_,_,_,_,[]). 26 | h57_do_while_time(Start,Allowed,_,_,_) :- 27 | clock(Start,Elapsed), 28 | Elapsed > Allowed. 29 | h57_do_while_time(Start,Allowed,Concept,Typicals,[Spec|Specs]) :- 30 | get(Spec,[defn,name],[Definition]), 31 | getarity(Concept,Arity), 32 | apply_to_all(Definition,Arity,Typicals), 33 | put(Concept,[conjecs],[equal,Concept,Spec]), 34 | addtoagenda(check,Concept,[conjecs],200, 35 | 'An untested conjecture has recently been proposed.'), 36 | addtoagenda(check,Spec,[examples,typ],150, 37 | 'A generalization was recently found to be equal.'), 38 | h57_do_while_time(Start,Allowed,Concept,Typicals,Specs). 39 | h57_do_while_time(Start,Allowed,Concept,Typicals,[Spec|Specs]) :- 40 | h57_do_while_time(Start,Allowed,Concept,Typicals,Specs). 41 | 42 | -------------------------------------------------------------------------------- /h/h6.pl: -------------------------------------------------------------------------------- 1 | /******************************************************** 2 | * h6: Any entity X is interesting if it is referred * 3 | * to in several interesting conjectures. * 4 | ********************************************************/ 5 | 6 | /* The 'interesting' slot contains a list of three elements. 7 | * h6 would be the FIRST element, The second element would 8 | * be 400, and the third element would be "A concept X is 9 | * interesting if X.Conjecs contains some interesting entries" 10 | */ 11 | h6(X) :- 12 | collect([conjectures,interest],[X],Conjecs_lst), 13 | h6_int_conjecs(Conjecs_lst,[],Int_conjs), 14 | non_null_list(Int_conjs). 15 | /* akkartik: replaced periods with commas to respect indentation. */ 16 | 17 | /* The following takes a list of conjectures and adds those 18 | that are interesting to the list Oj, yielding the list, 19 | Jecs. 20 | */ 21 | h6_int_conjecs([H|T],Oj,Jecs) :- 22 | h6_interesting(H,J), 23 | h6_int_conjecs(T,[],Oj), 24 | append(J,Oj,Jecs). 25 | 26 | 27 | 28 | /* The 'interesting' slot is a list of three elements. 29 | * The first element is the 'interesting' test predicate, 30 | * the second element is the interestingness value, 31 | * and the third element is the reason. 32 | * The following checks to see if the second element meets 33 | * the criterion of being interesting. If so, it returns that 34 | * value in its second argument. Otherwise it returns []. 35 | */ 36 | h6_interesting([F,S|R],[S]) :- interesting(S). 37 | h6_interesting([F,S|R],[S]) :- veryinteresting(S). 38 | h6_interesting(_,[]). 39 | 40 | /* For now, we use the following values for 'interesting' */ 41 | veryinteresting(X) :- X >= 500. 42 | interesting(X) :- X >= 350, 43 | X < 500. 44 | somewhatinteresting(X) :- X >= 200, 45 | X =< 350. 46 | boring(X) :- X < 200. 47 | 48 | -------------------------------------------------------------------------------- /CodeLog: -------------------------------------------------------------------------------- 1 | Importing Bruce Porter's AM version in prolog. Doesn't run in gprolog - 2 | perhaps we need to mess with modules. 3 | http://www.coli.uni-saarland.de/~kris/learn-prolog-now/html/node104.html#subsec.l12.modules 4 | =-=1 - Sat Nov 29 09:30:06 PST 2008 5 | 6 | Now am.pl compiles. But what does abolish do? 7 | =-=2 - Sat Nov 29 10:40:30 PST 2008 8 | 9 | Getting the rest of the files to compile. One error remaining: 10 | h92.pl:166:58: syntax error: current or previous operator needs brackets 11 | IMPORTANT: replaced commas with periods to respect indentation in 2 heuristics. 12 | 13 | Minor fixes: 14 | disable definition: ucall/1. 15 | disable duplicate definitions: collectclauses/3 in common and utilities, print_put_trace in common and am. 16 | disable primitives: reverse, nth, list, append, member, delete, makelist. 17 | rename duplicate private definition: loop_composit/8 in h407 -> loop_composit2. 18 | 19 | update syntax for directives: abolish, public, dynamic. 20 | amutilities -> multiple files. 21 | explicitly consult files in am_init. 22 | assert -> assertz. 23 | remove no_style_check directives. 24 | multiline -> single-line strings. 25 | =-=3 - Wed Dec 3 09:36:39 PST 2008 26 | 27 | Ok, it compiles now, though I need to call load_am_files separately before am. 28 | am dies within various abolish calls that I can comment out to get it to run. 29 | Don't want to save those until I figure out what I'm doing. 30 | =-=6 - Thu Dec 4 18:43:24 PST 2008 31 | 32 | make those procedures dynamic right at the start. Now is it hung or just 33 | processing for a long time? 34 | =-=7 - Thu Dec 11 12:23:44 PST 2008 35 | No, I need to call: 36 | [am]. 37 | load_am_files. 38 | [am]. 39 | am. 40 | for it to work/hang. 41 | =-=8 - Thu Dec 11 12:28:39 PST 2008 42 | Ok, now I can start it up with just: 43 | [am]. 44 | am. 45 | =-=9 - Thu Dec 11 12:30:41 PST 2008 46 | assert->assertz in heuristics. 47 | =-=10 - Sun Dec 14 11:19:34 PST 2008 48 | -------------------------------------------------------------------------------- /h/h89.pl: -------------------------------------------------------------------------------- 1 | %break% mutate.pl 527388122 409 20 100644 16899 ` 2 | 3 | :-public([h89/1, h92/1, h300/1, h301/1]). 4 | 5 | /**************************************************************************** 6 | * 7 | * h89 generalizes a concept definition. Each generalization is formed by 8 | * dropping a condition from a clause of the original concept definition. 9 | * Tasks are suggested to fill-in the frames for each new concept. 10 | * Many of the concepts created are worthless. The user gets a chance to 11 | * throw them out of the agenda before the frames are filled-in. 12 | * This heuristic generates as many new concepts as possible by using 13 | * 1/2 of the available time. 14 | */ 15 | 16 | h89(Concept):- get(Concept,[defn,name],[Mainfunctor]), 17 | getarity(Concept,N), 18 | collectclauses(Mainfunctor,N,Clauses), 19 | time(T),T1 is T/2, clock(Start,_), 20 | h89_do_while_time(Concept,Mainfunctor,T1,Start,Clauses). 21 | h89(_). 22 | 23 | /*** h89_do_while_time drops conditions from the concept definition 24 | **** of the passed parameter Concept. Each condition deletion results 25 | **** in a new concept definition. THis process is repeated until the 26 | **** allocated time is used up (Alotment). Each new concept definition 27 | **** is displayed to the user to allow for it's renaming or deletion. 28 | **** If accepted by the user, the new concept definition is asserted. 29 | **** Note the trick for iterating through h89_do_while_time: the 30 | **** predicate times_up FAILS if there is time remaining and 31 | **** succeeds is the alloted time is used up. Failure forces backtracking 32 | **** resulting in alternative paths through dropcondition. This 33 | **** works since the effects of h89_do_while_time are achieved through 34 | **** side-effects. 35 | ***/ 36 | 37 | h89_do_while_time(Concept,Mainfunctor,Alotment,Start,Clauses):- 38 | dropcondition(Clauses,TempClauses), newdefname(gen_of_,Concept,NewName), 39 | totalreplace(Mainfunctor,NewName,TempClauses,NewClauses), 40 | not_already_defined(NewName,NewClauses), 41 | check_with_user(Concept,generalization,NewName,NewClauses,NewName2,NewClauses2), 42 | assertset(NewClauses2), 43 | updateconcepts(Concept,NewName2,genl), 44 | put_in_hierarchy(Concept,NewName2), 45 | times_up(Alotment,Start). 46 | -------------------------------------------------------------------------------- /h/h34a.pl: -------------------------------------------------------------------------------- 1 | /* H34a - Any-concept.Examples.Fillin : 2 | Finds examples of Concept by finding examples of operations whose range 3 | includes Concept. Relevent operations are found by collecting the in_ran_of 4 | values of all specializations of Concept. */ 5 | 6 | h34a(Concept) :- 7 | time(Time), 8 | Allowed is Time/3, 9 | clock(Start,_), 10 | get(Concept,[defn,name],[Definition]), 11 | exs(Concept,Old), 12 | specs_sf(Concept,Specializations), 13 | h34a_collect([in_ran_of],Specializations,Operations), 14 | h34a_collect_examples(Operations,Operation_examples), 15 | mysetof(Range, 16 | Operation^ (member(Operation,Operation_examples), 17 | lastof(Range,Operation), 18 | nonmember(Range,Old)), 19 | Op_ranges), 20 | h29_do_while_time_2(Start,Allowed,Definition,Arity,Op_ranges,Examples), 21 | clock(Start,Elapsed), 22 | h29_add_and_check_new_values(Concept,[examples,typ],Examples,Elapsed). 23 | 24 | /* H34a_collect(Slot,Concepts,Values) - 25 | Values returns the set containing all the unique values of Slot for each of 26 | the Concepts. */ 27 | 28 | h34a_collect(_,[],[]). 29 | h34a_collect(Slot,[Concept|Concepts],Values) :- 30 | h34a_find_values(Slot,Concept,Concept_values), 31 | h34a_collect(Slot,Concepts,More_values), 32 | append(Concept_values,More_values,All_values), 33 | removedups(All_values,Values). 34 | 35 | /* H34a_find_values(Slot,Concept,Values) - 36 | Values returns the Slot values for Concept. When Concept has no value for 37 | Slot, a task is proposed to fillin the Slot for Concept. */ 38 | 39 | h34a_find_values(Slot,Concept,[Val1|Values]) :- 40 | get(Concept,Slot,[Val1|Values]),!. 41 | h34a_find_values(Slot,Concept,[]) :- 42 | addtoagenda(fillin,Concept,Slot,100, 43 | 'Examples might help find operations with a particular range'). 44 | 45 | /* H43a_collect_examples(Concepts,Examples) - 46 | Examples returns the set of examples for each concept in Concepts 47 | */ 48 | 49 | h34a_collect_examples([],[]). 50 | h34a_collect_examples([Concept|Concepts],Examples) :- 51 | find_examples(Concept,Concept_examples), 52 | h34a_collect_examples(Concepts,More_examples), 53 | append(Concept_examples,More_examples,All_examples), 54 | removedups(All_examples,Examples). 55 | 56 | nonmember(_,[]). 57 | nonmember(X,L) :- \+member(X,L). 58 | 59 | -------------------------------------------------------------------------------- /h/h199.pl: -------------------------------------------------------------------------------- 1 | /* H199,H200,H201,H202 combined-p.267-- 2 | When coalescing F(a,b,c,..), whose domain/range is R>, 3 | a good choice of 2 domain components to coalesce is : 4 | 1) a pair of identically equal ones.To fill in alg. for new 5 | coalesced version , call on F.alg with 2 args. the same. To fill in 6 | defn. of new coalesced version , call on F.defn with 2 args the same. 7 | 2) barring that, choose a pair related by specialization 8 | (eliminate the more general one). 9 | 3) barring that, choose a pair with a common specialization S 10 | and replace both by S. 11 | When filling in worth of a new coalesced version of F,a suitable value 12 | is 0.9*(worth of F) + 0.1*(worth of coalesce). */ 13 | 14 | h199(F) :- get(F,[dom_range],D_r), 15 | split_last(D_r,D,R), 16 | h199_coalesce(F,D), 17 | put(F,[coalesce],true). 18 | 19 | h199(F) :- put(F,[coalesce],nil). 20 | 21 | 22 | h199_coalesce(F,D) :- h199_equal(D,F). 23 | h199_coalesce(F,D) :- h199_related(D,F). 24 | h199_coalesce(F,D) :- h199_comm_spec(D,F). 25 | 26 | h199_equal([[]|_],_) :- fail. 27 | h199_equal([H|T],F) :- member(H,T), 28 | fremove(F,[dom_range],H). 29 | h199_equal([H|T],F) :- h199_equal(T,F). 30 | 31 | h199_related(D,F) :- rel_by_gen(D,F). 32 | h199_related(D,F) :- rel_by_spec(D,F). 33 | 34 | rel_by_gen([[]|_],_) :- fail. 35 | rel_by_gen([H|T],F) :- get(H,[gen1],Gen), 36 | intersection(Gen,T,[C|C1]), 37 | nonnull(C), 38 | fremove(F,[dom_range],C). 39 | rel_by_gen([H|T],F) :- rel_by_gen(T,F). 40 | 41 | rel_by_spec([[]|_],_) :- fail. 42 | rel_by_spec([H|T],F) :- get(H,[spec],Spec), 43 | intersection(Spec,T,[C|C1]), 44 | nonnull(C), 45 | fremove(F,[dom_range],H). 46 | rel_by_spec([H|T],F) :- rel_by_spec(T,F). 47 | 48 | h199_comm_spec([[]|_],_) :- fail. 49 | h199_comm_spec([H|T],F) :- 50 | get(H,[spec],Spec), 51 | common(Spec,T,H1,X), 52 | fremove(F,[dom_range],H), 53 | fremove(F,[dom_range],H1), 54 | put(F,[dom_range],X). 55 | 56 | h199_comm_spec([H|T],F) :- h199_comm_spec(T,F). 57 | 58 | common(L1,[[]|_],_,_) :- fail. 59 | common(L1,[H|L2],H,C) :- get(H,[spec],Spec), 60 | intersection(L1,Spec,[C|C1]), 61 | nonnull(C). 62 | common(L1,[H|L2],H,C) :- common(L1,L2,H1,X). 63 | 64 | /* End of H199 */ 65 | 66 | -------------------------------------------------------------------------------- /h/h56.pl: -------------------------------------------------------------------------------- 1 | /* H56 - Any-concept.Examples.Check : 2 | If any generalization of Concept has many typical examples, all of which 3 | are also examples of Concept, then add to the conjectures of Concept that 4 | Concept and the generalization are equivalent, (ie: Concept is really no 5 | more specialized than the "generalization"), and test this conjecture on 6 | the boundary examples of the generalization, and see if the generalization 7 | might be no more specialized than one of its generalizations. */ 8 | 9 | h56(Concept) :- 10 | time(Time), 11 | Allowed is Time/3, 12 | clock(Start,_), 13 | !, 14 | get(Concept,[defn,name],[Definition]), 15 | h34a_find_values([genl],Concept,Genls), 16 | % prevents calls to unknown clauses from suspending am. 17 | % unknown(Old,fail), 18 | h56_do_while_time(Start,Allowed,Concept,Definition,Genls) 19 | %, 20 | % unknown(fail,Old) 21 | . 22 | 23 | h56_do_while_time(_,_,_,_,[]). 24 | h56_do_while_time(Start,Allowed,_,_,_) :- 25 | clock(Start,Elapsed), 26 | Elapsed > Allowed. 27 | h56_do_while_time(Start,Allowed,Concept,Definition,[Genl|Genls]) :- 28 | h56_exs_typ(Genl,Typical_examples), 29 | length(Typical_examples,Length), 30 | Length > 10, 31 | getarity(Concept,Arity), 32 | apply_to_all(Definition,Arity,Typical_examples), 33 | put(Concept,[conjecs],[equal,Concept,Genl]), 34 | addtoagenda(check,Concept,[conjecs],200, 35 | 'An untested conjecture has recently been proposed'), 36 | addtoagenda(check,Genl,[examples,typ],150, 37 | 'A specialization was recently found to be equal'), 38 | h56_do_while_time(Start,Allowed,Concept,Definition,Genls). 39 | h56_do_while_time(Start,Allowed,Concept,Definition,[Genl|Genls]) :- 40 | h56_do_while_time(Start,Allowed,Concept,Definition,Genls). 41 | 42 | /* H56_exs_typ(Concept,Examples) - 43 | Examples returns all the typical examples of Concept and all of 44 | its specializations; (based on procedure exs). */ 45 | 46 | h56_exs_typ(Concept,Examples) :- 47 | ripple(down,Concept,Specializations), 48 | exs_typ1(Specializations,Exs), 49 | exs_typ2(Exs,Examples), 50 | !. 51 | 52 | exs_typ1([],[]). 53 | exs_typ1([H|T],Examples) :- 54 | get(H,[examples,typ],Typ1), 55 | exs_typ1(T,Typ2), 56 | append(Typ1,Typ2,Examples). 57 | 58 | exs_typ2([],[]). 59 | exs_typ2([H|T],Examples) :- 60 | ripple(down,H,Typ1), 61 | exs_typ2(T,Typ2), 62 | append(Typ1,Typ2,Examples). 63 | 64 | /* Apply_to_all(Predicate,Arglists) - 65 | Is satisfied when Predicate is satisfied by each argument list in Arglists. 66 | */ 67 | apply_to_all(_,_,[]). 68 | apply_to_all(Predicate,Arity,[Arglist|Arglists]) :- 69 | makeinst(Predicate,Arity,Arglist,Call), 70 | Call, 71 | /* apply(Predicate,[Arglist]), */ 72 | !, 73 | apply_to_all(Predicate,Arity,Arglists). 74 | 75 | -------------------------------------------------------------------------------- /h/h123.pl: -------------------------------------------------------------------------------- 1 | :- public(h123/1). 2 | /********************************************************************** 3 | * 4 | * h123 finds examples of active concept Con by collecting examples 5 | * from the domain of Con, running Con.alg, making the example 6 | * entry [d1,d2,...dn,v] where v is the output of the alg. 7 | * 8 | * h123 will use time proportional to the number of examples 9 | * found in the domain of CON. 10 | */ 11 | 12 | /******************************************************** 13 | * NEW VERSION -SMARTER 14 | * NOTE: this heuristic will not work on predicate because 15 | * Predicates do not really have a range. They should really 16 | * return true/false as a third argument. Until they do, 17 | * This heuristic will only work on relations/operations 18 | */ 19 | 20 | h123(C) :- 21 | get(C,[dom_range],[]), 22 | addtoagenda(fillin,C,[dom_range],200,'No current value for this slot'). 23 | h123(C) :- 24 | get(C,[dom_range],D_r), 25 | get(C,[alg],[Alg]), 26 | get_doms(D_r,D), 27 | getunique_dom(D,D_unique), 28 | collect_exs(D_unique,D_exs), 29 | fillin_if_few(D_exs), 30 | compute_time(D_exs,T), 31 | do_while_time(T,C,D,D_exs,Alg). 32 | 33 | 34 | /* note that dwt generates at most 25 examples from each d/r pair */ 35 | 36 | do_while_time(_,C,[],_,_). 37 | do_while_time(Allot,C,[D|R],D_exs,Alg) :- 38 | clock(Start,_), 39 | dwt(Start,Allot,C,D,D_exs,Alg), 40 | clock(Start,T), 41 | cleanup_a(h123,Num), 42 | ((Num > 0, 43 | addtoagenda(check,C,[examples],200,'just found examples of con'), 44 | put(C,[examples,dif],[Num,T])); 45 | true), 46 | do_while_time(Allot,C,R,D_exs,Alg). 47 | 48 | dwt(Start,Allot,Con,D,D_exs,Alg) :- 49 | ok_a(Start,Allot), 50 | get_rand_args(D,D_exs,Args), 51 | append(Args,[Val],Ex), 52 | apply(Alg,Ex), 53 | put(Con,[examples,typ],Ex), 54 | addnum_a(h123), 55 | termination_a(h123,Start,Allot). 56 | 57 | 58 | 59 | get_rand_args([],_,[]) :- !. 60 | get_rand_args([D|DD],D_exs,[A|AA]) :- 61 | get_rand_args(DD,D_exs,AA), 62 | member([D,N,L],D_exs), 63 | random(N,Rand), 64 | nth(L,Rand,A),!. 65 | 66 | get_doms([],[]). 67 | get_doms([H|T],[D|DT]) :- 68 | split_last(H,D,_), 69 | get_doms(T,DT). 70 | 71 | getunique_dom(D,D_unique) :- 72 | flatten(D,D_flat), 73 | removedups(D_flat,D_unique). 74 | 75 | collect_exs([],[]). 76 | collect_exs([D|R],[[D,N,Exs]|Rest]) :- 77 | collect_exs(R,Rest), 78 | exs(D,Exs), 79 | length(Exs,N). 80 | 81 | fillin_if_few([]). 82 | fillin_if_few([[D,N,_]|R]) :- 83 | N < 5, 84 | addtoagenda(fillin,D,[examples],150,'there are few examples of con'), 85 | fillin_if_few(R). 86 | fillin_if_few([H|T]) :- fillin_if_few(T). 87 | 88 | /* compute the time alloted to each element of the d-r slot */ 89 | compute_time(D_exs,T) :- 90 | time(T1), 91 | length(D_exs,N), 92 | T is (T1 / 3 * 2)/N. 93 | 94 | -------------------------------------------------------------------------------- /h/h408.pl: -------------------------------------------------------------------------------- 1 | 2 | /* this is another attemp to have a heuristic that makes multiple attempts 3 | at doing something repetitively. I am assuming that the number of 4 | repetitions it not crucial. And of course it runs both forwards and 5 | backwards! It also runs with just one var as input. That is to say 6 | the above applies to the defns and the algs that this heuristic 7 | creates! -marcos */ 8 | 9 | 10 | h408(C):- 11 | get(C,[worth],[Worth]), 12 | Worth >= 100, 13 | get(C,[defn,name],[CON_NAME]), 14 | getarity(C,N), 15 | do_while_time(C,CON_NAME,Worth,N). 16 | 17 | do_while_time(C,Defn_Name,Worth,N):- 18 | Times is Worth/10, 19 | makename(Defn_Name,'_X_',Temp), 20 | makename(Temp,Times,NewC_Dname), 21 | makeit(Defn_Name,N,Worth,Alg,NewC_Dname), 22 | get(C,[dom_range],Dom_range), Conceptname = NewC_Dname, 23 | /* check_with_user(),*/ 24 | write(Alg), 25 | create_composite_concept(C,NewC_Dname,Alg,Dom_range). 26 | 27 | create_composite_concept(F,Conceptname,Alg,Dom_range):- 28 | put(Conceptname,[name],Conceptname), 29 | put(Conceptname,[defn,name],Conceptname), 30 | put(Conceptname,[alg],Conceptname), 31 | assertz(frame(Conceptname,[dom_range],Dom_range)), 32 | put(Conceptname,[genl],F), 33 | get(F,[worth],[W1]), 34 | put(Conceptname,[worth],W1), 35 | addtoagenda(fillin,Conceptname,[examples],W1, 36 | 'no examples of this new concept'). 37 | 38 | 39 | 40 | makeit(D,N,Worth,Alg,Name):- 41 | Count is Worth/10, 42 | makelist(N,List), 43 | split_last(List,Domain,Range), 44 | split_last(Domain,D1,D2), 45 | append(Domain,[D2],List2), 46 | append(Domain,[OutPut],List4), 47 | append(D1,[Range,OutPut],List3), 48 | Pred1 =.. [D|List], 49 | Pred2 =.. [Name|List2], 50 | Pred3 =.. [Name|List3], 51 | Pred4 =.. [Name|List4], 52 | makename(Name,'count',NewName), 53 | CP1 =.. [NewName|[Count1]], 54 | CP2 =.. [NewName|[Count2]], 55 | 56 | C0 = (Pred2:- CP1,Count1 > Count, retract(CP2)), 57 | C1 = (Pred4:- Pred1, (retract(CP1); 58 | Count1 = 0), Count2 is Count1 + 1, 59 | assertz(CP2), 60 | Pred3), 61 | assertz(C1), 62 | asserta(C0),nl, write(C0),nl, write(C1),nl,Alg=[C0,C1]. 63 | 64 | 65 | 66 | 67 | /* 68 | callit(D,[],WholeExs,N,Output,Count,Worth,Start,LastR):- 69 | End = Start + 20, 70 | clock(End,End2), 71 | End2 < 0, 72 | callit(D,WholeExs,WholeExs,N,Output,Count,Worth,Start,LastR). 73 | 74 | callit(Dname,[E1|Rest],WholeExs,N,Output,Count,Worth,Start,LastR):- 75 | End = Start + 10, 76 | clock(End,End2), 77 | End2 < 0, 78 | split_last(E1,Range,Dom), 79 | ((var(LastR),Range2 = Range); 80 | (split_last(Range,[R1],R2), 81 | append(R1,LastR,Range2))) 82 | append(Range2,[Dom2],RDList), 83 | Pred =..[Dname|RDList], 84 | Count2 is Count + 1, 85 | callit(Dname,Rest,WholeExs,N,Output,Count2,Worth,Start,Dom2). 86 | 87 | callit(Dname,_,_,N,Output,Count,Worth,Start,Output):- 88 | End = Start + 10, 89 | clock(End,End2), 90 | End2 >= 0. 91 | 92 | 93 | 94 | 95 | */ 96 | 97 | 98 | -------------------------------------------------------------------------------- /h/h61b.pl: -------------------------------------------------------------------------------- 1 | /* H61b - Any-concept.Examples,typical.Check : 2 | 3 | *** Encodes H59, H61, and H62 for boundary examples 4 | 5 | Ensure boundary examples satisfy the Concept's definition, then see if they 6 | also satisfy any specialization definition. If so, then remove them from 7 | the Concept's boundary examples list and add them to those specializations' 8 | typical examples lists. When any example fails to satisfy the Concept's 9 | definition then remove it from the Concept's examples list and see if it 10 | satisfies any generalization of the concept. If so, then add it to the 11 | boundary examples lists of those generalizations. */ 12 | 13 | h61b(Concept) :- 14 | time(Time), 15 | Allowed is Time/3, 16 | clock(Start,_), 17 | !, 18 | get(Concept,[defn,name],[Defn]), 19 | h34a_find_values([spec],Concept,Specs), 20 | h34a_find_values([genl],Concept,Genls), 21 | h34a_find_values([examples,bnd],Concept,Examples), 22 | h61b_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 23 | 24 | /* h61b_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls) - 25 | While time remains, h61b_do_while_time processes each example of Concept 26 | in Examples, ensuring that it is appropriately included as an example of 27 | Concept and should not be moved to the examples list of some specialization 28 | or generalization of Concept. */ 29 | 30 | h61b_do_while_time(_,_,_,_,[],_,_). 31 | h61b_do_while_time(Start,Allowed,_,_,_,_,_) :- 32 | clock(Start,Elapsed), 33 | Elapsed > Allowed. 34 | h61b_do_while_time(Start,Allowed,Concept,Defn,[Example|Examples],Specs,Genls):- 35 | getarity(Concept,Arity), 36 | makeinst(Defn,Arity,Example,Call), 37 | Call, 38 | % apply(Defn,[Example]), 39 | h61b_put_if_example(Concept,Example,Specs,[examples,typ]), 40 | h61b_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 41 | h61b_do_while_time(Start,Allowed,Concept,Defn,[Example|Examples],Specs,Genls):- 42 | fremove(Concept,[examples,bnd],Example), 43 | h61b_put_if_example(Concept,Example,Genls,[examples,bnd]), 44 | h61b_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 45 | 46 | /* h61b_put_if_example(Concept,Example,Specs,Slot) - 47 | Specs is either the generalizations or the specializations of Concept. 48 | Example is a boundary example of Concept, and is tested to see if it 49 | satisfies any of the concepts in Specs. When any such member of Specs 50 | is found, Example is removed from the examples list of Concept and is 51 | added to the Slot examples list of that concept from Specs. Slot is 52 | assumed to be [examples,typ] when specs are Concept's specializations; 53 | Slot is [examples,bnd] when Specs are Concept's generalizations. 54 | */ 55 | h61b_put_if_example(_,_,[],_). 56 | h61b_put_if_example(Concept,Example,[Spec|Specs],Slot) :- 57 | get(Spec,[defn,name],[Defn]), 58 | getarity(Concept,Arity), 59 | makeinst(Defn,Arity,Example,Call), 60 | Call, 61 | % apply(Defn,[Example]), 62 | fremove(Concept,[examples,bnd],Example), 63 | put_if_more_examples_needed(Spec,Slot,Example), 64 | h61b_put_if_example(Concept,Example,Specs,Slot). 65 | h61b_put_if_example(Concept,Example,[Spec|Specs],Slot) :- 66 | h61b_put_if_example(Concept,Example,Specs,Slot). 67 | 68 | -------------------------------------------------------------------------------- /descriptions.pl: -------------------------------------------------------------------------------- 1 | /* Here is a list of people who have implemented the heuristics so far. 2 | adam = Adam Farquhar 3 | annanya = Annanya ? (ask adam) 4 | bruce = Dr. Bruce Porter 5 | ken = Ken Murray 6 | kim = Kim Matocha 7 | marcos = M.V. LaPolla 8 | martin = Dr. Martin Purvis 9 | ray = Ray Bareiss 10 | todd = Todd Stock 11 | */ 12 | 13 | descr(h1,'Boost worth of recently referenced concepts',adam). 14 | descr(h6,'C is interesting if refered to in interesting conjectures',martin). 15 | descr(h12,'Fillin all blank facets -go get some coffee',adam). 16 | descr(h14,'After dealing with C, boost Cons that use C',adam). 17 | descr(h17,'C is interesting if C.conjecs has interesting entries',martin). 18 | descr(h20,'C is interesting if its boundary corresponds another con', martin). 19 | descr(h23,'C is interesting if it satisfies some rare predicate',martin). 20 | descr(h28, 'Same idea as 114',marcos). 21 | descr(h29,'Find exs of X by looking at exs of more gen cons',ken). 22 | descr(h31,'Find exs of X by unfolding its definition',adam). 23 | descr(h34a,'Find exs of X by looking at ops whose range is X',ken). 24 | descr(h34b,'Find exs of X by looking at ops whose domain is X',ken). 25 | descr(h36, 'h36',marcos). 26 | descr(h40,'Find exs of X by looking at first cousins of X',ken). 27 | descr(h43,'If X and Y share many examples, then create their intersection', adam). 28 | descr(h44,'If there are very few exs of C, then generalize it',adam). 29 | descr(h45,'If there are very many exs of C, then specialize it',adam). 30 | descr(h46,'If there are no exs of C, then find some',adam). 31 | descr(h50,'After filling in exs of C, check them',adam). 32 | descr(h56,'If a gen of C has same exs as C, they may be the same',ken). 33 | descr(h57,'If a spec of C has same exs as C, they may be the same',ken). 34 | descr(h59a,'Check exs of C against the defn of C',anonymous). 35 | descr(h59c,'Prune the exs slot of C to a size reflecting its worth',anonymous). 36 | descr(h61a,'Move typical exs to as specific a con as possible',ken). 37 | descr(h61b,'Move bnd exs to as specific a con as possible',ken). 38 | descr(h89,'Generalize C by dropping conjuncts',bruce). 39 | descr(h92,'Specialize C by dropping disjuncts',bruce). 40 | descr(h110,'Make sure that no specs of S are the same',annanya). 41 | descr(h111,'If a gen & spec of C have a common elem, they may be the same', annanya). 42 | descr(h114, 'If C1 is a genl of C2 if C2 is a fenl of C3 ... if Ck is a genl of Cn then merge and increase the value of the highest value to begin with',marcos). 43 | descr(h114a, 'Same idea as 114 with a few mods',marcos). 44 | descr(h116,'Fillin in_dom_of by finding what can be run on C',annanya). 45 | descr(h117,'Fillin in_ran_of by finding ops that yield Cs',annanya). 46 | descr(h123,'Fillin exs of op by running it on domain exs',adam). 47 | descr(h124,'Fillin dom_range of C by finding where C is defined',annanya). 48 | descr(h174,'Create the composition FoG',ray). 49 | descr(h180,'Fillin exs of FoG by using exs of F and G',ray). 50 | descr(h183,'Check that FoG is different than F or G',ray). 51 | descr(h199,'Coalesce C',annanya). 52 | descr(h204,'Creating f-itself',annanya). 53 | descr(h240,'Find exs of mult elem by repeating elems of no-mult-elem', annanya). 54 | descr(h300,'Generalize concept definition by generalizing a predicate',todd). 55 | descr(h301,'Specialize concept definition by specializing a predicate',kim). 56 | 57 | descr(h402, 'If number of examples are between 5 and 30 incr worth',marcos). 58 | descr(h407, 'If a concept is worthwhile then compose it with itself',marcos). 59 | descr(h408, 'If a concept if worthwhile do it again',marcos). 60 | descr(h409, 'If a concept is ww then invert it',marcos). 61 | -------------------------------------------------------------------------------- /h/h61a.pl: -------------------------------------------------------------------------------- 1 | /* H61a - Any-concept.Examples,typical.Check : 2 | 3 | *** Encodes H59, H61, and H62 for typical examples 4 | 5 | Ensure typical examples satisfy the Concept's definition, then see if they 6 | also satisfy any specialization definition. If so, then remove them from 7 | the Concept's typical examples list and add them to those specializations' 8 | typical examples lists. When any example fails to satisfy the Concept's 9 | definition then remove it from the Concept's examples list and see if it 10 | satisfies any generalization of the concept. If so, then add it to the 11 | boundary examples lists of those generalizations. */ 12 | h61a(Concept) :- 13 | time(Time), 14 | Allowed is Time/3, 15 | clock(Start,_), 16 | !, 17 | get(Concept,[defn,name],[Defn]), 18 | h34a_find_values([spec],Concept,Specs), 19 | h34a_find_values([genl],Concept,Genls), 20 | h34a_find_values([examples,typ],Concept,Examples), 21 | h61a_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 22 | 23 | /* h61a_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls) - 24 | While time remains, h61a_do_while_time processes each example of Concept 25 | in Examples, ensuring that it is appropriately included as an example of 26 | Concept and should not be moved to the examples list of some specialization 27 | or generalization of Concept. */ 28 | 29 | h61a_do_while_time(_,_,_,_,[],_,_). 30 | h61a_do_while_time(Start,Allowed,_,_,_,_,_) :- 31 | clock(Start,Elapsed), 32 | Elapsed > Allowed. 33 | h61a_do_while_time(Start,Allowed,Concept,Defn,[Example|Examples],Specs,Genls):- 34 | getarity(Concept,Arity), 35 | makeinst(Defn,Arity,Example,Call), 36 | Call, 37 | /* apply(Defn,[Example]), */ 38 | h61a_put_if_example(Concept,Example,Specs,[examples,typ]), 39 | h61a_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 40 | h61a_do_while_time(Start,Allowed,Concept,Defn,[Example|Examples],Specs,Genls):- 41 | fremove(Concept,[examples,typ],Example), 42 | h61a_put_if_example(Concept,Example,Genls,[examples,bnd]), 43 | h61a_do_while_time(Start,Allowed,Concept,Defn,Examples,Specs,Genls). 44 | 45 | /* h61a_put_if_example(Concept,Example,Specs,Slot) - 46 | Specs is either the generalizations or the specializations of Concept. 47 | Example is a typical example of Concept, and is tested to see if it 48 | satisfies any of the concepts in Specs. When any such member of Specs 49 | is found, Example is removed from the examples list of Concept and is 50 | added to the Slot examples list of that concept from Specs. Slot is 51 | assumed to be [examples,typ] when Specs are Concept's specializations; 52 | Slot is [examples,bnd] when Specs are Concept's generalizations. */ 53 | 54 | h61a_put_if_example(_,_,[],_). 55 | h61a_put_if_example(Concept,Example,[Spec|Specs],Slot) :- 56 | get(Spec,[defn,name],[Defn]), 57 | getarity(Concept,Arity), 58 | makeinst(Defn,Arity,Example,Call), 59 | Call, 60 | /* apply(Defn,[Example]), */ 61 | fremove(Concept,[examples,typ],Example), 62 | 63 | /* get(Concept,[examples,dif],[Num,Time]), 64 | Dif is Num/Time, 65 | put(Spec,[examples,dif],[1,Dif]), 66 | */ 67 | put_if_more_examples_needed(Spec,Slot,Example), 68 | h61a_put_if_example(Concept,Example,Specs,Slot). 69 | 70 | h61a_put_if_example(Concept,Example,[Spec|Specs],Slot) :- 71 | h61a_put_if_example(Concept,Example,Specs,Slot). 72 | 73 | /* put_if_more_examples_needed(Concept,Example) - 74 | Determines if Concept is important enough to store more examples of the 75 | Concept than is already stored, and if so, stores Example in Slot. 76 | */ 77 | put_if_more_examples_needed(Concept,Slot,Example) :- 78 | exs(Concept,Examples), 79 | length(Examples,Number), 80 | more_values_needed(Concept,Slot,Number), 81 | put(Concept,Slot,Example), 82 | addtoagenda(check,Concept,[examples,typ],100,'Check new examples'). 83 | put_if_more_examples_needed(_,_,_). 84 | 85 | /* more_values_needed(Concept,Slot,Number) - 86 | Determines by the worth of a Concept and its Slot if there is justification 87 | to store more values for the Concept's Slot. Number is the current number 88 | of values stored for the Slot. 89 | */ 90 | more_values_needed(_,_,Number) :- 91 | Number < 15,!. 92 | more_values_needed(Concept,Slot,Number) :- 93 | get(Concept,[worth],[Concept_worth]), 94 | worth(Slot,Slot_worth), 95 | Value_limit is Concept_worth * Slot_worth / 4000, 96 | Number =< Value_limit, 97 | Number =< 60. 98 | 99 | -------------------------------------------------------------------------------- /h/old-h174.pl: -------------------------------------------------------------------------------- 1 | /* This is Ray's original code: 2 | 3 | :-public h174/2. 4 | ?-no_style_check(all). 5 | 6 | 7 | 8 | 9 | 10 | /* h174 creates a new operation by composing two existing operations.In clausal 11 | form, the composition is expressed as fog(a,b,c,y):-g(a,b,c,x),f(x,y) which 12 | is equivalent to f(g(a,b,c)) in functional notation. First function f is 13 | checked to make sure that it has "arity" 2 (one input and one output 14 | parameter). Next the lists of valid domains and ranges of the two functions 15 | are checked to find a valid composite domain-range. Then the new algorithm 16 | is created as a single prolog clause and is asserted. Finally a new concept 17 | frame is filled in. Note that this heuristic is not really very useful 18 | given the operations that we have defined; this is because very few of 19 | our operations are of arity 2 with one input and one output parameter. */ 20 | 21 | h174(_) :- fail. 22 | h174(F,G):- 23 | getarity(F,2), 24 | get(F,[dom_range],Fdr), 25 | get(G,[dom_range],Gdr), 26 | get_composite_dr(Fdr,Gdr,FoGdr), 27 | make_composite_alg(F,G,FoGdr,Newname,Alg), 28 | create_composite_concept(F,G,Newname,Alg,FoGdr). 29 | 30 | /* get_composite_dr finds a legal domain-range for the composition. It searches 31 | the domain-range lists of f and g for a pair such that the 32 | range of g is the domain of f. The legal composite is g's domain and f's 33 | range. */ 34 | get_composite_dr(Fdr,Gdr,FoGdr):- 35 | member(X,Gdr), 36 | split_last(X,Gdom,Grange), 37 | genls_sf(Grange,Gens_of_grange), 38 | member([Fdom,Frange],Fdr), 39 | member(Fdom,Gens_of_grange), 40 | append(Gdom,[Frange],FoGdr). 41 | 42 | /* make_composite_alg creates f o g in clausal form. First it gensyms a list 43 | of symbols to serve as variables in the clause. Then it assigns them to 44 | g's domain, g's range(1), and f's range(1). Then a new clause is synthesized 45 | and given the tentative name F_o_G (where F_o_G(...Y):-G(...X),F(X,Y).). 46 | Finally the user is shown the composition and is given a chance to reject it 47 | or to rename it, then the algorithm is asserted. */ 48 | make_composite_alg(F,G,FoGdr,Newname2,Alg):- 49 | length(FoGdr,N),N1 is N+1, 50 | makelist(N1,[Frange,Grange|Gdom]), 51 | append(Gdom,[Grange],T1), 52 | T2=[Grange,Frange], 53 | get(F,[defn,name],[Main_functor_F]), 54 | get(G,[defn,name],[Main_functor_G]), 55 | Func1=..[Main_functor_G|T1], 56 | Func2=..[Main_functor_F|T2], 57 | makename(F,'_o_',Temp), 58 | makename(Temp,G,Newname), 59 | append(Gdom,[Frange],Newdr), 60 | Func3=..[Newname|Newdr], 61 | Alg=(Func3:-Func1,Func2),!, 62 | check_with_user2(F,G,Newname,Alg,Newname2), 63 | Func4=..[Newname2|Newdr], 64 | Alg2=(Func4:-Func1,Func2), 65 | assertz(Alg2). 66 | 67 | /* create_composite_concept creates a concept frame for the new operation. 68 | Then a task is added to the agenda to generate examples of the new 69 | concept. */ 70 | create_composite_concept(F,G,Conceptname,Alg,Dom_range):- 71 | put(Conceptname,[name],Conceptname), 72 | put(Conceptname,[defn,name],Conceptname), 73 | put(Conceptname,[alg],Conceptname), 74 | put(Conceptname,[dom_range],Dom_range), 75 | put(Conceptname,[genl],F), 76 | put(Conceptname,[genl],G), 77 | put(Conceptname,[compose],[F,G]), /* pseudo-facet identifies composition 78 | */ 79 | get(F,[worth],[W1]), 80 | get(G,[worth],[W2]), 81 | New_worth is (W1+W2)/2, 82 | put(Conceptname,[worth],New_worth), 83 | addtoagenda(fillin,Conceptname,[examples],200, 84 | 'no examples of this new concept'). 85 | 86 | /* check_with_user2 allows the user to discard or rename a newly created 87 | composition. If he/she renames the concept, the new name is returned. 88 | Note that this routine is very similar to check_with_user written by Bruce. 89 | */ 90 | check_with_user2(F,G,Newname,Alg,Newname2):- 91 | nl,nl, 92 | write('I have created a new concept definition which is a composition of 93 | '),nl, 94 | write(F),write(' and '),write(G),nl, 95 | write('This concept is defined as follows:'),nl, 96 | write(Alg),nl, 97 | write('Do you want to keep this new concept (y/n)? '), 98 | nl,aminput('y'), 99 | write('Please type new name for this concept or to keep the current 100 | name: '), 101 | nl,aminput(X), 102 | ((X='',Newname2=Newname); 103 | (\+ X='',Newname2=X)). 104 | 105 | 106 | 107 | */ 108 | -------------------------------------------------------------------------------- /h/h29.pl: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | /* H29 - Any-concept.Examples.Fillin : 24 | To fill in examples of X, where X is a kind of Y (for some more general 25 | concept Y), inspect the examples of Y; some of them may be examples of X 26 | as well. */ 27 | 28 | h29(Concept) :- 29 | get(Concept,[genl],[]), 30 | addtoagenda(fillin,Concept,[genl],200, 31 | 'Generalizations might be helpful for finding examples.'). 32 | h29(Concept) :- 33 | time(Time), 34 | Allowed is Time / 4, 35 | clock(Start,_), 36 | get(Concept,[defn,name],[Definition]), 37 | getarity(Concept,Arity), 38 | exs(Concept,Old), 39 | genls_sf(Concept,[Concept|Superset]), 40 | h29_do_while_time_1(Start,Allowed,Definition,Arity,Superset,Old,Examples), 41 | clock(Start,Elapsed), 42 | h29_add_and_check_new_values(Concept,[examples,typ],Examples,Elapsed). 43 | 44 | /* h29_do_while_time_1(Start,Allowed,Definition,Superset,Prior,Examples) - 45 | Examples returns those examples of the concepts in Superset which satisfy 46 | the predicate Definition and can be identified within Allowed time. Prior 47 | keeps track of what items have already been tried. */ 48 | 49 | h29_do_while_time_1(_,_,_,_,[],_,[]). 50 | h29_do_while_time_1(Start,Allowed,_,_,_,_,[]) :- 51 | clock(Start,Elapsed), 52 | Elapsed > Allowed. 53 | h29_do_while_time_1(Start,Allowed,Definition,Arity, 54 | [Genl|Superset],Prior,Examples) :- 55 | getarity(Genl,Arity), 56 | find_examples(Genl,Genl_examples), 57 | setdiff(Genl_examples,Prior,New_items), 58 | append(New_items,Prior,Old), 59 | h29_do_while_time_2(Start,Allowed,Definition,Arity,New_items,Exs), 60 | h29_do_while_time_1(Start,Allowed,Definition,Arity, 61 | Superset,Old,More_exs), 62 | append(Exs,More_exs,Examples). 63 | h29_do_while_time_1(Start,Allowed,Definition,Arity, 64 | [Genl|Superset],Prior,Examples) :- 65 | h29_do_while_time_1(Start,Allowed,Definition,Arity, 66 | Superset,Prior,Examples). 67 | 68 | /* h29_do_while_time_2(Start,Allowed,Definition,Arity,Genl_examples,Examples) - 69 | Examples returns those examples in Genl_examples which satisfy the 70 | predicate Definition and can be identified within Allowed time. */ 71 | 72 | h29_do_while_time_2(_,_,_,_,[],[]). 73 | h29_do_while_time_2(Start,Allowed,_,_,_,[]) :- 74 | clock(Start,Elapsed), 75 | Elapsed > Allowed. 76 | h29_do_while_time_2(Start,Allowed,Definition,Arity,[Ex|Genl_exs],[Ex|Examples]):- 77 | makeinst(Definition,Arity,Ex,Call), 78 | Call, 79 | h29_do_while_time_2(Start,Allowed,Definition,Arity,Genl_exs,Examples). 80 | h29_do_while_time_2(Start,Allowed,Definition,Arity,[Non_ex|Genl_exs],Examples):- 81 | h29_do_while_time_2(Start,Allowed,Definition,Arity,Genl_exs,Examples). 82 | 83 | 84 | /* h29_add_and_check_new_values(Concept,Slot,Values,Time) - 85 | New examples of Concept, if any, are added to example slot Slot, updating 86 | the [examples,diff] slot of Concept and proposing the task of checking the 87 | examples of Concept. */ 88 | 89 | h29_add_and_check_new_values(Concept,Slot,Values,Time) :- 90 | get(Concept,Slot,Old_values), 91 | setdiff(Values,Old_values,New_values), 92 | length(New_values,Number), 93 | put(Concept,[examples,dif],[Number,Time]), 94 | review_new_values(Concept,Slot,New_values). 95 | h29_add_and_check_new_values(Concept,Slot,Values,Time). 96 | 97 | /* find_examples(Concept,Examples) - 98 | Examples returns the examples, (both boundary and typical), of Concept. If 99 | no examples are available, a task is proposed to discover some. */ 100 | 101 | find_examples(Concept,[Example|Examples]) :- 102 | exs(Concept,[Example|Examples]),!. 103 | 104 | find_examples(Concept,[]) :- 105 | addtoagenda(fillin,Concept,[examples,typ],200, 106 | 'Examples might be helpful for finding examples of a specialization'). 107 | 108 | /* review_new_values(Concept,Slot,New_values) - 109 | If New_values is not null, its members are added to Slot of Concept and a 110 | task is proposed to check the values of Slot, otherwise, (no new values 111 | have been discovered), the task of finding values for Slot of Concept is 112 | reproposed. */ 113 | 114 | review_new_values(Concept,Slot,[Value|Values]) :- 115 | putvals(Concept,Slot,[Value|Values]), 116 | addtoagenda(check,Concept,Slot,300, 117 | 'New examples of the concept have recently been defined'). 118 | review_new_values(Concept,Slot,_) :- 119 | addtoagenda(fillin,Concept,Slot,100, 120 | 'Prior attempts to find examples failed, try again later'). 121 | -------------------------------------------------------------------------------- /h/h31.pl: -------------------------------------------------------------------------------- 1 | :- public(h31/1). 2 | 3 | /*********************************************************** 4 | * h31 anyconcept.examples.fillin 5 | * 6 | * unfolds the definition of a RECURSIVE defn of C 7 | * if the base case is of the form 8 | * c_defn(a,b,..) :- basecase. 9 | * i.e. there are no tests. The problem with tests is that 10 | * You would have to do an extensial proof of some X that 11 | * satisfied them. 12 | * The game plan is to collect the clauses for c_defn, 13 | * find an instance of a call to c_defn by using existing 14 | * examples or using the basecase. 15 | * Next remove the base case from the clauses, and bind 16 | * the instance to the recursive call. This way, when 17 | * we execute the defn, the recursive call is already 18 | * instantiated and its variable bindings are propagated 19 | * to the other terms. 20 | */ 21 | 22 | h31(C) :- 23 | getarity(C,Arity), 24 | get(C,[defn,name],[Mainfunctor]), 25 | exs(C,Exs), 26 | collectclauses(Mainfunctor,Arity,Clauses), 27 | time(T1), 28 | T is T1 / 2, % use 1/2 of remaining time 29 | clock(S,_), 30 | h31_do_while_time(T,S,C,Mainfunctor,Arity,Clauses), 31 | clock(S,Time), 32 | cleanup_a(h31,Num), 33 | put(C,[examples,dif],[Num,Time]), 34 | ((Num > 0, 35 | addtoagenda(check,C,[examples,typ],200,'have found some exs of C')) 36 | ; !,fail). 37 | 38 | h31_do_while_time(T,S,C,Mainfunctor,Arity,Clauses) :- 39 | removebase(Clauses,Newclauses), 40 | ok_a(S,T), 41 | exs(C,Exs), 42 | findinst(Exs,C,Mainfunctor,Arity,Clauses,Inst), 43 | unfold(Inst,Newclauses,Newinst), 44 | unifyinst(Arity,Newinst,_,NewEx), 45 | put(C,[examples,typ],NewEx), 46 | addnum_a(h31), 47 | termination_a(h31,S,T). 48 | h31_do_while_time(_,_,_,_,_,_). 49 | 50 | 51 | /**************************************************** 52 | * findinst(Exs,Mainfunctor,Arity,Clauses,-Inst). 53 | * Find an instance of the recursive call. 54 | * if there are no exs, then use the base case, 55 | * otherwise, use the exs. 56 | */ 57 | findinst([],C,Mainfunctor,Arity,Clauses,Inst) :- 58 | functor(Inst,Mainfunctor,Arity), 59 | bindbase(Inst,Clauses), 60 | unifyinst(Arity,Inst,_,Ex), 61 | put(C,[examples,bnd],Ex), 62 | addnum_a(h31),!. 63 | 64 | findinst(Exs,_,Mainfunctor,Arity,_,Inst) :- 65 | randomelement(Exs,Ex), 66 | unifyinst(Arity,Inst,Mainfunctor,Ex),!. 67 | 68 | 69 | 70 | /************************************************************* 71 | * bindbase(+Inst,+Clauses) 72 | * Works by unifying Inst with the basecase of clauses. 73 | * 74 | * Note that the above clause for bindbase will ONLY work 75 | * if there are no TESTS on the base case. The problem 76 | * is clear in the example: 77 | * a(X) :- integer(X). 78 | * To instantiate this, we would have to run integer backwards. 79 | * It is even more akward with multiple clauses. One could put 80 | * some more restrictions on the tests which could be make 81 | * limiting them to ones which are invertible. But this was 82 | * easier. 83 | */ 84 | bindbase(Inst,Clauses) :- member([Inst,basecase],Clauses). 85 | bindbase(Inst,Clauses) :- member([Inst,(basecase ',' _)],Clauses). 86 | 87 | /******************************************************************** 88 | * removebase(+Clauses,-Nonbase) 89 | * deletes the basecase clause from clauses -- look at note about 90 | * bindbase. 91 | */ 92 | removebase(Clauses,Nonbase) :- remove_or_die([_,basecase],Clauses,Nonbase),!. 93 | %removebase(Clauses,Nonbase) :- remove([_,(basecase ',' _)],Clauses,Nonbase),!. 94 | 95 | /****************************************************************** 96 | * unfold(+Instance,+Clauses,-Head) 97 | * Binds Head to a new instance of the predicate we are unfolding. 98 | * It does this by binding the recurisive calls in Clauses to 99 | * Instance. Then it trys to execute each clause in Clauses. 100 | * If one of them succedes, Head will be bound to the head of 101 | * that clause. E.g. 102 | * unfold(a([]),[[a(X),fail],[a([b|Y]),(somepred(X,Y),a(Y))]],H) 103 | * would bind H = a([b]). First it would replace a(Y) with a([]), 104 | * binding Y = []. Then member would pull of the first clause, 105 | * it would fail. On backtracking, Body = (somepred(X,[]),a([])). 106 | * Suppose Body succedes, then unfold sucedes with H=a([b|[]]). 107 | * 108 | */ 109 | unfold(Inst,Clauses,Head) :- 110 | bind_recursive_call(Inst,Clauses), 111 | member([Head,Body],Clauses), 112 | Body,!. 113 | 114 | /************************************************************ 115 | * bind_recursive_call(+inst,+clauses) 116 | * binds all recursive calls in clauses to Inst. 117 | * 118 | * Note that this could cause some trouble if Inst contained 119 | * some unbound vars, and the recursive calls instantiated them. 120 | */ 121 | bind_recursive_call(Inst,[]). 122 | bind_recursive_call(Inst,[[_,Terms]|Rest]) :- 123 | matchcall(Inst,Terms), 124 | bind_recursive_call(Inst,Rest). 125 | 126 | /*********************************************************** 127 | * matchcall(+Inst,+Terms) 128 | * matchcall binds inst to all recursive calls in each 129 | * set of terms. 130 | */ 131 | matchcall(Inst,(Inst)). 132 | matchcall(Inst,(X ',' Y)) :- matchcall(Inst,X),matchcall(Inst,Y). 133 | matchcall(Inst,(X ';' Y)) :- matchcall(Inst,X),matchcall(Inst,Y). 134 | matchcall(Inst,(_)). 135 | 136 | -------------------------------------------------------------------------------- /am.pl: -------------------------------------------------------------------------------- 1 | :- public([am/0, load_am_files/0]). 2 | 3 | load_am_files :- 4 | [common], 5 | [utilities], 6 | [clock], 7 | [agenda], 8 | [descriptions], 9 | [concepts], 10 | [definitions], 11 | descr(H,_,_), 12 | strcat('h/',H,Hfile), 13 | consult(Hfile), 14 | fail. 15 | 16 | am :- 17 | load_am_files; 18 | init_am, 19 | repeat, 20 | am_loop, 21 | fail. 22 | 23 | init_am :- 24 | abolish(agenda/1), 25 | abolish(time/1), 26 | abolish(history/1), 27 | abolish(do_threshold/1), 28 | abolish(seed/1), 29 | abolish(auto/1), 30 | abolish(cycle/1), 31 | assertz(cycle(1)), 32 | assertz(auto(no)), 33 | assertz(seed(13)), 34 | assertz(time(0)), 35 | assertz(history([])), 36 | assertz(do_threshold(500)), 37 | assertz(agenda([[fillin,set, [examples],310,[['some reason',10]]], 38 | [suggest,set,[examples],300,[['why not',10]]], 39 | [fillin,set, [genl], 300,[['whynot',10]]], 40 | [fillin,set, [spec], 300,[['reason',10]]], 41 | [check,set, [examples],150,[[r1,10],[r2,50]]]])). 42 | 43 | 44 | am_loop:- 45 | retract(cycle(Cycle)),NextCycle is Cycle + 1, assertz(cycle(NextCycle)), 46 | amformat('~n---- Cycle ~a: ', [Cycle]), 47 | user_selects_task(Task), 48 | Task = [Op,Con,Slot,Worth,_], 49 | compute_time(Worth), 50 | collect_heuristics(Con,Slot,Op,H), 51 | amformat('~a ~a of ~a ----------------~n',[Op,Slot,Con]), 52 | execute_heuristics(Con,H), 53 | !. 54 | 55 | user_selects_task(Task) :- 56 | % present_choices, 57 | % aminput(Ans), 58 | % process_input(Ans,Task), 59 | process_input('',Task), 60 | !. 61 | 62 | present_choices :- 63 | cdisplay(3), 64 | present_choice1,nl. 65 | 66 | present_choice1 :- best_worth(W),do_threshold(Thresh), 67 | W < Thresh, 68 | amformat('Worth of best task is ~a, do-threshold is ~a,~n', 69 | [W,Thresh]), 70 | amformat('Best task is poor. # = task, s = suggest~n',[]), 71 | amformat('n = new threshold,i = input task, q = quit,~n',[]), 72 | amformat('a = agenda display, p = concept printing, b = break. ~n', []). 73 | 74 | present_choice1 :- 75 | printstring("hit return to select top task,"), 76 | printstring(" # = task #,q = quit, x = extensions "),nl, 77 | amformat('n = new threshold,i = input task, q = quit,~n',[]), 78 | amformat('a = agenda display, p = concept printing, b = break. ~n', []). 79 | 80 | 81 | 82 | process_input(q,[]). 83 | process_input(n,Task) :- toptask(Task), set_new_threshold. 84 | process_input(s,Task) :- suggest_task(T), 85 | apply(addtoagenda,T),toptask(Task). 86 | process_input(x,Task) :- print('not yet implemented'),nl,toptask(Task). 87 | process_input(i,Task) :- user_task,toptask(Task). 88 | process_input(a,Task):- write('How many tasks do you want to display?'), 89 | aminput(D), cdisplay(D), user_selects_task(Task). 90 | process_input(p,Task):- 91 | write('Do you want to print a single concept or all of them?'),nl, 92 | write('name to print one, a for all, or for cancel'), aminput(A), 93 | processinput1(A),user_selects_task(Task). 94 | process_input(b,Task):- break,user_selects_task(Task). 95 | process_input(N,Task) :- integer(N),select_task(N,Task). 96 | process_input(_,Task) :- toptask(Task), !. 97 | process_input(_,_):- 98 | nl, write('Agenda is empty. AM is exiting. Good-bye!'), nl, 99 | abort. 100 | processinput1([]):- !. 101 | processinput1(a):- ppall. 102 | processinput1(N):- ppframe(N). 103 | 104 | set_new_threshold :- do_threshold(X), 105 | print('Old threshold is '),print(X),nl, 106 | print('New threshold is '),ttyflush, 107 | aminput(Y),set_new_threshold1(Y). 108 | set_new_threshold1(Y) :- integer(Y),retract(do_threshold(_)), 109 | asserta(do_threshold(Y)). 110 | set_new_threshold1(_) :- print('Must be an integer'),nl, 111 | set_new_threshold. 112 | 113 | suggest_task(T) :- best_worth(W),W1 is W + 500, 114 | agenda([[_,Con|_]|_]), 115 | T = [suggest,Con,_,W1,'there are no worthwhile tasks']. 116 | 117 | /* allot time in 10ths of seconds = to Worth * 1.5. I.e. 118 | * a good task (worth 800) gets 12 seconds. 119 | */ 120 | compute_time(Worth) :- T is Worth * 3 / 2, 121 | retract(time(_)), 122 | assertz(time(T)). 123 | 124 | collect_heuristics(Con,[examples,typ],Op,H) :- 125 | collect_heuristics(Con,[examples],Op,H). 126 | 127 | collect_heuristics(Con,Slot,Op,H) :- 128 | genls_sf(Con,L), 129 | append(Slot,[Op],Slot_name), 130 | collect(Slot_name,L,H1), 131 | collect([Op],L,H2), 132 | append(H1,H2,H3), 133 | removedups(H3,H),!. 134 | 135 | execute_heuristics(_,_) :- time(T), 136 | T < 0. 137 | execute_heuristics(Con,[H|R]) :- 138 | ((descr(H,Msg,_), 139 | format('~a: ~a~n',[H,Msg]),flush_output) ; 140 | (format('~a: ~n',[H]), flush_output)), 141 | clock(Start,_), 142 | apply_heuristic(H,[Con]), 143 | clock(Start,Elapsed_time), 144 | retract(time(T)), 145 | T1 is T - Elapsed_time, 146 | assertz(time(T1)),!, 147 | execute_heuristics(Con,R). 148 | execute_heuristics(_,[]). 149 | 150 | % apply heuristic, if it fails then just succeed trivially. 151 | % Could do some statistical collection here. 152 | 153 | % This version stubbed out since success/failure info is not 154 | % always an indication of the effect of a heuristic. -Todd 155 | %apply_heuristic(H,A) :- apply(H,A), !, amformat('succeeded ~n',[]). 156 | %apply_heuristic(H,_) :- amformat('failed ~n',[]). 157 | 158 | apply_heuristic(H,A):- apply(H,A), !. 159 | apply_heuristic(_,_). 160 | -------------------------------------------------------------------------------- /h/h300.pl: -------------------------------------------------------------------------------- 1 | /*** h300 and h301 respectively generalize and specialize a concepts definition 2 | **** by finding the most interesting generalization or specialization of its 3 | **** most interesting component predicate. For example, h300(set_member) would 4 | **** work as follows 5 | **** Given the definition of set_member as 6 | **** set_member_defn([H|_],Element):- 7 | **** basecase, 8 | **** set_equal_defn(Element,H). 9 | **** set_member_defn([_|T],Element):- 10 | **** set_member_defn(T,Element). 11 | **** h300 might pick the component predicate set_member_defn as the most 12 | **** interesting, and generalize it to member_defn to generate the new 13 | **** concept: 14 | **** genl_of_set_member_defn([H|_],Element):- 15 | **** basecase, 16 | **** set_equal_defn(Element,H). 17 | **** genl_of_set_member_defn([_|T],Element):- 18 | **** genl_of_set_member_defn(T,Element). 19 | **** h301 works similarly in the specialization direction. 20 | ***/ 21 | 22 | 23 | h300(Con):- 24 | time(T), 25 | T1 is T/2, 26 | clock(Start,_), !, 27 | mutate_defn(Con,genl,T1,Start). 28 | h300(_). 29 | 30 | mutate_defn(Con,Direction,Alotment,Start):- % Direction = up or down 31 | get(Con,[dom_range],Check), \+ Check = [], % Ensure dom_range slot exists 32 | most_interesting_predicate(Con,Con_defn,MI_pred_defn,Con_clauses), 33 | strip__defn(MI_pred_defn,MI_pred), 34 | convert_direction(Direction,Root,Relation,Rel), !, 35 | most_interesting_mutation(MI_pred,Rel,Con,MI_mutation_defn), 36 | % Give it a new name 37 | newdefname(Root,Con,NewCon_defn), 38 | replacePredName(NewCon_defn,Con_clauses,Con_clauses1), 39 | % Mutate the definition... 40 | totalreplace(MI_pred_defn,MI_mutation_defn,Con_clauses1,Con_clauses2), 41 | totalreplace(Con,NewCon_defn,Con_clauses2,NewCon_clauses), 42 | % ---A new concept is born! Make sure it's unique... 43 | not_already_defined(NewCon_defn,NewCon_clauses), 44 | check_with_user(Con,Relation,NewCon_defn,NewCon_clauses,Final_con,Final_con_clauses), 45 | % It's unique and the user likes it -> save it. 46 | assertset(Final_con_clauses), 47 | updateconcepts(Con,Final_con,Direction), 48 | put_in_hierarchy(Con,Final_con), 49 | times_up(Alotment,Start), !. 50 | mutate_defn(Con,Direction,_,_):- 51 | get(Con,[dom_range],[]), 52 | addtoagenda(fillin,Con,[dom_range],500,'No examples of this slot exist'), 53 | if(Direction = genl, 54 | Reason = 'Generalize C by generalizing a predicate in its defn', 55 | Reason = 'Specialize C by specializing a predicate in its defn'), 56 | addtoagenda(fillin,any_concept,[Direction,fillin],400,Reason), !. 57 | 58 | 59 | convert_direction(genl,genl_of_,generalization,up). 60 | convert_direction(spec,spec_of_,specialization,down). 61 | 62 | % Expects a list of lists (ie. output from collectclauses), and gives the 63 | % predicate they define a new name. 64 | replacePredName(_,[],[]). 65 | replacePredName(NewFunctor,[ [OldHead|Body] | OldRest], [ [NewHead|Body] | NewRest] ):- 66 | OldHead=..[_|OldArg], 67 | NewHead=..[NewFunctor|OldArg], 68 | replacePredName(NewFunctor, OldRest, NewRest). 69 | 70 | 71 | strip__defn(Old,New):- 72 | name(Old,String_defn), 73 | append(String,[95,100,101,102,110|_],String_defn), !, 74 | name(New,String). 75 | strip__defn(Old,Old). 76 | 77 | most_interesting_predicate(Con,Con_defn,MI_pred,Con_clauses):- 78 | get(Con,[Defn,Name],[Con_defn]), 79 | getarity(Con,Arity), 80 | collectclauses(Con_defn,Arity,Con_clauses), 81 | setof(Pred2s, X ^ (member(X,Con_clauses), conditionof(Pred2s, X) ), List_O_Preds), !, 82 | most_interesting_pred1(List_O_Preds,MI_pred). 83 | 84 | 85 | % given a list of predicates, returns most interesting predicate functor. 86 | most_interesting_pred1([Pred], Pred_functor):- Pred=..[Pred_functor|_]. 87 | most_interesting_pred1([Pred|Preds], MI_Pred):- 88 | most_interesting_pred1(Preds, Pred1), 89 | if(frame(Real_Pred1, [defn,name], [Pred1]), % if the concept exists... 90 | get(Real_Pred1, [worth], [P1_worth]), % get its worth 91 | P1_worth = 0), % else use zer0. 92 | Pred=..[Pred_functor|_], 93 | if(frame(Real_Pred, [defn,name], [Pred_functor]), % if the concept exists... 94 | get(Real_Pred, [worth], [P_worth]), % get its worth 95 | P_worth = 0), % else use zerO. 96 | if(P1_worth>=P_worth, 97 | MI_Pred = Pred1, 98 | MI_Pred = Pred). 99 | 100 | most_interesting_mutation(MI_pred,Rel,Con,MI_mutation_defn):- 101 | ripple_sf(Rel,MI_pred,X_cons1), % List of gens/specs of MI_functor. 102 | remove(Con,X_cons1,X_cons), % Con is not a mutation of itself. 103 | screen_mutants(Con,X_cons,Valid_X_cons), !, 104 | most_interesting_concept(Valid_X_cons,MI_mutation), 105 | get(MI_mutation,[defn,name],[MI_mutation_defn]). 106 | 107 | most_interesting_clause([C],C). 108 | most_interesting_clause([C|Cs],C):- 109 | C =..[C_func|_], 110 | get(C_func,[worth],[C_worth]), 111 | most_interesting_clause(Cs,MI_rest), 112 | MI_rest =..[MI_rest_func|_], 113 | get(MI_rest_func,[worth],[C_worth]), !, 114 | C_worth >= MI_rest_worth. 115 | most_interesting_clause([_|Cs],MI):- 116 | most_interesting_clause(Cs,MI). 117 | % This part just enables backtracking to resucceed with the 2nd most interesting 118 | % predicate, etc. 119 | most_interesting_concept(C,MIC):- most_interesting_concept2(C,MIC). 120 | most_interesting_concept(C,MIC):- 121 | most_interesting_concept2(C,OldMIC), 122 | remove(OldMIC,C,NewC), 123 | most_interesting_concept(NewC,MIC). 124 | 125 | % Finds the worth of the first concept and returns it if it's better than all the rest. 126 | most_interesting_concept2([C],C). 127 | most_interesting_concept2([C|Cs],MI_C):- 128 | get(C,[worth],[C_worth]), 129 | most_interesting_concept2(Cs,MI_rest), 130 | get(MI_rest,[worth],[MI_rest_worth]), 131 | if( C_worth >= MI_rest_worth, 132 | MI_C = C, 133 | MI_C = MI_rest), !. 134 | most_interesting_concept2([_|Cs], MI_C):- 135 | most_interesting_concept2(Cs, MI_C). 136 | 137 | % check all that domain/range compatibility stuff... 138 | screen_mutants(Cons,X_cons,Valid_cons):- 139 | getarity(Cons,Arity), 140 | dom_ran(Cons,Domain,Range), 141 | screen_them_mutants(Arity,Domain,Range,X_cons,Valid_cons). 142 | 143 | screen_them_mutants(_,_,_,[],[]). 144 | screen_them_mutants(A,D,R,[H|T],[H|Rest]):- 145 | getarity(H,A), 146 | dom_ran(H,D2,R2), 147 | subset(D,D2), 148 | subset(R2,R), 149 | screen_them_mutants(A,D,R,T,Rest). 150 | screen_them_mutants(A,D,R,[_|T],Rest):- 151 | screen_them_mutants(A,D,R,T,Rest). 152 | 153 | dom_ran(Cons,Domains,Ranges):- 154 | get(Cons,[dom_range],DR), 155 | split_dom_range(DR,Domains,Ranges). 156 | 157 | split_dom_range([],[],[]). 158 | split_dom_range([DR|DRs],[D|DT],[R|RT]):- 159 | split_last(DR,D,R), 160 | split_dom_range(DRs,DT,RT). 161 | 162 | subset([],_). 163 | subset([X|Xs],Y):- 164 | member(X,Y), 165 | subset(Xs,Y). 166 | 167 | -------------------------------------------------------------------------------- /agenda.pl: -------------------------------------------------------------------------------- 1 | :- public([ 2 | toptask/1,best_worth/1,do_threshold/1,addtoagenda/5, 3 | select_task/2,current_task/1, display_tasks/1,cdisplay/1, 4 | current_worth/1,delete_task/1,user_task/0]). 5 | 6 | % toptask(-Task_record) returns the highest priority task on the agenda. 7 | % The task is removed from the agenda and added to the history when selected 8 | toptask(Task):- 9 | retract(agenda(Agenda)), 10 | split(Agenda,[Task|Agenda2]), 11 | addtohistory(Task), 12 | assertz(agenda(Agenda2)). 13 | 14 | /* best_worth(Worth of top task) gets the worth of the best task */ 15 | best_worth(0):-agenda([]). 16 | best_worth(Worth) :- agenda([[_,_,_,Worth,_]|_]). 17 | 18 | /* do_threshold returns the lowest acceptable value for an 19 | * executable task. 20 | */ 21 | do_threshold(500). 22 | 23 | /* addtohistory adds a task to the 5 task history stack which is kept by 24 | the system. When a new task is selected for execution it is pushed 25 | onto the stack */ 26 | addtohistory(Task):- 27 | retract(history(History)), 28 | addh1(Task,History,H2), 29 | assertz(history(H2)). 30 | 31 | /* this is a help function used by addtohistory. It adds a new task to the 32 | assertzed history clause, removing the oldest task if there are already 10 */ 33 | addh1(Task,[],[Task]). 34 | addh1(Task,History,[Task|History]):- 35 | length(History,L), 36 | L<10. 37 | addh1(Task,History,[Task|H2]):- 38 | removelast(History,H2). 39 | 40 | /* addtoagenda adds a new task to the agenda if it is not already there. 41 | Its parameters are operation, concept, facet, worth, and reason: 42 | addtoagenda(+Op,+C,+F,+W,+R). */ 43 | 44 | /* if task is already there with same reason, do nothing */ 45 | addtoagenda(Op,C,F,W,R):- 46 | agenda(Agenda), 47 | member([Op,C,F,_,Rlist],Agenda), 48 | member([R,_],Rlist),!. 49 | /* if task has been executed within the last 5 cycles and it's not worthy (<300) 50 | , */ 51 | /* do nothing. */ 52 | addtoagenda(Op,C,F,W,R):- 53 | W<300, 54 | history(History), 55 | member([Op,C,F,_,Rlist],History), 56 | member([R,_],Rlist),!. 57 | /* if task is there with other reasons, add new reason and recompute worth */ 58 | addtoagenda(Op,C,F,W,R):- 59 | agenda(Agenda), 60 | member([Op,C,F,_,Rlist],Agenda), 61 | % nl, cwrite('adding ',[Op,C,F,W,R]), 62 | newworth(Op,C,F,[[R,W]|Rlist],Worth), 63 | remove([Op,C,F,_,_],Agenda,Agenda2), 64 | addinorder([Op,C,F,Worth,[[R,W]|Rlist]],Agenda2,Agenda3), 65 | retract(agenda(_)), 66 | assertz(agenda(Agenda3)),!. 67 | /* if task is not there, add task to agenda */ 68 | addtoagenda(Op,C,F,W,R):- 69 | % cwrite('adding ',[Op,C,F,W,R]), 70 | agenda(Agenda), 71 | newworth(Op,C,F,[[R,W]],Worth), 72 | addinorder([Op,C,F,Worth,[[R,W]]],Agenda,Agenda2), 73 | retract(agenda(_)), 74 | assertz(agenda(Agenda2)),!. 75 | 76 | /* newworth computes the worth of a concept using the formula: 77 | worth=(2*operator worth + 3*concept worth + 5*facet worth) 78 | * sum of reason worths / 1000. */ 79 | newworth(Op,C,F,Rlist,Worth):- 80 | worth(Op,Oworth), 81 | worth(C,Cworth), 82 | worth(F,Fworth), 83 | getrworth(Rlist,Rworth), 84 | Ocf is (2*Oworth)+(3*Cworth)+(5*Fworth), 85 | Worth is (Rworth*Ocf)/1000. 86 | 87 | /* getrworth is a help function for newworth that sums the worths of 88 | the reasons for a task */ 89 | getrworth([],0). 90 | getrworth([[R,W]|Tail],Rworth):- 91 | getrworth(Tail,Rw2), 92 | Rworth is W+Rw2. 93 | 94 | /* addinorder adds a new task to the agenda list in priority order. If 95 | an existing task has the same priority, the new task goes ahead of 96 | it to give recent tasks a slight priority edge */ 97 | addinorder(Task,[],[Task]). 98 | addinorder(Task,Agenda,[Task|Agenda]):- 99 | split(Task,[_,_,_,W,_]), 100 | split(Agenda,[[_,_,_,W2,_]|Tail]), 101 | W>=W2. 102 | addinorder(Task,[H|T],[H|Agenda2]):- 103 | addinorder(Task,T,Agenda2). 104 | 105 | /* select_task allows selecting a task other than the highest priority 106 | task from the agenda. If the task number exceeds the actual number of 107 | tasks in the agenda, the top task is returned. The task is removed from 108 | the agenda and added to the history. 109 | select_task(+Task_number,-Task_record). */ 110 | select_task(N,Task):- 111 | agenda(Agenda), 112 | length(Agenda,L), 113 | N>L, 114 | toptask(Task). 115 | select_task(1,Task):- 116 | toptask(Task). 117 | select_task(N,Task):- 118 | retract(agenda(Agenda)), 119 | nth(Agenda,N,Task), 120 | addtohistory(Task), 121 | remove(Task,Agenda,Agenda2), 122 | assertz(agenda(Agenda2)). 123 | 124 | /* current_task(-Task_record) returns the record of the currently executing 125 | task from the history stack. */ 126 | current_task(Task):- 127 | history([Task|_]). 128 | current_task([]). 129 | 130 | /* display_tasks(+Number_to_display) prints the top N tasks from the agenda 131 | if N exist */ 132 | display_tasks(N):- 133 | agenda(Agenda), 134 | disp(N,1,Agenda). 135 | 136 | /* disp is a help function for display_tasks */ 137 | disp(0,_,_):- 138 | nl,nl. 139 | disp(_,_,[]):- 140 | nl,nl. 141 | disp(N,Count,[H|T]):- 142 | wrtask(H,Count), 143 | N1 is N-1, 144 | C2 is Count+1, 145 | disp(N1,C2,T). 146 | 147 | /* wrtask is a help function that displays the information for a single 148 | task */ 149 | wrtask([Op,C,F,W,Rlist],Count):- 150 | nl, 151 | write('Task # '),write(Count),nl, 152 | write(' operator: '),write(Op),nl, 153 | write(' concept: '),write(C),nl, 154 | write(' facet: '),write(F),nl, 155 | write(' worth: '),write(W),nl, 156 | write(' reasons: '),nl, 157 | writerlist(Rlist). 158 | 159 | /* writerlist is a help function for wrtask which writes out the reason 160 | list */ 161 | writerlist([]). 162 | writerlist([[R,W]|T]):- 163 | write(' '),write(R),write(' '),write(W),nl, 164 | writerlist(T). 165 | 166 | /* cdisplay(+Number_of_Tasks) concisely displays the desired number of tasks 167 | from the top of the agenda. The tasks are displayed one per line; each line 168 | contains the task number, operation, concept, facet, and worth. Reasons are 169 | not displayed. cwrite is used to print a heading. */ 170 | cdisplay(N):- 171 | agenda(Agenda), 172 | length(Agenda,Num), 173 | amformat('~a Tasks on agenda~n',[Num]), 174 | cwrite(' ',['OPERATION','CONCEPT','FACET','WORTH',unused]), 175 | cdisp(N,1,Agenda). 176 | 177 | /* cdisp is a help function for cdisplay */ 178 | cdisp(0,_,_):-nl,nl. 179 | cdisp(_,_,[]):-nl,nl. 180 | cdisp(N,Count,[H|T]):- 181 | cwrite(Count,H), 182 | C1 is Count+1, 183 | N1 is N-1, 184 | cdisp(N1,C1,T). 185 | 186 | /* cwrite writes a one line concise task entry */ 187 | cwrite(N,[Op,C,F,W,_]):- 188 | write(N), 189 | spaces(N,5), 190 | write(Op), 191 | spaces(Op,15), 192 | write(C), 193 | spaces(C,20), 194 | write(F), 195 | spaces(F,30), 196 | write(W),nl. 197 | 198 | /* spaces is a function to fill the difference in length between the length of 199 | a given atom and the print field into which it is being written. It is 200 | used to align atoms for columnar output */ 201 | 202 | 203 | spaces(X,N):- 204 | explode(X,List), 205 | length(List,L), 206 | T is N-L, 207 | tab(T). 208 | 209 | /* current_worth(-W) returns the worth of the currently executing task from 210 | the top of the history. */ 211 | current_worth(0):- 212 | history([]). 213 | current_worth(W):- 214 | history([[_,_,_,W,_]|_]). 215 | 216 | /* delete_task(+task_number) deletes the task numbered N from the agenda. Tasks 217 | are numbered starting with 1 as the highest priority task. */ 218 | delete_task(N):- 219 | agenda(Agenda), 220 | length(Agenda,L), 221 | (N<1;N>L). 222 | delete_task(N):- 223 | retract(agenda(Agenda)), 224 | nth(Agenda,N,Task), 225 | remove(Task,Agenda,Agenda2), 226 | assertz(agenda(Agenda2)). 227 | 228 | /* user_task is invoked to allow the user to define his/her own task. The worth 229 | is fixed at 500 and the reason is fixed. */ 230 | user_task:- 231 | write('Input information about the new task.'),nl, 232 | write('End with a period since the Prolog read is used here.'),nl, 233 | write('Operation: '),ttyflush, 234 | read(Op),nl, 235 | write('Concept: '),ttyflush, 236 | read(C),nl, 237 | write('Facet: '),ttyflush, 238 | read(F),nl, 239 | addtoagenda(Op,C,[F],500,'User Requested Task'). 240 | -------------------------------------------------------------------------------- /h/h92.pl: -------------------------------------------------------------------------------- 1 | /**************************************************************************** 2 | * 3 | * h92 specializes a concept definition. Each specialization is formed by 4 | * dropping a clause of the original concept definition. 5 | * Tasks are suggested to fill-in the frames for each new concept. 6 | * Many of the concepts created are worthless. The user gets a chance to 7 | * throw them out of the agenda before the frames are filled-in. 8 | * This heuristic generates as many new concepts as possible by using 9 | * 1/2 of the available time. 10 | */ 11 | 12 | h92(Concept):- get(Concept,[defn,name],[Mainfunctor]), 13 | getarity(Concept,N), 14 | collectclauses(Mainfunctor,N,Clauses), 15 | time(T),T1 is T/2, clock(Start,_), 16 | h92_do_while_time(Concept,Mainfunctor,T1,Start,Clauses). 17 | h92(_). 18 | 19 | /*** h92_do_while_time drops clauses from the concept definition 20 | **** of the passed parameter Concept. Each clause deletion results 21 | **** in a new concept definition. This process is repeated until the 22 | **** allocated time is used up (Alotment). Each new concept definition 23 | **** is displayed to the user to allow for it's renaming or deletion. 24 | **** If accepted by the user, the new concept definition is asserted. 25 | **** Note the trick for iterating through h92_do_while_time: the 26 | **** predicate times_up FAILS if there is time remaining and 27 | **** succeeds is the alloted time is used up. Failure forces backtracking 28 | **** resulting in alternative paths through dropclause. This 29 | **** works since the effects of h92_do_while_time are achieved through 30 | **** side-effects. 31 | ***/ 32 | 33 | h92_do_while_time(Concept,Mainfunctor,Alotment,Start,Clauses):- 34 | dropclause(Clauses,TempClauses), newdefname(spec_of_,Concept,NewName), 35 | totalreplace(Mainfunctor,NewName,TempClauses,NewClauses), 36 | not_already_defined(NewName,NewClauses), 37 | check_with_user(Concept,specialization,NewName,NewClauses,NewName2,NewClauses2), 38 | assertset(NewClauses2), 39 | updateconcepts(Concept,NewName2,spec), 40 | times_up(Alotment,Start). 41 | 42 | 43 | /*** succeed only if the newly generated procedure is unique (can't unify with 44 | **** any concept AM already knows about). fails otherwise. 45 | ***/ 46 | not_already_defined(OldName,OldClauses):- 47 | frame(Name,[defn,name], [Name_defn]), 48 | getarity(Name,Arity), 49 | collectclauses(Name_defn,Arity,NameClauses), 50 | totalreplace(OldName,Name_defn,OldClauses,NewClauses), 51 | NameClauses = NewClauses, 52 | amformat('~n (The new concept, ~a, is the same as the concept, ~a!)~n',[OldName,Name]), 53 | !, fail. 54 | not_already_defined(_,_). 55 | 56 | /*** updateconcepts simply does the bookkeeping required for new concepts. 57 | **** The name, arity and worth slots are filled-in and some tasks are 58 | **** added to the agenda. 59 | ***/ 60 | 61 | updateconcepts(OldConcept,NewConcept,Relation):- 62 | put(NewConcept,[name],NewConcept), 63 | ensure_name_ends_with__defn(NewConcept,NewConcept_defn), 64 | put(NewConcept,[defn,name],NewConcept_defn), 65 | put(OldConcept,[Relation],NewConcept), 66 | copyslot(OldConcept,NewConcept,[defn,arity]), 67 | copyslot(OldConcept,NewConcept,[worth]), 68 | addtoagenda(fillin,NewConcept,[examples],200,'no examples of this new concept' 69 | ), 70 | addtoagenda(fillin,NewConcept,[worth],200,'new concept with unknown worth'), ! 71 | . 72 | 73 | copyslot(FromFrame,ToFrame,Slot):- 74 | get(FromFrame,Slot,X), update(ToFrame,Slot,X). 75 | 76 | /*** 77 | **** This is a new function added by adam, Without this, the 78 | **** new generalizations are not linked into the tree properly. 79 | **** The result is that we cannot collect any heuristics for them. 80 | ***/ 81 | 82 | put_in_hierarchy(Con,Newcon) :- 83 | get(Con,[genl],Gens), 84 | remove(Newcon,Gens,Gens1), 85 | putvals(Newcon,[genl],Gens1),!. 86 | 87 | /*** check_with_user is a simple but messy function for interacting 88 | **** with the user. The intent is determine if the user likes a concept 89 | **** definition and to determine a name for it. 90 | ***/ 91 | 92 | check_with_user(Concept,_,X,Y,X,Y):- 93 | assertz(gensymed_concepts(Concept)), !. 94 | check_with_user(Concept,Relation,NewConcept,NewClauses,NewConceptName,NewClauses2):- 95 | nl,nl, 96 | write(' I have created a concept definition which is a '), write(Relation), 97 | write(' of'), nl,write(Concept),write('.'), 98 | write(' This new concept is defined as follows: '), nl, 99 | ppclauses(NewClauses), nl, 100 | repeat, 101 | write(' Do you want to keep this new concept (y/n)? '), 102 | aminput(Reply), (Reply=y ; Reply=n ; Reply=''), 103 | !, (Reply=y ; Reply=''), 104 | repeat, 105 | write(' Please type new name for this concept or to keep current name:'), 106 | aminput(X), 107 | check_new_concept_name(X,NewConcept,NewConceptName,NewClauses,NewClauses2), 108 | !. 109 | 110 | check_new_concept_name('',NewConcept,NewConcept,NewClauses,NewClauses):- !. 111 | check_new_concept_name(X,NewConcept,X,NewClauses,NewClauses2):- 112 | ensure_name_ends_with__defn(X,X2), 113 | \+frame(_,[defn,name],X2), 114 | totalreplace(NewConcept,X2,NewClauses,NewClauses2), !. 115 | check_new_concept_name(X,NewConcept,NewConceptName,NewClauses,NewClauses2):- 116 | amformat('The name ~a, is already being used. Please try again.~n',[NewConcept]), 117 | fail. 118 | 119 | ensure_name_ends_with__defn(Old,Old):- 120 | name(Old,L), 121 | append(_,[95,100,101,102,110|_],L), !. 122 | ensure_name_ends_with__defn(Old,New):- 123 | name(Old,L), 124 | append(L,[95,100,101,102,110],NewL), 125 | name(New,NewL). 126 | 127 | ppclauses([]). 128 | ppclauses([H|T]):- ppclause(H), ppclauses(T). 129 | ppclause([Head|[Body]]):- write(Head),write(':'),write('-'),nl, 130 | write(' '),write(Body), write('.'), nl. 131 | 132 | /*** newdefname(X,Y,New) forms NEW by concatenating the following: 133 | **** X, Y, _defn, I where I is a generated integer. 134 | ***/ 135 | 136 | newdefname(Name1,Name2,NewName):- makename(Name1,Name2,Temp), 137 | makename(Temp,'_defn',Tempname), gensym(Tempname,NewName). 138 | 139 | /*** dropcondition removes a term from Clauses to form NewClauses. 140 | **** dropcondition will not remove the term 'basecase' which is intended 141 | **** to flag the basecase clause of a recursive definition. By backtracking 142 | **** different terms are selected for dropping. Note that Clauses must 143 | **** be a list (of the form returned by collectclauses). 144 | ***/ 145 | 146 | dropcondition(Clauses,NewClauses):- member(Clause,Clauses), 147 | conditionof(Cond,Clause), \+Cond=basecase, 148 | removecond(Cond,Clause,NewClause), 149 | replace(Clause,NewClause,Clauses,NewClauses). 150 | 151 | removecond(Cond,Clause,NewClause):- Clause=[Head,Body], 152 | removecond2(Cond,Body,NewBody), NewClause=[Head,NewBody]. 153 | removecond2(Cond,Cond,true). 154 | removecond2(Cond,(Cond,Y),Y). 155 | removecond2(Cond,(X,Cond),X). 156 | removecond2(Cond,(X,Y),Z):- \+X=Cond, \+Y=Cond, 157 | removecond2(Cond,Y,Z). 158 | 159 | /*** conditionof returns a single term (Cond) of Clause. The only 160 | **** tricky part is getting past the functors ',' and ';'. 161 | **** Note that Clause must be in the form (Head,Body). A null 162 | **** body is encoded as 'true'. 163 | ***/ 164 | 165 | conditionof(Cond,Clause):- Clause=[_,Body], conditionof2(Cond,Body). 166 | conditionof2(Cond,Cond):- \+Cond=true, Cond=..[F|_], \+F=(','), \+F=(';'). 167 | conditionof2(Cond,(X,Y)):- conditionof2(Cond,X). 168 | conditionof2(Cond,(X,Y)):- conditionof2(Cond,Y). 169 | 170 | /*** assertset does the inverse of collectclauses: given a list of 171 | **** clauses, assertz each clause to the database. Note that assertz 172 | **** is used to maintain order of the clauses. 173 | ***/ 174 | 175 | assertset([]). 176 | assertset([Clause|Rest]):- Clause=[Head|[true]], assertz((Head)), 177 | assertset(Rest). 178 | assertset([Clause|Rest]):- Clause=[Head|[Body]], assertz((Head:-Body)), 179 | assertset(Rest). 180 | 181 | /*** dropclause removes a clause from a set of clauses. Note that 182 | **** the basecase clause is not deleted. (The term 'basecase' is 183 | **** added to the basecase clause of a recursive definition as an 184 | **** AM/p convention). 185 | ***/ 186 | 187 | dropclause(Clauses,NewClauses):- member(Clause,Clauses), droppable(Clause), 188 | remove(Clause,Clauses,NewClauses), \+NewClauses=[]. 189 | droppable(Clause):- \+ conditionof(basecase,Clause). 190 | 191 | /*** totalreplace(+Oldfunctor,+Newfunctor,+Oldclauses,-Newclauses) 192 | **** replaces all terms with functor=Oldfunctor with Newfunctor 193 | **** in the clauses Oldclauses to produce Newclauses. Note that 194 | **** Oldclauses must be in the form produced by collectclauses. 195 | **** totalreplace must check both the head and the body of each 196 | **** clause for occurrences of Oldfunctor 197 | ***/ 198 | 199 | totalreplace(Old,New,Old,New). 200 | totalreplace(Old,New,Oldstruc,Oldstruc):- atomic(Oldstruc), \+Old=Oldstruc. 201 | totalreplace(Old,New,[OldHead|OldTail],[NewHead|NewTail]):- 202 | totalreplace(Old,New,OldHead,NewHead), 203 | totalreplace(Old,New,OldTail,NewTail). 204 | totalreplace(Old,New,Oldstruc,Newstruc):- 205 | \+atomic(Oldstruc), 206 | Oldstruc=..[Oldhead|Oldargs], \+Oldhead='.', 207 | totalreplace(Old,New,Oldhead,Newhead), 208 | Newstruc=..[Newhead|Oldargs]. 209 | 210 | -------------------------------------------------------------------------------- /h/h174.pl: -------------------------------------------------------------------------------- 1 | :-public(h174/2). 2 | 3 | /* h174 creates a new operation by composing two existing operations.In clausal 4 | form, the composition is expressed as fog(a,b,c,y):-g(a,b,c,x),f(x,y) which 5 | is equivalent to f(g(a,b,c)) in functional notation. First function f is 6 | checked to make sure that it has "arity" 2 (one input and one output 7 | parameter). Next the lists of valid domains and ranges of the two functions 8 | are checked to find a valid composite domain-range. Then the new algorithm 9 | is created as a single prolog clause and is asserted. Finally a new concept 10 | frame is filled in. Note that this heuristic is not really very useful 11 | given the operations that we have defined; this is because very few of 12 | our operations are of arity 2 with one input and one output parameter. */ 13 | 14 | /* I noticed that all the other heuristics are of arity 1 and compute on 15 | a single concept. I have also noticed that this heuristic never seems 16 | to succeed and I hope that this will give it a better change to succeed. 17 | -marcos 18 | 19 | Ray's original code is in the rile h174-old.pl 20 | 21 | */ 22 | 23 | h174(F) :- 24 | getarity(F,2), 25 | get(G,[dom_range],Gdr), 26 | h174(F,G). 27 | 28 | 29 | h174(F,G):- 30 | getarity(F,2), 31 | get(F,[dom_range],Fdr), 32 | get(G,[dom_range],Gdr), 33 | get_composite_dr(Fdr,Gdr,FoGdr), 34 | make_composite_alg(F,G,FoGdr,Newname,Alg), 35 | create_composite_concept(F,G,Newname,Alg,FoGdr). 36 | 37 | /* Since I took ray's comment (see above) to mean that F should be allowed 38 | to have arity 2+, I am defining a compose function that will allow 39 | F to have arity n. I hope this works. 40 | 41 | We start with the same h174, and then add to it a that will look for 42 | a set of concepts to fill up the arity of F -marcos 43 | 44 | Basically this is the way the compose function works. Given 2 functions 45 | as input F(A...N) and G(A..N) compose creates a composition that composes 46 | G with F and fills in the rest of Fs slots with compatable functions: 47 | 48 | Given the functions F(A,B,C),G(D,E,F),H(G,I,K), this function creates 49 | the composition F(G(D,E,F),H(G,I,K)) (C is the prolog output parameter). 50 | 51 | This is way it looks like in PROLOG: 52 | 53 | FoGH(A,B,D,E,Y):- G(A,B,X), IntermedFoH(D,E,X,Y). 54 | IntermedFoH(D,E,X,Y):- H(D,E,Q), IntermedF(Q,X,Y). 55 | IntermedF(Q,X,Y):- F(Q,X,Y). 56 | 57 | It is written in a general way that will allow F to be arity N -marcos*/ 58 | 59 | 60 | h174(F,G):- 61 | assertz(flag), 62 | getarity(F,N1), N is N1 -1, 63 | loop_composit(F,G,N,[],Glist,[],FoGdr,1), 64 | makename(F,'_o_',Temp), 65 | loopmakename(Temp,Glist,SeedName), 66 | loop_make_composit(F,SeedName,Glist,FoGdr,Newname,Algorogo,N,0),!, 67 | assertz(flag), 68 | create_composite_concept2(F,Glist,Newname,Algorogo,FoGdr). 69 | 70 | 71 | loopmakename(Temp,[],Temp). 72 | loopmakename(Temp,[G|Glist],R):- 73 | makename(Temp,G,Iname), 74 | loopmakename(Iname,Glist,R). 75 | 76 | 77 | loop_make_composit(F,Topname,[],[],Newname2,Alg2,Arity,Q):- 78 | getarity(F,N), 79 | makelist(N,List), 80 | get(F,[defn,name],[Name]), 81 | Pred1 =.. [Name|List], 82 | Pred2 =.. [Topname|List], 83 | Alg = (Pred2:-Pred1), 84 | write(Alg), 85 | assertz(Alg). 86 | 87 | loop_make_composit(F,Topname,[G|Glist],[FoGdr|FoGdrlist],Newname2,Alg2,Arity,Q):- 88 | length(FoGdr,N), 89 | N1 is N + 1, 90 | makelist(N1,[Frange,Grange|Gdom]), 91 | append(Gdom,[Grange],T1), 92 | sumup(FoGdrlist,0,N2), 93 | write('Q is '),write(Q),nl, 94 | write('N2 is '),write(N2),nl, 95 | N3 is N2 + Q, 96 | makename(G,'_Caller',Temp), 97 | makename(Temp,Arity,Iname), 98 | makelist(N3,Hdomain), 99 | append(Hdomain,[Grange],Hdomain1), 100 | append(Hdomain1,[Frange],Hdomain2), 101 | append(Gdom,Hdomain,Newdr1), 102 | append(Newdr1,[Frange], Newdr), 103 | get(G,[defn,name],[Main_functor_G]), 104 | Func1 =.. [Main_functor_G|T1], 105 | Func2 =.. [Iname|Hdomain2], 106 | Func3 =.. [Topname|Newdr], 107 | Alg=(Func3:-Func1,Func2),!, 108 | %debugging 109 | write(Alg), 110 | (/*flag,*/fail, 111 | check_with_user2(F,G,Topname,Alg,Newname2), 112 | assertz(newname(Newname2)); 113 | Newname2 = Topname), 114 | Func4=..[Newname2|Newdr], 115 | Alg2=(Func4:-Func1,Func2), 116 | assertz(Alg2), 117 | (retract(flag); true), 118 | Arity2 is Arity - 1, 119 | Q2 is Q + 1, 120 | loop_make_composit(F,Iname,Glist,FoGdrlist,_,_,Arity2,Q2). 121 | 122 | sumup([],N2,N2). 123 | sumup([L1|List],N2,N3):- 124 | length(L1,N4), 125 | N5 is N2 + N4 - 1, 126 | sumup(List,N5,N3). 127 | 128 | loop_composit(F,G,N,X,X,Y,Y,_):- 129 | N = 0. 130 | 131 | loop_composit(F,G,N,Glist,New_Glist,Old_FoGdr,New_FoGdr,It) :- 132 | get(F,[dom_range],Fdr), 133 | bget(G,[dom_range],Gdr), 134 | get_composite_dr(Fdr,Gdr,FoGdr,It), 135 | N1 is N - 1, 136 | It2 is It + 1, 137 | loop_composit(F,_,N1,[G|Glist],New_Glist,[FoGdr|Old_FoGdr], 138 | New_FoGdr,It2). 139 | 140 | /* a general get_composit_dr */ 141 | get_composite_dr(Fdr,Gdr,FoGdr,It):- 142 | member(X,Gdr), 143 | split_last(X,Gdom,Grange), 144 | genls_sf(Grange,Gens_of_grange), 145 | member(FDR,Fdr), 146 | split_last(FDR,Fdom,Frange), 147 | get_arg_num_val(Fdom,Fdom2,It,1), 148 | member(Fdom2,Gens_of_grange), 149 | append(Gdom,[Frange],FoGdr). 150 | 151 | 152 | get_arg_num_val([DOM1|DOMLIST],DOM1,IT,IT). 153 | 154 | get_arg_num_val([_|DOMLIST],DOM1,IT,IT3):- 155 | IT2 is IT3 + 1, 156 | get_arg_num_val(DOMLIST,DOM1,IT,IT2). 157 | 158 | 159 | 160 | 161 | 162 | /* get_composite_dr finds a legal domain-range for the composition. It searches 163 | the domain-range lists of f and g for a pair such that the 164 | range of g is the domain of f. The legal composite is g's domain and f's 165 | range. */ 166 | get_composite_dr(Fdr,Gdr,FoGdr):- 167 | member(X,Gdr), 168 | split_last(X,Gdom,Grange), 169 | genls_sf(Grange,Gens_of_grange), 170 | member([Fdom,Frange],Fdr), 171 | member(Fdom,Gens_of_grange), 172 | append(Gdom,[Frange],FoGdr). 173 | 174 | /* make_composite_alg creates f o g in clausal form. First it gensyms a list 175 | of symbols to serve as variables in the clause. Then it assigns them to 176 | g's domain, g's range(1), and f's range(1). Then a new clause is synthesized 177 | and given the tentative name F_o_G (where F_o_G(...Y):-G(...X),F(X,Y).). 178 | Finally the user is shown the composition and is given a chance to reject it 179 | or to rename it, then the algorithm is asserted. */ 180 | make_composite_alg(F,G,FoGdr,Newname2,Alg):- 181 | length(FoGdr,N),N1 is N+1, 182 | makelist(N1,[Frange,Grange|Gdom]), 183 | append(Gdom,[Grange],T1), 184 | T2=[Grange,Frange], 185 | get(F,[defn,name],[Main_functor_F]), 186 | get(G,[defn,name],[Main_functor_G]), 187 | Func1=..[Main_functor_G|T1], 188 | Func2=..[Main_functor_F|T2], 189 | makename(F,'_o_',Temp), 190 | makename(Temp,G,Newname), 191 | append(Gdom,[Frange],Newdr), 192 | Func3=..[Newname|Newdr], 193 | Alg=(Func3:-Func1,Func2),!, 194 | %debugging 195 | write(Alg), 196 | check_with_user2(F,G,Newname,Alg,Newname2), 197 | Func4=..[Newname2|Newdr], 198 | Alg2=(Func4:-Func1,Func2), 199 | assertz(Alg2). 200 | 201 | /* create_composite_concept creates a concept frame for the new operation. 202 | Then a task is added to the agenda to generate examples of the new 203 | concept. */ 204 | create_composite_concept(F,G,Conceptname,Alg,Dom_range):- 205 | put(Conceptname,[name],Conceptname), 206 | put(Conceptname,[defn,name],Conceptname), 207 | put(Conceptname,[alg],Conceptname), 208 | %I had to use putvals and not put as ray had it. That was a bug -marcos 209 | putvals(Conceptname,[dom_range],Dom_range), 210 | put(Conceptname,[genl],F), 211 | put(Conceptname,[genl],G), 212 | put(Conceptname,[compose],[F,G]), /* pseudo-facet identifies composition 213 | */ 214 | get(F,[worth],[W1]), 215 | get(G,[worth],[W2]), 216 | New_worth is (W1+W2)/2, 217 | put(Conceptname,[worth],New_worth), 218 | addtoagenda(fillin,Conceptname,[examples],200, 219 | 'no examples of this new concept'). 220 | 221 | create_composite_concept2(F,Glist,Conceptname,Alg,Dom_range):- 222 | put(Conceptname,[name],Conceptname), 223 | put(Conceptname,[defn,name],Conceptname), 224 | put(Conceptname,[alg],Conceptname), 225 | %I had to use putvals and not put as ray had it. That was a bug -marcos 226 | putvals(Conceptname,[dom_range],Dom_range), 227 | put(Conceptname,[genl],F), 228 | putlist(Conceptname,[genl],Glist), 229 | append([F],Glist,FGlist), 230 | put(Conceptname,[compose],FGlist), 231 | /* pseudo-facet identifies composition 232 | */ 233 | get(F,[worth],[W1]), 234 | get_ave_worth(Glist,0,0,W2), 235 | New_worth is (W1+W2)/2, 236 | put(Conceptname,[worth],New_worth), 237 | addtoagenda(fillin,Conceptname,[examples],200, 238 | 'no examples of this new concept'). 239 | 240 | 241 | /*utility-ru for my bastard piece of modification on ray's code.*/ 242 | get_ave_worth([],C,W2,R):- R is W2/C. 243 | get_ave_worth(Glist,C,W2,_):- var(Glist), !,fail. 244 | get_ave_worth([G|Glist],C,W2,R):- 245 | C2 is C + 1, 246 | get(G,[worth],[W4]), 247 | W3 is W2 + W4, 248 | get_ave_worth(Glist,C2,W3,R). 249 | 250 | /*this is just putvals rewritten because I did not know about 251 | putvals -marcos.*/ 252 | putlist(Conceptname,FS,[]). 253 | putlist(Conceptname,FS,[G|Glist]):- 254 | put(Conceptname,FS,G), 255 | putlist(Conceptname,FS,Glist). 256 | 257 | /* check_with_user2 allows the user to discard or rename a newly created 258 | composition. If he/she renames the concept, the new name is returned. 259 | Note that this routine is very similar to check_with_user written by Bruce. 260 | */ 261 | /* taking this unnecessary gabbing out! -marcos*/ 262 | check_with_user2(F,G,Newname,Alg,Newname2):- 263 | assertz(gensymed_concepts(Newname,Alg,none)). 264 | check_with_user2(F,G,Newname,Alg,Newname2):- 265 | nl,nl, 266 | write('I have created a new concept definition which is a composition of '),nl, 267 | write(F),write(' and '),write(G),nl, 268 | write('This concept is defined as follows:'),nl, 269 | write(Alg),nl, 270 | write('Do you want to keep this new concept (y/n)? '), 271 | nl,aminput('y'), 272 | write('Please type new name for this concept or to keep the current name: '), 273 | nl,aminput(X), 274 | ((X='',Newname2=Newname); 275 | (\+ X='',Newname2=X)). 276 | 277 | -------------------------------------------------------------------------------- /common.pl: -------------------------------------------------------------------------------- 1 | :- public([ 2 | times_up/2, collectclauses/3, makelist/2, 3 | ok_a/2,termination_a/3,cleanup_a/2,addnum_a/1, 4 | check_if_any_found/2,unifyinst/4, 5 | 6 | allconcepts/1,fillable_slots/1,examples/2,exs/2, 7 | isas/2,genls/2,specs/2,ripple/3,collect/3, 8 | genls_sf/2,specs_sf/2,ripple_sf/3,getarity/2, 9 | get/3,concept/1,put/3,putvals/3,update/3,fremove/3, 10 | fremoveall/2,ppframe/1,ppall/0,worth/2,aminput/1]). 11 | 12 | %Use examine/0 to browse the concept base 13 | examine:- 14 | write('EXAMINE which concept? (completion supported) '), 15 | aminput(ConToken), 16 | \+member(ConToken,['',q,quit,e,exit]), 17 | name(ConToken,ConString), 18 | frame(Name,_,_), name(Name,FrameString), 19 | append(ConString,_,FrameString), % isa match? 20 | ppframe(Name), 21 | !, examine. 22 | 23 | 24 | /*** times_up succeeds if the elapsed time exceeds the alloted time; 25 | **** else fail. 26 | ***/ 27 | 28 | times_up(Alotment,Start):- clock(Start,T),T>Alotment. 29 | 30 | /*** collectclauses forms a list of all clauses with a given mainfunctor. 31 | **** The only tricky part is forming a template which will match the 32 | **** head of each of the clauses (this to satisfy the 'clause' predicate). 33 | ***/ 34 | 35 | collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), 36 | bagof([Func,Body], clause(Func,Body), Clauses). 37 | functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. 38 | 39 | /*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ 40 | 41 | makelist(0,[]). 42 | makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). 43 | 44 | 45 | /************************************************************* 46 | * The following set of functions are used to control a 47 | * heuristics which uses backtracking, and produces results 48 | * through side_effects. 49 | */ 50 | 51 | ok_a(Start,Allot) :- clock(Start,T), Allot > T. 52 | ok_a(Start,Allot) :- clock(Start,T), Allot > T,ok_a(Start,Allot). 53 | 54 | makenumcall(H,Var,Call) :- makename(H,num,Funct), Call =.. [Funct,Var]. 55 | 56 | termination_a(H,_,_) :- makenumcall(H,Num,Call),Call,Num>24. 57 | termination_a(_,S,T) :- times_up(S,T). 58 | 59 | cleanup_a(H,Num) :- makenumcall(H,Num,X),retract(X),!. 60 | cleanup_a(_,0). 61 | 62 | addnum_a(H) :- makenumcall(H,Num,Term), retract(Term), 63 | N is Num +1,makenumcall(H,N,New),asserta(New),!. 64 | addnum_a(H) :- makenumcall(H,1,Term), 65 | asserta(Term). 66 | 67 | check_if_any_found(H,C) :- makenumcall(H,Num,Call),Call,integer(Num), 68 | Num > 0, 69 | addtoagenda(check,C,[examples,typ],200,'have found some exs of C'). 70 | 71 | /******************** END OF SET **********************************/ 72 | 73 | 74 | /****************************************************** 75 | * unifyinst is the result of an inconsistency 76 | * in our treatment of examples. The example of an 77 | * object is different from an example of an activity. 78 | * I.e. objects have an arity of 1, with NO dom/ran. 79 | * So we have to unify them differently to get the 80 | * appropriate call. 81 | */ 82 | unifyinst(1,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor,Ex],!. 83 | unifyinst(_,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor|Ex]. 84 | 85 | makeinst(Defn,1,Ex,Call) :- Call =.. [Defn,Ex],!. 86 | makeinst(Defn,_,Ex,Call) :- Call =.. [Defn|Ex]. 87 | 88 | %% End of COMMON STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 89 | 90 | /* return all currently defined concepts */ 91 | allconcepts(C) :- 92 | setof(X,Y^frame(X,[name],Y),C). 93 | 94 | /* return all slots that AM has heuristics to fillin */ 95 | fillable_slots(S) :- 96 | S = [[defn],[examples],[genl],[spec],[alg],[dom_range], 97 | [in_domain_of],[in_range_of],[isas]]. 98 | /* collect X.examples since they may live on several sub-slots */ 99 | examples(Con,L) :- 100 | get(Con,[examples,bnd],L1), /* bound changed to bnd, KM 7/24 */ 101 | get(Con,[examples,typ],L2), 102 | append(L1,L2,L). 103 | 104 | /* collect all the examples of Con by collecting the examples 105 | * of all the specs of Con 106 | */ 107 | exs(Con,Examples):- 108 | specs_sf(Con,Specs), % spec*(X)=Specs 109 | removedups(Specs,Specs1), 110 | exs1(Specs1,Exs), % examples(Specs)=Exs 111 | exs2(Exs,Examples),!. % spec*(Exs)=Examples 112 | 113 | 114 | exs1([],[]). 115 | exs1([H|T],L) :- examples(H,L1),exs1(T,L2), union(L1,L2,L). 116 | 117 | exs2([],[]). 118 | exs2([H|T],L) :- ripple(down,H,L1),exs2(T,L2),union(L1,L2,L). 119 | 120 | /* collect the isas according to the formula: 121 | * genl*(isa(genl*(X))) 122 | */ 123 | isas(Con,L1) :- genls_sf(Con,G), 124 | collect([isas],G,Isas1), 125 | removedups(Isas1,Isas2), 126 | isas1(Isas2,L), 127 | removedups(L,L1). 128 | 129 | isas1([],[]). 130 | isas1([H|T],L) :- genls_sf(H,L1),isas1(T,L2),append(L1,L2,L). 131 | 132 | /* collect genls or specs of a concept X by rippling UP or Down in 133 | * the hierarchy 134 | * ripple(+direction,+concept,-list of concepts) 135 | */ 136 | 137 | genls(Con,G) :- ripple(up,Con,G),!. 138 | 139 | specs(Con,S) :- ripple(down,Con,S),!. 140 | 141 | ripple(up,X,Genls) :- ripple1([genl],[X],G),Genls = [X|G]. 142 | ripple(down,X,Specs) :- ripple1([spec],[X],G),Specs = [X|G]. 143 | ripple(_,X,[X]). 144 | 145 | ripple1(_,[],[]):-!. 146 | ripple1(Dir,X,G) :- adjacent_to(Dir,X,G1), 147 | ripple1(Dir,G1,G2), 148 | append(G1,G2,G). 149 | 150 | /* ripple_sf is a safe ripple, that can deal with loops in the tree 151 | * similarly with genls_sf and specs_sf 152 | */ 153 | genls_sf(C,G) :- ripple_sf(up,C,G),!. 154 | specs_sf(C,S) :- ripple_sf(down,C,S),!. 155 | 156 | ripple_sf(up,X,Genls) :- ripple_sf1([genl],[X],[X],G),Genls = [X|G], !. 157 | ripple_sf(down,X,Specs) :- ripple_sf1([spec],[X],[X],G),Specs = [X|G], !. 158 | ripple_sf(_,X,[X]). 159 | 160 | ripple_sf1(_,_,[],[]):-!. 161 | ripple_sf1(Dir,Seen,Level,G) :- 162 | adjacent_to(Dir,Level,Nextlevel), 163 | setdif(Nextlevel,Seen,Neverseen), 164 | append(Seen,Neverseen,Nowseen), 165 | ripple_sf1(Dir,Nowseen,Neverseen,G1), 166 | append(Neverseen,G1,G). 167 | 168 | adjacent_to(_,[],[]):-!. 169 | adjacent_to(Dir,[H|T],G) :- get(H,Dir,G1), 170 | adjacent_to(Dir,T,G2), 171 | append(G1,G2,G). 172 | 173 | /* collect all the entries on Slot for each concept in List 174 | * collect(+Slot,+List_of_cons,-List_of_vals) 175 | */ 176 | collect(_,[],[]):-!. 177 | collect(Slot,[H|T],L) :- 178 | get(H,Slot,L1), 179 | collect(Slot,T,L2), 180 | append(L1,L2,L). 181 | 182 | /* returns the arity of a concept definition */ 183 | getarity(Con,Arity) :- 184 | get(Con,[dom_range],[L|_]), length(L,Arity). 185 | getarity(Con,Arity) :- get(Con,[defn,arity],[Arity]). 186 | 187 | concept(C) :- frame(C,_,_),!. 188 | 189 | get(Name,Slot,Value):- frame(Name,Slot,Value),!. 190 | get(_,[worth],[0]). 191 | get(_,[examples, dif],[0,0]). 192 | get(_,_,[]). 193 | % commented out because they don't work (in my opinion). 194 | %get(Name,Slot,Value) :- nonvar(Value), !, 195 | % get1(Name,Slot,Value). 196 | %get1(Name,Slot,Value) :- frame(Name,Slot,X),!,X = Value. 197 | %get1(Name,Slot,[]). 198 | %to put a single element onto a slot 199 | 200 | % the first clause catches all changes to the concept base and displays them. 201 | %? put(C,S,V):- 202 | %? watch_mode_on, % if you want a trace, 203 | %? print_put_trace(C,S,V). % ! This will fail and backtrack to the real put/3. 204 | put(C,S,V) :- put1(C,S,V),!. 205 | 206 | /* This stuff is duplicated in am.pl so it will be interpreted because it 207 | doesn't work if it's compiled. (another FEATURE of VAX/VMS QP) */ 208 | print_put_trace(C,S,V):- 209 | ancestors([G|_]), % find out who's calling put/3, 210 | G=..[H|_], 211 | writeln([' ',H,'is adding',V,to,the,S,slot,of,C,nl]), % show change, 212 | !, fail. 213 | 214 | put1(C,[examples,dif],[N,T]) :- !,nonvar(N),nonvar(T), 215 | ((retract(frame(C,[examples,dif],[N1,T1])), 216 | N2 is N + N1, T2 is T + T1, 217 | assertz(frame(C,[examples,dif],[N2,T2]))) 218 | ; 219 | (assertz(frame(C,[examples,dif],[N,T])))). 220 | put1(C,[spec],V) :- 221 | put2(C,[spec],V), 222 | put2(V,[genl],C). 223 | put1(C,[genl],V) :- 224 | put2(C,[genl],V), 225 | put2(V,[spec],C). 226 | put1(C,[worth],W) :- 227 | update(C,[worth],[W]). 228 | put1(C,[dom_range],D_r) :- 229 | put_d_r(C,D_r), 230 | put2(C,[dom_range],D_r). 231 | put1(C,[isas],V) :- 232 | put2(C,[isas],V), 233 | put2(V,[examples,typ],C). 234 | put1(C,[examples,T],V) :- 235 | concept(V), 236 | member(T,[bnd,typ]), 237 | put2(C,[examples,T],V), 238 | put2(V,[isas],C). 239 | put1(C,[conjecs],X) :- 240 | put2(C,[conjecs],X), 241 | put1(conjecs,[examples,typ],X). 242 | 243 | put1(C,S,V) :- put2(C,S,V). 244 | 245 | put2(Name,Slot,Item) :- frame(Name,Slot,Value), 246 | member(Item,Value). 247 | put2(Name,Slot,Item) :- retract(frame(Name,Slot,Value)), 248 | assertz(frame(Name,Slot,[Item|Value])). 249 | put2(Name,Slot,Item) :- assertz(frame(Name,Slot,[Item])). 250 | 251 | put_d_r(C,[R]) :- put(R,[in_range_of],C). 252 | put_d_r(C,[D|R]) :- put(D,[in_domain_of],C),put_d_r(C,R). 253 | 254 | %to add several vals to a slot 255 | putvals(_,_,[]). 256 | putvals(C,S,[H|T]) :- 257 | putvals(C,S,T), 258 | put(C,S,H). 259 | 260 | %update - to replace oldvalue with newvalue 261 | update(Name,Slot,Newval) :- retract(frame(Name,Slot,_)), 262 | assertz(frame(Name,Slot,Newval)). 263 | update(Name,Slot,Newval) :- assertz(frame(Name,Slot,Newval)). 264 | 265 | %fremove - remove item from values of slot. Fail if not present 266 | fremove(C,S,V) :- fremove0(C,S,V),!. 267 | 268 | fremove0(C,[genl],V) :- 269 | fremove1(C,[genl],V), 270 | fremove1(V,[spec],C). 271 | fremove0(C,[spec],V) :- 272 | fremove1(C,[spec],V), 273 | fremove1(V,[genl],C). 274 | fremove0(C,[isas],V) :- 275 | fremove1(C,[isas],V), 276 | fremove1(V,[examples,typ],C). 277 | fremove0(C,[examples,T],V) :- concept(C),member(T,[typ,bnd]), 278 | fremove1(C,[examples,T],V), 279 | fremove(V,[isas],C). 280 | 281 | fremove0(C,S,V) :- fremove1(C,S,V). 282 | 283 | fremove1(Name,Slot,Item) :- frame(Name,Slot,Val), 284 | remove(Item,Val,Newval), 285 | update(Name,Slot,Newval). 286 | fremove1(_,_,_). 287 | 288 | % remove the entire slot. 289 | fremoveall(Name,Slot) :- retract(frame(Name,Slot,_)). 290 | fremoveall(_,_). 291 | 292 | /* print all concept frames to current stream */ 293 | 294 | ppall :- 295 | allconcepts(X), 296 | member(A,X), 297 | ppframe(A),nl, 298 | fail. 299 | ppall. 300 | 301 | /* print a frame and the values on its slots */ 302 | ppframe(X) :- 303 | mysetof((Y,Z),frame(X,Y,Z),L), 304 | remove(([name],Names),L,L1), 305 | write(X),write(': '),myprint(Names,_),nl, 306 | ppframe1(L1),nl,!. 307 | 308 | ppframe1([(Slot,Vals)|R]) :- 309 | tab(3), myprint(Slot,Len),write(':'), Col is 3 + Len, 310 | ((Col < 25,tab(25 - Col)) 311 | ;true), 312 | tab(3), print(Vals), 313 | nl,ppframe1(R). 314 | ppframe1([]). 315 | 316 | 317 | /* in addition to the worth of a concept, there is an apriori worth 318 | * given to each operation and slot. 319 | */ 320 | worth(A,W) :- frame(A,[worth],[W]). 321 | worth(Operation,300) :- member(Operation,[fillin,check,int,suggest]). 322 | worth(Slot,300). 323 | 324 | 325 | aminput(X):- write('>>'),ttyflush,myinput(X). 326 | 327 | -------------------------------------------------------------------------------- /h/h0.pl: -------------------------------------------------------------------------------- 1 | /* Some of these heuristics were derived from Lenat'st thesis. They were 2 | not explicitly listed though. They a start at 402. 3 | 4 | 5 | */ 6 | 7 | /* if the number of examples of C are between 5 and 30 increment worth. 8 | This is Lenat's no too many not too few */ 9 | 10 | 11 | h402(C):- 12 | (exs(C,Examples);get(C,[examples,typ],Examples)), 13 | length(Examples,N), 14 | N > 5, N < 30, 15 | (retract(frame(C,[worth],[Worth]));Worth = 100), 16 | Worth2 is Worth + (Worth + 1)/5, 17 | assertz(frame(C,[worth],[Worth2])). 18 | 19 | h402(C):- 20 | (exs(C,Examples);get(C,[examples,typ],Examples)), 21 | length(Examples,N), 22 | N < 5, 23 | (retract(frame(C,[worth],[Worth]));Worth = 1), 24 | Worth2 is Worth/2, 25 | assertz(frame(C,[worth],[Worth2])). 26 | 27 | 28 | 29 | h402(C):- 30 | (exs(C,Examples);get(C,[examples,typ],Examples)), 31 | length(Examples,N), 32 | N > 40, 33 | (retract(frame(C,[worth],[Worth])); Worth = 1), 34 | Worth2 is Worth/2, 35 | assertz(frame(C,[worth],[Worth2])). 36 | 37 | 38 | 39 | /* if a concept is worthwhile then compose it with itself; this is short 40 | of like Lenat's repetition heuristic. However, the only way that that 41 | heuristic will work is if the domain = range! Thus one could be equal to 42 | repetitive application of a concept and it might not. -marcos */ 43 | 44 | h407(F):- 45 | get(F,[worth],[Worth]), 46 | Worth > 200, 47 | assertz(flag), 48 | getarity(F,N1), N is N1 -1, 49 | loop_composit(F,F,N,[],Glist,[],FoGdr,1), 50 | makename(F,'_o_',Temp), 51 | loopmakename(Temp,Glist,SeedName), 52 | loop_make_composit(F,SeedName,Glist,FoGdr,Newname,Algorogo,N,0),!, 53 | assertz(flag), 54 | create_composite_concept2(F,Glist,Newname,Algorogo,FoGdr). 55 | 56 | loop_composit(F,G,N,X,X,Y,Y,_):- 57 | N = 0. 58 | 59 | loop_composit(F,G,N,Glist,New_Glist,Old_FoGdr,New_FoGdr,It) :- 60 | get(F,[dom_range],Fdr), 61 | get(F,[dom_range],Gdr), 62 | get_composite_dr(Fdr,Gdr,FoGdr,It), 63 | N1 is N - 1, 64 | It2 is It + 1, 65 | loop_composit(F,F,N1,[G|Glist],New_Glist,[FoGdr|Old_FoGdr], 66 | New_FoGdr,It2). 67 | 68 | /* this is another attemp to have a heuristic that makes multiple attempts 69 | at doing something repetitively. I am assuming that the number of 70 | repetitions it not crucial. And of course it runs both forwards and 71 | backwards! It also runs with just one var as input. That is to say 72 | the above applies to the defns and the algs that this heuristic 73 | creates! -marcos */ 74 | 75 | 76 | h408(C):- 77 | get(C,[worth],[Worth]), 78 | Worth >= 100, 79 | get(C,[defn,name],[CON_NAME]), 80 | getarity(C,N), 81 | do_while_time(C,CON_NAME,Worth,N). 82 | 83 | do_while_time(C,Defn_Name,Worth,N):- 84 | Times is Worth/10, 85 | makename(Defn_Name,'_X_',Temp), 86 | makename(Temp,Times,NewC_Dname), 87 | makeit(Defn_Name,N,Worth,Alg,NewC_Dname), 88 | get(C,[dom_range],Dom_range), Conceptname = NewC_Dname, 89 | /* check_with_user(),*/ 90 | write(Alg), 91 | create_composite_concept(C,NewC_Dname,Alg,Dom_range). 92 | 93 | create_composite_concept(F,Conceptname,Alg,Dom_range):- 94 | put(Conceptname,[name],Conceptname), 95 | put(Conceptname,[defn,name],Conceptname), 96 | put(Conceptname,[alg],Conceptname), 97 | assertz(frame(Conceptname,[dom_range],Dom_range)), 98 | put(Conceptname,[genl],F), 99 | get(F,[worth],[W1]), 100 | put(Conceptname,[worth],W1), 101 | addtoagenda(fillin,Conceptname,[examples],W1, 102 | 'no examples of this new concept'). 103 | 104 | 105 | 106 | makeit(D,N,Worth,Alg,Name):- 107 | Count is Worth/10, 108 | makelist(N,List), 109 | split_last(List,Domain,Range), 110 | split_last(Domain,D1,D2), 111 | append(Domain,[D2],List2), 112 | append(Domain,[OutPut],List4), 113 | append(D1,[Range,OutPut],List3), 114 | Pred1 =.. [D|List], 115 | Pred2 =.. [Name|List2], 116 | Pred3 =.. [Name|List3], 117 | Pred4 =.. [Name|List4], 118 | makename(Name,'count',NewName), 119 | CP1 =.. [NewName|[Count1]], 120 | CP2 =.. [NewName|[Count2]], 121 | 122 | C0 = (Pred2:- CP1,Count1 > Count, retract(CP2)), 123 | C1 = (Pred4:- Pred1, (retract(CP1); 124 | Count1 = 0), Count2 is Count1 + 1, 125 | assertz(CP2), 126 | Pred3), 127 | assertz(C1), 128 | asserta(C0),nl, write(C0),nl, write(C1),nl,Alg=[C0,C1]. 129 | 130 | 131 | 132 | 133 | /* 134 | callit(D,[],WholeExs,N,Output,Count,Worth,Start,LastR):- 135 | End = Start + 20, 136 | clock(End,End2), 137 | End2 < 0, 138 | callit(D,WholeExs,WholeExs,N,Output,Count,Worth,Start,LastR). 139 | 140 | callit(Dname,[E1|Rest],WholeExs,N,Output,Count,Worth,Start,LastR):- 141 | End = Start + 10, 142 | clock(End,End2), 143 | End2 < 0, 144 | split_last(E1,Range,Dom), 145 | ((var(LastR),Range2 = Range); 146 | (split_last(Range,[R1],R2), 147 | append(R1,LastR,Range2))) 148 | append(Range2,[Dom2],RDList), 149 | Pred =..[Dname|RDList], 150 | Count2 is Count + 1, 151 | callit(Dname,Rest,WholeExs,N,Output,Count2,Worth,Start,Dom2). 152 | 153 | callit(Dname,_,_,N,Output,Count,Worth,Start,Output):- 154 | End = Start + 10, 155 | clock(End,End2), 156 | End2 >= 0. 157 | 158 | 159 | 160 | 161 | */ 162 | 163 | 164 | 165 | /* This function is the general inverse function. It's a little funky 166 | because most of the prolog defn's and alg's don't really run perfectly 167 | backwards and forwards, even though I debugged them alot. So I had 168 | to put in a few caviats into this heuristic. And of course this is 169 | not a perfect inverse because there are many ways to do an inverse for 170 | an N-ary function. Or so it seems to me. Though calls like : 171 | 172 | | ?- inverse_of_set_insert_defn([a],a,P). 173 | 174 | P = [] 175 | 176 | | ?- inverse_of_set_insert_defn([a],B,P). 177 | 178 | B = a, 179 | P = [] 180 | 181 | Produce the right results calls like: 182 | 183 | yes 184 | | ?- inverse_of_set_insert_defn([a],[],P). 185 | 186 | no 187 | | ?- 188 | So I have h409 make, for arity = 3, and perhaps greater, simply the reverse 189 | of the dom_range list! 190 | 191 | -marcos 192 | */ 193 | 194 | h409(C):- 195 | get(C,[defn,name],[DN]), 196 | getarity(C,N), 197 | makelist(N,List), 198 | split_last(List,Dom,Range), 199 | ((N > 2, 200 | split_last(Dom,D1,D2), 201 | append([Range],D1,RD1), 202 | append(RD1,[D2],RD)); append([Range],Dom,RD)), 203 | makename('inverse_of_',DN,Nname), 204 | Pred1 =.. [Nname|RD], 205 | Pred2 =.. [DN|List], 206 | Alg = (Pred1:-Pred2,((N>2,not(Range = D2)); 207 | (N=2,not([Range] = Dom)))), 208 | ((N >= 3, 209 | reverse(List,Rlist), 210 | Pred3 =.. [Nname|Rlist], 211 | Alg2 = (Pred3:-Pred2,not(Range = D2)), 212 | assertz(Alg2));true), 213 | asserta(Alg),nl,write(Alg),nl,write(Alg2),nl. 214 | 215 | 216 | 217 | 218 | not(X):-X,!,fail. 219 | not(X). 220 | 221 | 222 | /* this is a gag for AM -marcos*/ 223 | 224 | check_with_user(Concept,Relation,NewConcept,NewClauses,NewConceptName,NewClauses2):- not(if_Flag), 225 | matchtoname(NewClauses,Cname), 226 | assertz(gensymed_concepts(Concept,NewConcept,Relation,Cname)), 227 | NewClauses2 = NewClauses, NewConcept = NewConceptname. 228 | matchtoname([[C|T]],C). 229 | 230 | 231 | 232 | check_with_user(Concept,Relation,NewConcept,NewClauses,NewConceptName,NewClauses2):- 233 | nl,nl, 234 | write(' I have created a concept definition which is a '), write(Relation), 235 | write(' of'), nl,write(Concept),write('.'), 236 | write(' This new concept is defined as follows: '), nl, 237 | ppclauses(NewClauses), nl, 238 | repeat, 239 | write(' Do you want to keep this new concept (y/n)? '), 240 | aminput(Reply), (Reply=y ; Reply=n ; Reply=''), 241 | !, (Reply=y ; Reply=''), 242 | repeat, 243 | write(' Please type new name for this concept or to keep current name:'), 244 | aminput(X), 245 | check_new_concept_name(X,NewConcept,NewConceptName,NewClauses,NewClauses2), 246 | !. 247 | 248 | 249 | run_I_face:- assertz(if_Flag), 250 | gensymed_concepts(Concept,NewConcept,Relation,OldName), 251 | check_with_user(Concept,Relation,NewConcept,NewClauses,NewConceptname, 252 | NewClauses2), 253 | retract(if_Flag), 254 | (var(NewConceptname); 255 | retract(frame(OldName,[name],[_])), 256 | retract(frame(OldName,[defn,name],[_])), 257 | retract(frame(OldName,[worth],[Worth])), 258 | Worth2 is Worth + 100, 259 | put(Concept,[name],NewConceptname), 260 | put(Concept,[defn,name],[NewClauses2]), 261 | put(Concept,[worth],Worth), 262 | retract(agenda(A)), 263 | inc_tasks(Concept,NewConceptname,A,100,[],P)), 264 | subCname(Concept,NewConceptname). 265 | 266 | 267 | inc_tasks(C,Cn,[],W,O,O). 268 | inc_tasks(C,Nc,A,W,O,P):- 269 | split(A,[[L,C,L2,W1,L3]|Tail]), 270 | W2 is W1 + W, 271 | inc_tasks(C,Tail,W,[[L,Nc,L2,W2,L4]|O],P), 272 | assertz(agenda(P)). 273 | 274 | /*check_with_user(Concept,Relation,NewConcept,NewClauses,NewConceptName,NewClauses2):- 275 | assertz(gensymed_concepts(Concept,NewClauses,Relation)), 276 | NewClauses2 = NewClauses. 277 | 278 | */ 279 | 280 | /*If C1 is a genl of C2 if C2 is a fenl of C3 ... if Ck is a genl of Cn then 281 | merge and increase the value of the highest value to begin with*/ 282 | 283 | h114(C):- assertz(counter(0)),h114_it(C,C,0,[]). 284 | h114a(C):-h114_ita(C,C,0,[]). 285 | 286 | h114_it(Present_C,C,Counter,CTrail):- 287 | Counter < 100, 288 | retract(counter(_)), 289 | assertz(counter(Counter)), 290 | get(Present_C,[genl],Value),!, 291 | notmember(C,Value),!, 292 | first_element_defn(Value,FirstElement), 293 | counter(Counter), 294 | New_counter is Counter + 1, 295 | h114_it(FirstElement,C,New_counter,[FirstElement|CTrail]). 296 | 297 | h114_it(Present_C,C,Counter,CTrail):- 298 | get(Present_C,[genl],Value), 299 | member(C,Value),!, 300 | rid_ex_cons(C,[Present_C|CTrail]). 301 | 302 | h114_ita(Present_C,C,Counter,CTrail):- 303 | Counter < 100, 304 | retract(counter(_)), 305 | assertz(counter(Counter)), 306 | get(Present_C,[spec],Value),!, 307 | notmember(C,Value),!, 308 | first_element_defn(Value,FirstElement), 309 | counter(Counter), 310 | New_counter is Counter + 1, 311 | h114_it(FirstElement,C,New_counter,[FirstElement|CTrail]). 312 | 313 | h114_ita(Present_C,C,Counter,CTrail):- 314 | get(Present_C,[spec],Value), 315 | member(C,Value),!, 316 | rid_ex_cons(C,[Present_C|CTrail]). 317 | 318 | rid_ex_cons(C,Ctrail):- 319 | merge_cons(C,Ctrail), 320 | retract(C,[worth],[Worth2]), 321 | Worth3 is Worth2 + Worth2/2, 322 | assertz(C,[worth],[Worth3]). 323 | 324 | merge_cons(C,[]). 325 | 326 | merge_cons(C,[C2|Ctrail]):- 327 | get(C2,X,Y), 328 | get(C,X,Y), 329 | retract(C2,X,Y), 330 | merge_cons(C,Ctrail). 331 | merge_cons(C,[C2|Ctrail]):- 332 | get(C2,X,Y), 333 | not(get(C,X,Y)), 334 | assertz(frame(C,X,Y)), 335 | retract(frame(C2,X,Y)), 336 | merge_cons(C,Ctrail). 337 | 338 | 339 | 340 | h28(C1):- 341 | get(C,[examples,P],Value), 342 | get(C1,[examples,P],Value2), 343 | set_equal_defn(Value,Value2), 344 | rid_ex_cons(C,[C1]). 345 | h28(C1):- 346 | h114(C1). 347 | h28(C1):- 348 | h114a(C1). 349 | 350 | 351 | h36(C):- 352 | h36_limited(C,0). 353 | 354 | h36_limited(C,Counter):- 355 | Counter < 100, 356 | get(C1,[examples,typ],V), 357 | first_element(V,F), 358 | get(C1,[defn,name],[Defn]), 359 | Defn2 =.. [Defn|F], 360 | Defn2, 361 | retract(C,[examples,typ],V2), 362 | append(V2,F,V3), 363 | assertz(C,[examples,typ],V3). 364 | 365 | 366 | frame(gob1,[genl],[gob2,gob3]). 367 | frame(gob1,[sap],[ya]). 368 | frame(gob1,[worth],[100]). 369 | frame(gob3,[sap],[ya]). 370 | frame(gob2,[worth],[100]). 371 | frame(gob3,[genl],[gob4]). 372 | frame(gob4,[genl],[gob5]). 373 | frame(gob5,[genl],[gob1]). 374 | frame(gob5,[sap],[ya]). 375 | 376 | bget(_,_,_):-write('bogus definition of bget'),nl, 377 | write('this is a bug, I fail'),nl, 378 | write('I am in h0.pl'),nl,!,fail. 379 | 380 | -------------------------------------------------------------------------------- /utilities.pl: -------------------------------------------------------------------------------- 1 | :- public([ 2 | split/2,null/1,not_null_list/1,consp/1,cons/3,split_last/3, 3 | firstn/3,reverse/2,removeall/3,remove/3, 4 | remove_or_die/3, 5 | removelast/2,nth/3,wrlist/1,myinput/1,list/1,flatten/2, 6 | lastof/2,append/3,concat/3,replace/4,assoclist/3,union/3, 7 | setdiff/3,intersection/3, 8 | makeset/2,merge/3,setmember/2, 9 | 10 | member/2,seteq/2,delete/3,absval/2,mysetof/3,mybagof/3, 11 | /*ucall/1,*/clock/2,gensym/2,myprint/2,pp/1,printstring/1, 12 | printstrings/1,makename/3, 13 | 14 | collectclauses/3, makelist/2, if/2, if/3, 15 | 16 | explode/2,random/2,removedups/2,removetop/3,setdif/3, 17 | apply/2,format/3,format/2,prompt_and_read/3,randomelement/2, 18 | remove_random/2,randombreak/3,remove_nth/3]). 19 | 20 | split(X,X). 21 | 22 | null([]). 23 | 24 | not_null_list([_|_]). 25 | consp([_|_]). 26 | cons(A,B,[A|B]). 27 | 28 | /* Split_last(+List,-Allbutlast,-Last) */ 29 | split_last([A,B],[A],B). 30 | split_last([H|T],[H|T1],Last) :- split_last(T,T1,Last). 31 | 32 | firstn([],N,[]). 33 | firstn([H|Remlist],N,[H|Remfirst]):- 34 | N>0, N1 is N-1,firstn(Remlist,N1,Remfirst). 35 | firstn(List,N,[]):- \+N>0. 36 | 37 | 38 | 39 | %? reverse(L,L1):- reverse_concat(L,[],L1). 40 | %? reverse_concat([X|L1],L2,L3):- reverse_concat(L1,[X|L2],L3). 41 | %? reverse_concat([],L,L). 42 | 43 | 44 | removeall(Set1,[],Set1). 45 | removeall(Set1,[Del|Rest],Set2):- remove(Set1,Del,SetX), 46 | removeall(SetX,Rest,Set2). 47 | 48 | remove(_,[],[]). 49 | remove(Member,[Member|Rest],Rest). 50 | remove(Member,[H|Rest],[H|Newrest]):- \+H=Member, remove(Member,Rest,Newrest). 51 | 52 | remove_or_die(Member,List,Newlist) :- member(Member,List), 53 | remove(Member,List,Newlist). 54 | 55 | removelast([X],[]). 56 | removelast([X|Y],[X|Z]) :- removelast(Y,Z). 57 | 58 | %? nth(L,P,V):- nth2(L,P,V,1). 59 | %? nth2([H|T],N,H,N). 60 | %? nth2([H|T],P,V,N):- \+P=N, N1 is N+1, nth2(T,P,V,N1). 61 | 62 | %length([],0). 63 | %length([X|Y],N) :- length(Y,N1), N is N1 + 1. 64 | 65 | wrlist([]). 66 | wrlist([H|Rest]):- write(' '),write(H),nl,wrlist(Rest). 67 | 68 | %? list([]). 69 | %? list([_|_]). 70 | 71 | flatten(Atom,Atom):- \+list(Atom). 72 | flatten(L,F):- list(L), flatten2(L,F),!. 73 | flatten2([],[]). 74 | flatten2([X],[X]):- \+list(X). 75 | flatten2([X|Y],Z):- flatten2(X,X1),flatten2(Y,Y1),append(X1,Y1,Z). 76 | flatten2(X,[X]):- \+list(X). 77 | 78 | lastof(L,[L]). 79 | lastof(L,[A|B]):- lastof(L,B). 80 | 81 | /* myinput allows character input ending with CR, no periods needed */ 82 | myinput(I):- myread(T),reverse(T,R), name(I,R). 83 | myread(I):- myread2([],I). 84 | myread2(Prev, More):- ttyget0(C), \+C=10, % 10 in quintus prolog 85 | myread2([C|Prev],More),!. 86 | myread2(A,A):- !. 87 | 88 | %? append([],L,L). 89 | %? append([A|B], L2, [A|L3]):- append(B,L2,L3). 90 | 91 | concat([X|L1],L2,[X|L3]):- concat(L1,L2,L3). 92 | concat([],L,L). 93 | 94 | strcat(H,T,HT):-name(H,HL), name(T,TL), append(HL,TL,HTL), name(HT,HTL). 95 | 96 | replace(Old,New,[Old|Rest],[New|Rest]). 97 | replace(Old,New,[Car|Oldlist],[Car|Newlist]):- 98 | replace(Old,New,Oldlist,Newlist). 99 | 100 | /* assoclist(Oldlist,list of pairs,Newlist) */ 101 | 102 | assoclist(List,[],List). 103 | assoclist(List,[H|Tail],L2):-assocterm(List,H,L1), 104 | assoclist(L1,Tail,L2). 105 | 106 | /* 107 | assocterm(Lhs=>Rhs, H, Nlhs=>Rhs):- assocterm(Lhs, H, Nlhs). 108 | */ 109 | assocterm([],H,[]):- !. 110 | assocterm([F|B],H,[F1|B1]):-ass1(F,H,F1),assocterm(B,H,B1). 111 | assocterm(T,H,T2):- ass1(T,H,T2),!. 112 | 113 | ass1(H,[H,T],T):- !. /* no choice here */ 114 | /* 115 | ass1(X,Pr,T):- X=..[eq,Eqno|T1], assocterm(T1,Pr,T2), T=..[eq,Eqno|T2]. 116 | ass1(X,Pr,T):- X=..[*|Ts], assocterm(Ts,Pr,T2), T=..[*|T2]. 117 | */ 118 | ass1(X,Pr,T):- X=..[X1|T1], assocterm(T1,Pr,T2), T=..[X1|T2]. 119 | ass1(X,Pr,X). 120 | 121 | union(L,[],L). 122 | union([],L,L). 123 | union([H|T],L,L1):-member(H,L),union(T,L,L1). 124 | union([H|T],L,[H|L1]):-union(T,L,L1). 125 | 126 | 127 | /* setdiff(Set1,Set2,Diff) : Diff returns the elements in Set1 not in Set2 */ 128 | 129 | setdiff([],_,[]). 130 | setdiff([H|T],Set2,[H|Diff]) :- 131 | \+ member(H,Set2), 132 | setdiff(T,Set2,Diff). 133 | setdiff([H|T],Set2,Diff) :- 134 | setdiff(T,Set2,Diff). 135 | 136 | 137 | intersection([],L,[]). 138 | intersection([H|A1],A2,[H|L]) :- 139 | member(H,A2), 140 | intersection(A1,A2,L). 141 | intersection([H|A1],A2,L) :- 142 | intersection(A1,A2,L). 143 | 144 | makeset(Bag,Set) :- mysetof(X,member(X,Bag),Set). 145 | 146 | merge([],L,L). 147 | merge([H|T],L,L1):-setmember(H,L),merge(T,L,L1). 148 | merge([H|T],L,L1):-merge(T,[H|L],L1). 149 | 150 | setmember(H,[H1|L]):-seteq(H,H1). 151 | setmember(H,[_|L]):-setmember(H,L). 152 | 153 | %? member(X,[X|T]). 154 | %? member(X,[_|T]):-member(X,T). 155 | 156 | 157 | seteq([],[]). 158 | seteq([A|B],C):-delete(A,C,C1),seteq(B,C1). 159 | 160 | %? delete(A,[A|B],B). 161 | %? delete(A,[B|C],[B|C1]):-delete(A,C,C1). 162 | 163 | absval(N,N):- integer(N), \+N<0. 164 | absval(N,AbsN):- integer(N), N<0, AbsN is -1*N. 165 | 166 | 167 | call2(X):- \+list(X), call(X). % Choice can be a single goal... 168 | call2([]). % ... or a list of goals. 169 | call2([H|T]):- call(H), call2(T). 170 | 171 | % This IF does not try to resatisfy the condition if it fails (as the QP built 172 | % in '->' does). It behaves exactly as if-then, if-then-else structures of 173 | % other languages do. 174 | % NOTE: The if, then, and else slots may be single predicates, or lists of 175 | % predicates. ie: if( [foo(x),bar(y)] , write(foobar) , [write(no),nl] ). 176 | % NOTE: IF will ALWAYS succeed, hence it's invisible to the goal satisfaction 177 | % process. 178 | % WARNING: The clauses in lists are evaluated regardless of their resulting 179 | % value, so in the above example, suppose the test fails, the 'nl' would be 180 | % evaluated even if the 'write' failed for some reason. 181 | if(If,Then):- if(If,Then,true). 182 | if(If,Then,_):- call2(If), call2(Then), !. 183 | if(If,_,Else):- call2(Else). 184 | 185 | 186 | 187 | /* mysetof & mybagof return [] if there are no values that satisfy 188 | * P(X), rather than failing as do setof & bagof. 189 | */ 190 | mysetof(A,B,C) :- setof(A,B,C). 191 | mysetof(_,_,[]). 192 | 193 | mybagof(A,B,C) :- bagof(A,B,C). 194 | mybagof(_,_,[]). 195 | 196 | /* t(X) gives time since last call to statistics. It is not 197 | * generally as useful as clock(_,_) since intermediate calls 198 | * to t(_) will reset the time. 199 | */ 200 | 201 | t(X) :- statistics(runtime,[_,X]). 202 | 203 | 204 | /*** 205 | **** turn a list into a function call 206 | ***/ 207 | %? :-op(100,fx,ucall). 208 | %? ucall(X) :- Z =.. X ,Z. 209 | 210 | /* Create a new atom starting with a root provided and 211 | * finishing with a unique number. 212 | */ 213 | gensym(Root,Atom) :- 214 | get_num(Root,Num), 215 | name(Root,Name1), 216 | name(Num,Name2), 217 | append(Name1,Name2,Name), 218 | name(Atom,Name). 219 | 220 | get_num(Root,Num) :- 221 | retract(current_num(Root,Num1)), !, 222 | Num is Num1 + 1, 223 | asserta(current_num(Root,Num)). 224 | get_num(Root,1) :- asserta(current_num(Root,1)). 225 | 226 | 227 | /* convert from an integer to a list of chars */ 228 | 229 | integer_name(Int,List) :- integer_name(Int,[],List). 230 | 231 | integer_name(I,Sofar,[C|Sofar]) :- I < 10, !, C is I + 48. 232 | integer_name(I,Sofar,List) :- Top is I / 10, 233 | Bot is I mod 10, 234 | C is Bot + 48, 235 | integer_name(Top,[C|Sofar],List). 236 | 237 | /* print a list of atoms with spaces between them, return length 238 | * of all printed chars (len of atoms + spaces) 239 | */ 240 | myprint([],0). 241 | myprint([H|T],Len) :- 242 | name(H,L),length(L,Len1), 243 | write(H),write(' '), 244 | myprint(T,Len2), Len is Len1 + Len2 +1. 245 | 246 | /* 'list' pretty printer with brackets */ 247 | /* --- Martin Purvis */ 248 | 249 | pp(X) :- write('['), 250 | pp_aux(X,1), 251 | write(']'). 252 | 253 | pp_aux([],_). 254 | pp_aux([[HH|HT]|T], I) :- J is I + 1, 255 | write('['), 256 | pp_aux([HH|HT],J), 257 | write(']'), 258 | pp_aux2(T,I). 259 | 260 | pp_aux([H|T],I) :- pp_aux(H,I), 261 | pp_aux2(T,I). 262 | pp_aux(X,I) :- write(X). 263 | 264 | pp_aux2(X,I) :- null(X). 265 | pp_aux2(X,I) :- nl, 266 | tab(I), 267 | pp_aux(X,I). 268 | 269 | 270 | 271 | 272 | 273 | /* print a string */ 274 | printstring([]). 275 | printstring([H|T]) :- put(H), printstring(T). 276 | 277 | /* print a list of strings */ 278 | printstrings([]). 279 | printstrings([H|T]) :- printstring(H),printstrings(T). 280 | 281 | makename(X,Y,N) :- name(X,X1),name(Y,Y1),append(X1,Y1,N1), 282 | name(N,N1). 283 | 284 | 285 | 286 | %? /*** collectclauses forms a list of all clauses with a given mainfunctor. 287 | %? **** The only tricky part is forming a template which will match the 288 | %? **** head of each of the clauses (this to satisfy the 'clause' predicate). 289 | %? ***/ 290 | %? 291 | %? collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), 292 | %? bagof([Func,Body], clause(Func,Body), Clauses). 293 | %? functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. 294 | %? 295 | %? /*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ 296 | %? 297 | %? makelist(0,[]). 298 | %? makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). 299 | 300 | 301 | 302 | 303 | explode(Var,X) :- var(Var),gensym(A,X). 304 | explode(Atom,L) :- atomic(Atom),name(Atom,L). 305 | explode(L,E) :- list(L), 306 | numbervars(L,1,_), 307 | explode1(L,L1), 308 | append(L1,[93],L2), 309 | E = [91|L2]. 310 | 311 | explode1([],[]). 312 | explode1([H|T],L) :- 313 | explode(H,L1), 314 | explode1(T,L2), 315 | append(L1,L2,L). 316 | 317 | /* return a pseudo random number between 1 and R */ 318 | random(R,N) :- 319 | \+R=0, % else div by 0 error 320 | ((retract(seed(X)),S=X) ; 321 | (statistics(runtime,[S,_]), 322 | integer(S),asserta(seed(S)))), 323 | N is (S mod R) +1, 324 | Newseed is (125 * S + 1) mod 4096, 325 | asserta(seed(Newseed)),!. 326 | 327 | dynamic(seed/1). 328 | seed(13). 329 | 330 | /* remove duplicate entries from a list, maintaining original order */ 331 | 332 | removedups([],[]). 333 | removedups([H|T],[H|L]) :- removetop(H,T,L1), 334 | removedups(L1,L). 335 | 336 | 337 | /* remove all top level occurences of Element from a List */ 338 | removetop(_,[],[]). 339 | removetop(E,[E|R],L) :- removetop(E,R,L). 340 | removetop(E,[H|T],[H|T1]) :- removetop(E,T,T1). 341 | 342 | /* setdif(S1,S2,S) removes all the members of S2 from S1 to yield S */ 343 | 344 | setdif([],_,[]). 345 | setdif(A,[],A). 346 | setdif(S,To_remove,Newset) :- 347 | length(S,S_length), 348 | length(To_remove,T_length), 349 | S_length > T_length, 350 | setdif1(S,To_remove,Newset). 351 | setdif(S1,S2,NewS) :- setdif2(S1,S2,NewS). 352 | 353 | setdif1(S,[],S). 354 | setdif1(L,[H|T],L2) :- removetop(H,L,L1), 355 | setdif(L1,T,L2). 356 | 357 | setdif2(S,[],S). 358 | setdif2([],_,[]). 359 | setdif2([H|T],Remove_list,L) :- 360 | member(H,Remove_list), 361 | setdif2(T,Remove_list,L). 362 | setdif2([H|T],Remove_list,[H|L]) :- 363 | setdif2(T,Remove_list,L). 364 | 365 | 366 | /* e.g. apply(append,[[1,2,3],[4,5,6],X]) will bind X to [1,2,3,4,5,6]. 367 | */ 368 | apply(Functor,Arglist) :- X =.. [Functor|Arglist],X. 369 | 370 | 371 | 372 | 373 | /******************************************************************* 374 | 375 | FORMAT 376 | Two caveats: Prolog cannot keep two files open at the same time 377 | so amformat(t,''[]. goes to the currently open stream 378 | which defaults to user at the beginning. The moral of all this is that 379 | you should close files with told. as soon as you are finished with them, 380 | and don't try to output to the user at the same time. 381 | 382 | -Brad 383 | 384 | Use: 385 | amformat(,,). 386 | is the info to be printed surrounded by single quotes. 387 | It may also contain the following escape chars: 388 | 389 | ~a Add the next value from to the output. 390 | 391 | ~l Treat the next value on the as a 392 | predicate name. List it to the output stream. 393 | 394 | ~n Newline. 395 | 396 | ~s skip white space, skips ,spaces,tabs, to 397 | next char. Use when you want to break up 398 | text in you source file. 399 | 400 | is a list containing Variables or atoms. They are treated 401 | according to the escape chars in . 402 | 403 | Example: 404 | Fun = append, 405 | amformat(foo,'list the ~a on the next line ~n ~l', 406 | [function,Fun]). 407 | would add "list the function on the next line 408 | append([],_1,_1). 409 | append([_1|_2],_3,[_1|_4]) :- append(_2,_3,_4)." 410 | to the file foo. 411 | 412 | */ 413 | 414 | /* format/2 can be used if the current stream is desired */ 415 | 416 | amformat(Weird_atom,Args) :- amformat(t,Weird_atom,Args). 417 | amformat(Stream,Atom,Args) :- format1(Stream,Atom,Args), !. 418 | 419 | format1([],[],_). 420 | format1([], Weird_big_atom, Args) :- 421 | tell(user), 422 | name(Weird_big_atom, String), 423 | formatprint(String,Args). 424 | format1(t, Weird_big_atom, Args) :- /* t is zeta syntax, and can be*/ 425 | name(Weird_big_atom, String), /* changed to any global */ 426 | formatprint(String,Args). 427 | format1(File, Weird_big_atom, Args) :- 428 | tell(File), 429 | name(Weird_big_atom,String), 430 | formatprint(String, Args). 431 | 432 | formatprint([126, 97 | Rest_of_string],Args) :- /* the case of ~a */ 433 | first_or_nil(Args,An_arg,Rest_of_args), /* a is for atom */ 434 | write(An_arg), 435 | formatprint(Rest_of_string,Rest_of_args). 436 | formatprint([126, 108 | Rest_of_string],Args) :- /* this is ~l */ 437 | first_or_nil(Args,An_arg,Rest_of_args), /* l is for listing */ 438 | listing(An_arg), 439 | formatprint(Rest_of_string,Rest_of_args). 440 | formatprint([126, 110 | Rest_of_string],Args) :- /* and ~n */ 441 | nl, /* n is for newline */ 442 | formatprint(Rest_of_string,Args). 443 | formatprint([126, 115, 31 | Rest_of_string],Args) :- /* and ~s */ 444 | remove_white_space(Rest_of_string, String), /* s is for skip cr's and */ 445 | formatprint(String,Args). /* other white space */ 446 | formatprint([126, 110 | Rest_of_string],Args) :- /* and ~n */ 447 | put(32), put(32), /* n is for newline */ 448 | formatprint(Rest_of_string,Args). 449 | formatprint([Letter | Rest_of_string],Args) :- 450 | put(Letter), 451 | formatprint(Rest_of_string,Args). 452 | formatprint([],_). 453 | 454 | /* maybe? */ 455 | 456 | prompt_and_read(Weird_atom, Args, Answer) :- 457 | format1([],Weird_atom,Args),ttyflush, 458 | myinput(Answer). 459 | 460 | 461 | 462 | remove_white_space([32 | Rest], No_white) :- 463 | remove_white_space(Rest,No_white). 464 | remove_white_space([9 | Rest], No_white) :- 465 | remove_white_space(Rest, No_white). 466 | remove_white_space(No_white, No_white). 467 | 468 | /* this does work and produces the file foo which is both human and 469 | machine readable */ 470 | 471 | test(X) :- 472 | X1 is X + 1, X2 is X + 2, X3 is X + 3, 473 | amformat([],'~a testing foo ~n bar ~s baz ~a testing ~a', [X1, X2, X3]), nl, 474 | amformat(foo,'/* foo written ~n this is formatprint */ ~l ',[formatprint]), 475 | amformat(t,'~n /* this is test */ ~n ~l ', [test]), 476 | told, 477 | amformat([],'~a testing ~a testing ~a', [X1, X2, X3]), nl, 478 | nl. 479 | 480 | 481 | /* surely I'm not the only one who needs (car ()) -> (cdr ()) -> (). */ 482 | 483 | first_or_nil([],[],[]). 484 | first_or_nil([H | T],H,T). 485 | 486 | randomelement(L,E) :- 487 | length(L,N), 488 | random(N,R), 489 | nth(L,R,E). 490 | 491 | break([H|T],Element,1,Restoflist):-Element=H,Restoflist=T,!. 492 | break([H|T],Element,Index,Restoflist):-Newindex is Index-1, 493 | Restoflist=[H|Rest], 494 | break(T,Element,Newindex,Rest). 495 | /* breaks a list into Element and the rest of the list. [H|T] is the list, 496 | Element is to be the Indexth element, and Restoflist is the list without 497 | the Indexth element. 498 | */ 499 | 500 | randombreak(List,Element,Restoflist):- 501 | length(List,Len),random(Len,An_index), 502 | break(List,Element,An_index,Restoflist),!. 503 | /* breaks List into a random Element and the Restoflist. */ 504 | 505 | remove_random(L1,L2) :- 506 | length(L1,N), 507 | random(N,R), 508 | remove_nth(L1,R,L2). 509 | remove_nth([],0,[]). 510 | remove_nth([H|T],0,T). 511 | remove_nth([H|T],N,[H|New]) :- 512 | N1 is N-1, 513 | remove_nth(T,N1,New). 514 | 515 | -------------------------------------------------------------------------------- /definitions.pl: -------------------------------------------------------------------------------- 1 | /* To make sure this list of dynamic definitions is complete: 2 | 1. Erase this list 3 | 2. Consult the buffer of definitions 4 | 3. Cut out the list of prolog's messages from the prolog windowb 5 | 4. Replace all occurrences of "[consulting procedure" with ":-dynamic" 6 | 5. Replace all occurrences of "]" with "." 7 | and presto! all your defn's are dynamic. -Todd */ 8 | 9 | :-dynamic(seed/1). 10 | :-dynamic(do_threshold/1). 11 | 12 | :- dynamic(basecase/0). 13 | :- dynamic(notmember/2). 14 | :- dynamic(myvar/1). 15 | :- dynamic(makedif/2). 16 | :- dynamic(makedif1/3). 17 | :- dynamic(anything_defn/1). 18 | :- dynamic(any_concept_defn/1). 19 | :- dynamic(atom_defn/1). 20 | :- dynamic(object_equality_defn/2). 21 | :- dynamic(normalize/2). 22 | :- dynamic(asort/2). 23 | :- dynamic(ainsert/3). 24 | :- dynamic(delete_alg/3). 25 | :- dynamic(delete_defn/3). 26 | :- dynamic(member_alg/2). 27 | :- dynamic(member_defn/2). 28 | :- dynamic(set_member_defn/2). 29 | :- dynamic(set_member_alg/2). 30 | :- dynamic(length_defn/2). 31 | :- dynamic(length_alg/2). 32 | :- dynamic(set_defn/1). 33 | :- dynamic(set_alg/1). 34 | :- dynamic(insert_defn/3). 35 | :- dynamic(insert_defn2/3). 36 | :- dynamic(set_insert_defn/3). 37 | :- dynamic(set_insert_alg/3). 38 | :- dynamic(set_delete_defn/3). 39 | :- dynamic(set_equal_defn/2). 40 | :- dynamic(set_delete_alg/3). 41 | :- dynamic(bag_defn/1). 42 | :- dynamic(bag_alg/1). 43 | :- dynamic(bag_member_defn/2). 44 | :- dynamic(bag_insert_defn/3). 45 | :- dynamic(bag_equal_defn/2). 46 | :- dynamic(bag_delete_defn/3). 47 | :- dynamic(compose_defn/2). 48 | :- dynamic(getValues/4). 49 | :- dynamic(runF1values/2). 50 | :- dynamic(getDom/2). 51 | :- dynamic(struct_defn/1). 52 | :- dynamic(coalesce_defn/2). 53 | :- dynamic(compare_dR/2). 54 | :- dynamic(compare1_dR/2). 55 | :- dynamic(itdR/4). 56 | :- dynamic(equality_defn/2). 57 | :- dynamic(first_element_defn/2). 58 | :- dynamic(last_element_defn/2). 59 | :- dynamic(rest_defn/2). 60 | :- dynamic(bag_diff_defn/3). 61 | :- dynamic(bag_intersect_defn/3). 62 | :- dynamic(bag_union_defn/3). 63 | :- dynamic(constant_pred_defn/1). 64 | :- dynamic(check_true/1). 65 | :- dynamic(check_false/1). 66 | :- dynamic(constant_h_1/1). 67 | :- dynamic(constant_h_2/1). 68 | :- dynamic(constant_true_defn/1). 69 | :- dynamic(constant_false_defn/1). 70 | :- dynamic(difference_defn/3). 71 | :- dynamic(empty_struct_defn/1). 72 | :- dynamic(nonempty_struct_defn/1). 73 | :- dynamic(intersect_defn/3). 74 | :- dynamic(list_intersect_defn/3). 75 | :- dynamic(list_diff_defn/3). 76 | :- dynamic(list_delete_defn/3). 77 | :- dynamic(list_union_defn/3). 78 | :- dynamic(list_defn/1). 79 | :- dynamic(ordered_pairs_defn/1). 80 | :- dynamic(predicate_defn/1). 81 | :- dynamic(check_range/2). 82 | :- dynamic(list_insert_defn/3). 83 | :- dynamic(set_diff_defn/3). 84 | :- dynamic(oset_diff_defn/3). 85 | :- dynamic(oset_defn/1). 86 | :- dynamic(identity_defn/2). 87 | :- dynamic(object_defn/1). 88 | :- dynamic(reverse_ord_pair_defn/2). 89 | :- dynamic(invert_an_op_defn/2). 90 | :- dynamic(set_intersect_defn/3). 91 | :- dynamic(set_union_defn/3). 92 | :- dynamic(struct_of_struct_defn/1). 93 | 94 | /* I am going to change all of these definitions into (Pure) Pure Prolog so 95 | that they will run backwards as well as forwards. This way I can easily 96 | write functions that are invertable. Motivation: generate examples, make 97 | inverses easy...If they are not (Pure) Pure enough, oh ye who come after, 98 | rewrite to your hearts content. I think that this should be made a priority 99 | for you. 100 | 101 | I will also take it upon myself to add in all concepts defs of known 102 | concepts with no def. 103 | 104 | One problem is that most of these will not work on one parameter. 105 | Some don't really run true to form backwards and forwards but they 106 | come very close. At least they don't fail but come back with 107 | something. this problem prompted me to write my general inverse 108 | function the way I did. -marcos 109 | */ 110 | 111 | /*This stuff in the parens passes the test in a very nice way! -marcos*/ 112 | basecase. 113 | 114 | notmember(a,[]). 115 | notmember(X,[]). 116 | notmember(X,L) :- myvar(X),makedif(X,L),!. 117 | notmember(X,[H|T]) :- \+ X = H, notmember(X,T). 118 | 119 | 120 | myvar(X) :- var(X). 121 | myvar(X) :- nonvar(X),X=[H|T],myvar(H),myvar(T). 122 | 123 | 124 | /* makedif(-X,+L) binds X to an atom not in L */ 125 | 126 | makedif(X,L) :- makedif1(X,L,a),!. 127 | 128 | makedif1(X,[],X). 129 | makedif1(X,[Seed|T],Seed) :- randomelement([a,b,c,d,e,f,g],C), 130 | makename(Seed,C,Newseed), 131 | makedif1(X,T,Newseed). 132 | makedif1(X,[H|T],S) :- makedif1(X,T,S). 133 | 134 | /*added -marcos*/ 135 | anything_defn(X). 136 | 137 | any_concept_defn(C) :- concept(C). 138 | atom_defn(X) :- atom(X). 139 | 140 | %struct_defn(X). 141 | %this is bogus! 142 | 143 | /*end stuff!*/ 144 | 145 | /*This is a text predicate that can does not need to run forwards 146 | and/or backwards but I have modified it so that it may, even with 147 | the cuts in it. -marcos 148 | */ 149 | object_equality_defn(X,Y) :- 150 | normalize(X,X1), 151 | normalize(Y,Y1),!, 152 | X1=Y1. 153 | 154 | normalize(X,P):- var(X), X = P. 155 | normalize([],[]). 156 | normalize(A,A) :- atomic(A). 157 | normalize(X,[H1|T1]) :- 158 | asort(X,[H|T]),!, 159 | normalize(H,H1),!,normalize(T,T1). 160 | 161 | asort([],[]). 162 | asort([H|T],S) :- 163 | asort(T,S1), 164 | ainsert(H,S1,S). 165 | ainsert(A,[],[A]). 166 | ainsert(A,[H|T],[A,H|T]) :- A @< H. 167 | ainsert(A,[H|T],[H|R]) :- ainsert(A,T,R). 168 | 169 | 170 | /*end stuff2!*/ 171 | 172 | /*This next group runs backwards, forwards and sideways*/ 173 | 174 | delete_alg(A,B,C):-delete_defn(A,B,C). 175 | 176 | delete_defn(A,[A|B],B). 177 | delete_defn(A,[B|C],[B|C1]):-delete_defn(A,C,C1). 178 | 179 | /*end stuff2*/ 180 | 181 | /*now this next set will work and return [] as part of the set*/ 182 | 183 | member_alg(S,E):-member_defn(S,E). 184 | 185 | member_defn([],[]). 186 | member_defn(X,[X|T]). 187 | member_defn(X,[_|T]):-member_defn(X,T). 188 | 189 | /* not sure about this next one yet*/ 190 | 191 | set_member_defn([H|_],Element) :- basecase, 192 | set_equal_defn(Element,H). 193 | set_member_defn([_|T],Element) :- set_member_defn(T,Element). 194 | 195 | 196 | set_member_alg([H|_],Element) :- basecase, 197 | set_equal_defn(Element,H). 198 | set_member_alg([_|T],Element) :- set_member_alg(T,Element). 199 | 200 | /*length works backwards and forwards*/ 201 | 202 | length_defn([],[]) :- basecase. 203 | length_defn([_|R],[_|L]) :- length_defn(R,L). 204 | 205 | length_alg(X,Y) :- length_defn(X,Y). 206 | 207 | 208 | set_defn([]):-basecase. 209 | set_defn([H|T]):- notmember(H,T), set_defn(T). 210 | /*note ^^^ notmember(H,T) will instantiate H so that it is not a member of T*/ 211 | 212 | 213 | set_alg(X) :- set_defn(X). 214 | 215 | /*added not quite running backwards yet so I'll just call 216 | delete to get the proper inversion. Stupid but it'll work! 217 | This works with backwards and forwards and only with one 218 | input param! -marcos*/ 219 | 220 | insert_defn(A,B,C):-var(B),!,delete_defn(A,C,B). 221 | insert_defn(A,B,C):-var(A),var(C),!,randomelement([a,b,c,d,e,f,g,C],A), 222 | insert_defn(A,B,C). 223 | insert_defn(A,B,C):- normalize(B,B1),normalize(C,C1), 224 | insert_defn2(A,B1,C1). 225 | insert_defn2(X,[],[X]). 226 | insert_defn2(X,[],[]). 227 | insert_defn2(X,[A|B],[A|C]):-insert_defn2(X,B,C). 228 | insert_defn2(X,[A|B],[X|C]). 229 | 230 | 231 | /* set_insert works both ways, almost*/ 232 | 233 | 234 | set_insert_defn(I,Set,Set) :- member_defn(I,Set). 235 | set_insert_defn(I,Set,[I|Set]). 236 | 237 | set_insert_alg(I,Set,Set) :- member_alg(I,Set). 238 | set_insert_alg(I,Set,[I|Set]). 239 | 240 | /*set delete does not work! Set_equal checks to see if the items are 241 | in a set, strange. What if they are atoms? Is set delete only supposed 242 | to work on deleting sets? Under that assumption it works both ways*/ 243 | 244 | set_delete_defn(_,[],[]) :- basecase. 245 | set_delete_defn(I,[H|T],T) :- 246 | % not(equality_defn(I,[])), 247 | equality_defn(I,H). 248 | set_delete_defn(I,[H|T],[H|T1]) :- 249 | set_delete_defn(I,T,T1). 250 | 251 | set_equal_defn(A,B) :- set_defn(A),set_defn(B), 252 | object_equality_defn(A,B). 253 | 254 | set_delete_alg(I,With,Without) :- 255 | set_delete_defn(I,With,Without). 256 | 257 | bag_defn([]) :- basecase. 258 | bag_defn([H|T]):- bag_defn(T). 259 | 260 | bag_alg(X) :- bag_defn(X). 261 | 262 | bag_member_defn([],[]) :- basecase. 263 | bag_member_defn([H|_],Element) :- 264 | bag_equal_defn(Element,H). 265 | bag_member_defn([_|T],Element) :- bag_member_defn(T,Element). 266 | 267 | bag_insert_defn(Object,Bag,[Object|Bag]). 268 | 269 | bag_equal_defn(A,B) :- bag_defn(A),bag_defn(B),object_equality_defn(A,B). 270 | 271 | 272 | bag_delete_defn(_,[],[]) :- basecase. 273 | bag_delete_defn(I,[H|T],T) :- object_equality_defn(I,H). 274 | bag_delete_defn(I,[H|T],[H|T1]) :- 275 | bag_delete_defn(I,T,T1). 276 | 277 | % Needs to be written (but not by me!) 278 | % Remember this is a defn or an alg -marcos 279 | %from here on out new defn's -marcos 280 | compose_defn(FunList,FG):- 281 | get(FG,[defn,name],P), 282 | getarity(P,N), 283 | getValues(FunList,F,[],ReturnValue), 284 | append(ReturnValue,X,ArgList), 285 | Foo =.. [F|ArgList], 286 | Foo1 =.. [P|ArgList],!, 287 | Foo,Foo1. 288 | 289 | getValues([F|[]],F,P,P). 290 | getValues([Fun|FunList],F,[P|List],ReturnValue):- 291 | get(Fun,[defn,name],F1), 292 | get(Fun,[dom_range],Examples), 293 | runF1values(Examples,Dom), 294 | append(List,Dom,List2), 295 | getValues(FunList,[P,List2],ReturnValue). 296 | 297 | runF1values([],_):-!,fail. 298 | runF1values([E1|Rest],Dom):- 299 | getDom(E1,Dom). 300 | runF1values([E1|Rest],Dom):- 301 | runF1values(Rest,Dom). 302 | 303 | getDom([],_):-fail,!. 304 | getDom([Dom|[]],Dom):-!. 305 | getDom([_|Rest],Dom):- 306 | getDom(Rest,Dom). 307 | 308 | struct_defn(X):- 309 | bag_defn(X). 310 | 311 | coalesce_defn(F,G):- 312 | get(F,[dom_range],FDOMRANG), 313 | get(G,[dom_range],GDOMRANG), 314 | compare_dR(FDOMRANG,GDOMRANG). 315 | 316 | compare_dR([],_). 317 | %I don't know if the next clause is right but here goes: 318 | compare_dR([FDR1|FDOMRANG],GDOMRANG):- 319 | equality_defn(GDOMRANG,[]),!, 320 | fail. 321 | 322 | compare_dR([FDR1|FDOMRANG],GDOMRANG):- 323 | compare1_dR(FDR1,GDOMRANG), 324 | compare_dR(FDOMRANG,GDOMRANG). 325 | compare1_dR(FDR1,[]). 326 | compare1_dR(FDR1,[GDR1|GDOMRANG]):- 327 | length(FDR1,N), 328 | N1 is N - 1, 329 | length(GDR1,N1), 330 | itdR(FDR1,GDR1,N1,0). 331 | 332 | compare1_dR(FDR1,[GDR1|GDOMRANG]):- 333 | compare1_dR(FDR1,GDOMRANG). 334 | %this function must be fixed to reflect that two arguments of F must 335 | %be the same. 336 | itdR([A|[]],[A|[]],N,N). 337 | itdR([A|Rest],[A|Rest2],N,N2):- 338 | N3 is N2 + 1, 339 | itdR(Rest,Rest2,N,N3). 340 | itdR([_|Rest],Rest2,N,N2):- 341 | N3 is N2 + 1, 342 | itdR(Rest,Rest2,N,N3). 343 | 344 | %trying to keep stuff out of the heads 345 | equality_defn(Z,X):- 346 | object_equality_defn(Z,X). 347 | equality_defn(Z,Z):- not(object_defn(Z)). 348 | %I am worried that what is needed isn't equal but the various subtypes 349 | %or equality like object_equality, list_equality, bag_equality,etc. 350 | %Lenat seems t be using this sort of equal in his algorithm's but 351 | %I am not sure. He never says. I am assuming that '=' is lisp equal 352 | %the same as the above definition. -marcos 353 | /* There is another version after this comment, pick your poison... 354 | not(X):- X, !, fail. 355 | not(X). 356 | 357 | first_element_defn(A,X):- 358 | reverse(A,Aii), 359 | member_defn(Z,Aii), 360 | delete_defn(Z,A,A2), 361 | empty_struct_defn(A2), 362 | equality_defn(Z,X). 363 | first_element_defn(A,X):- 364 | reverse(A,Aii), 365 | member_defn(Z,Aii), 366 | delete_defn(Z,A,A2), 367 | first_element_defn(A2,X). 368 | 369 | last_element_defn(A,X):- 370 | member_defn(Z,A), 371 | delete_defn(Z,A,A2), 372 | empty_struct_defn(A2), 373 | equality_defn(Z,X). 374 | last_element_defn(A,X):- 375 | member_defn(Z,A), 376 | delete_defn(Z,A,A2), 377 | last_element_defn(A2,X). 378 | 379 | */ 380 | 381 | first_element_defn(A,X):- 382 | last_element_defn(A,Z), 383 | delete_defn(Z,A,A2), 384 | empty_structure_defn(A2), 385 | equality_defn(Z,X). 386 | first_element_defn(A,X):- 387 | last_element_defn(A,Z), 388 | delete_defn(Z,A,A2), 389 | first_element_defn(A2,X). 390 | 391 | last_element_defn(A,X):- 392 | first_element_defn(A,Z), 393 | delete_defn(Z,A,A2), 394 | empty_structure_defn(A2), 395 | equality_defn(Z,X). 396 | last_element_defn(A,X):- 397 | first_element_defn(A,Z), 398 | delete_defn(Z,A,A2), 399 | last_element_defn(A2,X). 400 | 401 | rest_defn([_|B],B). 402 | 403 | 404 | bag_diff_defn(X,Y,Z):- equality_defn(X,[]),equality_defn(Z,[]). 405 | bag_diff_defn(X,Y,Z):- 406 | first_element_defn(X,A), 407 | member_defn(A,Y), 408 | rest_defn(X,RX), 409 | bag_delete(A,Y,Y2), 410 | bag_diff_defn(RX,Y2,Z). 411 | bag_diff_defn(X,Y,Z):- 412 | first_element_defn(X,A), 413 | first_element_defn(Z,A), 414 | rest_defn(X,XB), 415 | rest_defn(Z,ZB), 416 | bag_diff_defn(XB,Y,ZB). 417 | 418 | bag_intersect_defn([],_,[]). 419 | bag_intersect_defn([A|AR],B,C):- 420 | member_defn(A,B), 421 | member_defn(A,C), 422 | bag_delete_defn(A,B,B2), 423 | bag_delete_defn(A,C,C2), 424 | bag_intersect_defn(AR,B2,C2). 425 | bag_intersect_defn([_|AR],B,C):- 426 | bag_intersect_defn(AR,B,C). 427 | 428 | bag_union_defn(A,B,C):- 429 | equality_defn(A,[]),!, 430 | bag_equal_defn(B,C). 431 | bag_union_defn(A,B,C):- 432 | first_element_defn(A,A1), 433 | bag_delete_defn(A1,A,A2), 434 | bag_delete_defn(A1,B,B2), 435 | bag_delete_defn(A1,C,C2), 436 | bag_union_defn(A2,B2,C2). 437 | 438 | %I'm stuck on the isa predicate part right now! 439 | %canonize_defn(P1,P2,F):- 440 | 441 | %not sure about what the defn of conjecture is 442 | %conjecture_defn(X):- 443 | 444 | constant_pred_defn(X):- 445 | X,!, 446 | check_true(X). 447 | constant_pred_defn(X):- 448 | !, 449 | check_false(X). 450 | check_true(X):- 451 | !, 452 | X. 453 | check_false(X):- 454 | !, 455 | not(X). 456 | 457 | constant_h_1(X):- 458 | not(X),!, 459 | not(X). 460 | constant_h_1(X):-!,fail. 461 | 462 | constant_h_2(X):- 463 | X,!, 464 | X. 465 | constant_h_2(X):- 466 | !,fail. 467 | 468 | constant_true_defn(X):-!. 469 | constant_false_defn(X):-!,fail. 470 | 471 | 472 | difference_defn(A,B,C):- 473 | first_element_defn(A,X),!, 474 | not(member_defn(X,B)), 475 | member_defn(X,C). 476 | 477 | empty_struct_defn(X):- 478 | struct_defn(X),!, 479 | equality_defn(X,[]). 480 | 481 | nonempty_struct_defn(X):- 482 | struct_defn(X), 483 | equality_defn(X,[]),!,fail. 484 | nonempty_struct_defn(X):-basecase. 485 | 486 | intersect_defn(A,B,C):- 487 | list_intersect_defn(A,B,C); 488 | bag_intersect_defn(A,B,C). 489 | 490 | /*a main problem i have with Lenat's algorithms in his thesis is that 491 | he has lots of trouble distinguishing from defn's that are predicates 492 | and defn's that are constructive. IN prolog the distinction is moot. 493 | I think that something should be done with that. -marcos 494 | */ 495 | 496 | list_intersect_defn(A,B,C):- 497 | equality_defn(A,[]), 498 | equality_defn(C,[]). 499 | list_intersect_defn(A,B,C):- 500 | first_element_defn(A,A1), 501 | member_defn(A1,B), 502 | first_element_defn(C,C1), 503 | equality_defn(A1,C1), 504 | list_delete_defn(A1,B,B2), 505 | rest_defn(C,C2), 506 | list_intersect_defn(A1,B2,C2). 507 | list_intersect_defn(A,B,C):- 508 | rest_defn(A,A2), 509 | list_intersect_defn(A2,B,C). 510 | 511 | 512 | list_diff_defn(A,B,C):- 513 | equality_defn(A,[]), 514 | equality_defn(C,[]). 515 | 516 | list_diff_defn(A,B,C):- 517 | first_element_defn(A,A1), 518 | equality_defn(A1,B), 519 | rest_defn(A,A2), 520 | list_delete_defn(A1,B,B2), 521 | list_diff_defn(A2,B2,C). 522 | 523 | list_diff_defn(A,B,C):- 524 | first_element_defn(A,A1), 525 | first_element_defn(C,C1), 526 | equality_defn(A1,C1), 527 | /* I have left out the obvious optimization: first_element_defn(C,A1), 528 | so that the code with be apparent to AM. -marcos 529 | */ 530 | rest_defn(A,A2), 531 | rest_defn(C,C2), 532 | list_diff_defn(A2,B,C2). 533 | 534 | 535 | list_delete_defn(X,A,B):- 536 | equality_defn(A,[]), 537 | equality_defn(B,[]). 538 | list_delete_defn(X,A,B):- 539 | first_element_defn(A,A1), 540 | equality_defn(A1,X), 541 | rest_defn(A,A2), 542 | equality_defn(A2,B). 543 | list_delete_defn(X,A,B):- 544 | rest_defn(A,A2), 545 | rest_defn(B,B2), 546 | list_delete_defn(X,A2,B2). 547 | 548 | list_union_defn(A,B,C):- 549 | equality_defn(A,[]), 550 | equality_defn(B,C). 551 | list_union_defn(A,B,C):- 552 | first_element_defn(A,A1), 553 | first_element_defn(C,C1), 554 | equality_defn(A1,C1), 555 | rest_defn(A,A2), 556 | rest_defn(C,C2), 557 | list_union_defn(A2,B,C2). 558 | 559 | list_defn(X):- 560 | equality_defn(X,[]). 561 | list_defn(X):- 562 | rest_defn(X,X2), 563 | list_defn(X2). 564 | 565 | %quick def, -marcos 566 | ordered_pairs_defn(X):- 567 | equality_defn(X,[A,B]). 568 | %slow def, but maybe better for AM-marcos 569 | ordered_pairs_defn(X):- 570 | list_defun(X), 571 | not(equality_defn(X,[])), 572 | member(Z,X), 573 | list_delete_defn(Z,X,S1), 574 | not(equality_defn(S1,[])), 575 | member(Y,S1), 576 | list_delete_defn(Y,S1,[]). 577 | 578 | 579 | predicate_defn(X):- 580 | equality_defn(X,[]),!, 581 | fail. 582 | 583 | predicate_defn(X):- 584 | get(X,[dom_range],DR), 585 | check_range(DR,[true_false]). 586 | 587 | check_range(DR,X):- 588 | first_element_defn(DR,DR1), 589 | split_last(DR1,X). 590 | check_range(DR,X):- 591 | rest_defn(DR,DR2), 592 | check_range(DR2,X). 593 | 594 | list_insert_defn(X,A,B):- 595 | first_element_defn(B,B1), 596 | rest_defn(B,B2), 597 | equality_defn(B1,X), 598 | equality_defn(B2,A). 599 | 600 | set_diff_defn(A,B,C):- 601 | equality_defn(A,[]), 602 | equality_defn(C,[]). 603 | set_diff_defn(A,B,C):- 604 | first_element_defn(A,A1), 605 | member_defn(A1,B), 606 | set_delete_alg(A1,B,B2), 607 | set_diff_defn(A1,B2,C). 608 | set_diff_defn(A,B,C):- 609 | first_element_defn(A,A1), 610 | first_element_defn(C,C1), 611 | equality_defn(A1,C1), 612 | rest_defn(A,A2), 613 | rest_defn(C,C2), 614 | set_diff_defn(A2,B,C2). 615 | 616 | 617 | 618 | oset_diff_defn(A,B,C):- 619 | equality_defn(A,[]), 620 | equality_defn(C,[]). 621 | oset_diff_defn(A,B,C):- 622 | first_element_defn(A,A1), 623 | member_defn(A1,B), 624 | oset_delete_alg(A1,B,B2), 625 | oset_diff_defn(A1,B2,C). 626 | oset_diff_defn(A,B,C):- 627 | first_element_defn(A,A1), 628 | first_element_defn(C,C1), 629 | equality_defn(A1,C1), 630 | rest_defn(A,A2), 631 | rest_defn(C,C2), 632 | oset_diff_defn(A2,B,C2). 633 | 634 | 635 | 636 | oset_defn(A):- 637 | equality_defn(A,[]). 638 | oset_defn(A):- 639 | rest_defn(A,A2), 640 | oset_defn(A2). 641 | 642 | identity_defn(A,B):- 643 | equality_defn(A,B). 644 | 645 | object_defn(X):- 646 | exs(object,Y),!, 647 | member(X,Y). 648 | 649 | reverse_ord_pair_defn(P,Q):- 650 | first_element_defn(P,P1), 651 | last_element_defn(Q,Q2), 652 | equality_defn(P1,Q2), 653 | last_element_defn(P,P2), 654 | first_element_defn(Q,Q1), 655 | equality_defn(P2,Q1). 656 | 657 | 658 | /* I don't get these. -marcos 659 | */ 660 | %projection1_defn(A) 661 | %projection2_defn(A) 662 | 663 | /* 664 | invert_op_defn(F,G):- 665 | getarity(G,N), 666 | getarity(F,N2), 667 | get(dom_range,F,FDR), 668 | get(dom_range,G,GDR), 669 | */ 670 | %for the above I will simply use the heuristic I wrote to do this. 671 | %However, please not that there is a big difference between this 672 | %defn, which produces a product, and the inverted_op defn which 673 | %is a predicate. Is this right? I think that the next defn must be 674 | %redone and alot of evaluation must in injected into it. -marcos 675 | 676 | invert_an_op_defn(F,G):- mh9(F), makename('inverse_of_',F,G). 677 | 678 | %inverted_op(F):- 679 | /* 680 | parallel_join_defn(S1,F,G):- 681 | get(G,[dom_rang],DomRange), 682 | splitlast(DomRange,Range), 683 | delete 684 | 685 | parallel_join2_defn(S1,S2,F,G):- 686 | 687 | parallel_replace_defn(S1,F,G):- 688 | 689 | parallel_replace2_defn(S1,S2,F,G):- 690 | 691 | 692 | repeat_defn(S1,F1,G1):- 693 | first_element_defn( 694 | */ 695 | /* 696 | restrict_defn(F,G):- 697 | not(var(G)), 698 | get(F,[dom_range],DRF), 699 | get(G,[dom_range],DRG), 700 | compare_for_restrict(DRF,DRG), 701 | compare_defns(F,G). 702 | 703 | restrict_defn(F,G):- 704 | var(G), 705 | get(F,[dom_range],DRF), 706 | subvarsforDR(DRF,DRG), 707 | G1 = frame(G,[dom_range],DRG). 708 | assert(G1), 709 | compare_for_restrict(DRF,DRG), 710 | compare_defns(F,G). 711 | 712 | subvarsforDR([],[]). 713 | subvarsforDR([X|RestDRF],[_|RestDRG]):- 714 | subvarsforDR(RestDRF,RestDRG). 715 | */ 716 | 717 | set_intersect_defn(A,B,C):- 718 | equality_defn(A,[]), 719 | equality_defn(C,[]). 720 | set_intersect_defn(A,B,C):- 721 | member_defn(Z,A), 722 | not(equality_defn(Z,[])), 723 | member_defn(Z,B), 724 | member_defn(Z,C), 725 | set_delete_defn(Z,A,A1), 726 | set_delete_defn(Z,B,B1), 727 | set_delete_defn(Z,C,C1), 728 | set_intersect_defn(A1,B1,C1). 729 | 730 | set_intersect_defn(A,B,C):- 731 | member_defn(Z,A), 732 | set_delete_defn(Z,A,A1), 733 | set_intersect_defn(A1,B,C). 734 | 735 | set_union_defn(A,B,C):- 736 | equality_defn(A,[]), 737 | equality_defn(B,C). 738 | 739 | set_union_defn(A,B,C):- 740 | first_element(A,A1), 741 | member_defn(A1,C), 742 | rest_defn(A,A2), 743 | set_delete_defn(A1,B,B2), 744 | set_delete_defn(A1,C,C2), 745 | set_union_defn(A2,B2,C2). 746 | 747 | struct_of_struct_defn(S):- 748 | empty_struct_defn(S). 749 | struct_of_struct_defn(S):- 750 | struct_defn(S), 751 | member(Z,S), 752 | struct_defn(Z), 753 | delete_defn(Z,S,S2), 754 | struct_of_struct(S2). 755 | 756 | 757 | -------------------------------------------------------------------------------- /concepts.pl: -------------------------------------------------------------------------------- 1 | %break% con.pl 526016830 409 20 100644 7918 ` 2 | /* This is the concept definitions file. There are many changes and 3 | comments through out this file. I have added many concepts that 4 | were not here before and have done my best at adding their defn's. 5 | 6 | -mv LaPolla (marcos) 7 | */ 8 | 9 | :- dynamic(frame/3). 10 | 11 | frame(anything,[name],[anything]). 12 | frame(anything,[spec],[any_concept,non_concept]). 13 | frame(anything,[examples,typ],[anything,any_concept]). 14 | frame(anything,[isas],[any_concept]). 15 | frame(anything,[worth],[100]). 16 | frame(anything,[suggest],[h1,h12]). 17 | 18 | frame(any_concept,[name],['any concept']). 19 | frame(any_concept,[defn,name],[any_concept_defn]). 20 | frame(any_concept,[defn,arity],[1]). 21 | frame(any_concept,[genl],[anything]). 22 | frame(any_concept,[spec],[active,object]). 23 | frame(any_concept,[examples,typ],[anything,any_concept,object,active]). 24 | frame(any_concept,[isas],[anything,any_concept]). 25 | frame(any_concept,[worth],[100]). 26 | frame(any_concept,[suggest],[h14]). 27 | frame(any_concept,[int],[h6,h17,h20,h23]). 28 | frame(any_concept,[examples,fillin],[h29,h31,h34a,h34b,h40,h174]). 29 | frame(any_concept,[examples,suggest],[h44,h45,h46,h50]). 30 | frame(any_concept,[examples,check],[h56,h59a,h59c,h57,h61a,h61b]). 31 | frame(any_concept,[genl,fillin],[h300,h89]). 32 | frame(any_concept,[spec,fillin],[h301,h92]). 33 | frame(any_concept,[genl,check],[h111,h110]). 34 | frame(any_concept,[spec,check],[h110,h111]). 35 | frame(any_concept,[conjecs,fillin],[183]). 36 | 37 | frame(object,[name],[object]). 38 | frame(object,[spec],[atom,struct,conjecs]). 39 | frame(object,[genl],[any_concept]). 40 | frame(object,[in_dom_of],[object_equality,set_insert,bag_insert,set_delete,bag_delete]). 41 | frame(object,[examples,fillin],[h31]). 42 | frame(object,[worth],[100]). 43 | 44 | frame(active,[name],[active]). 45 | frame(active,[genl],[any_concept]). 46 | frame(active,[spec],[operation,predicate]). 47 | frame(active,[isas],[any_concept]). 48 | frame(active,[in_dom_of],[coalesce,compose]). 49 | frame(active,[in_ran_of],[coalesce,compose]). 50 | frame(active,[worth],[100]). 51 | frame(active,[in_dom_of,fillin],[h116]). 52 | frame(active,[in_ran_of,fillin],[h117]). 53 | frame(active,[dom_range,fillin],[h124]). 54 | 55 | 56 | frame(operation,[name],[operation]). 57 | frame(operation,[examples,typ],[compose,insert,member,delete,coalesce,length]). 58 | frame(operation,[spec],[compose,insert,member,delete,coalesce,length]). 59 | frame(operation,[genl],[active]). 60 | frame(operation,[examples,fillin],[h123]). 61 | frame(operation,[worth],[100]). 62 | 63 | frame(predicate,[name],[predicate]). 64 | frame(predicate,[genl],[active]). 65 | frame(predicate,[examples,typ],[object_equality]). 66 | frame(predicate,[worth],[100]). 67 | frame(predicate,[defn,name],[predicate_defn]). 68 | 69 | frame(coalesce,[name],[coalesce]). 70 | frame(coalesce,[genl],[operation]). 71 | frame(coalesce,[isas],[operation]). 72 | frame(coalesce,[dom_range],[[active,active],[operation,operation], 73 | [predicate,predicate]]). 74 | frame(coalesce,[worth],[300]). 75 | 76 | frame(insert,[name],[insert]). 77 | frame(insert,[isas],[operation]). 78 | frame(insert,[spec],[set_insert,bag_insert]). 79 | frame(insert,[genl],[operation]). 80 | frame(insert,[dom_range],[[object,struct,struct]]). 81 | frame(insert,[worth],[100]). 82 | frame(insert,[defn,name],[insert_defn]). 83 | 84 | frame(delete,[name],[delete]). 85 | frame(delete,[defn,name],[delete_defn]). 86 | frame(delete,[isas],[operation]). 87 | frame(delete,[spec],[set_delete,bag_delete]). 88 | frame(delete,[genl],[operation]). 89 | frame(delete,[dom_range],[[object,struct,struct]]). 90 | frame(delete,[worth],[100]). 91 | 92 | 93 | frame(member,[name],[member]). 94 | frame(member,[defn,name],[member_defn]). 95 | frame(member,[isas],[operation]). 96 | frame(member,[spec],[set_member,bag_member]). 97 | frame(member,[genl],[operation]). 98 | frame(member,[dom_range],[[struct,object]]). 99 | frame(member,[worth],[100]). 100 | 101 | 102 | frame(atom,[name],[atom]). 103 | frame(atom,[genl],[object]). 104 | frame(atom,[examples,typ],[a,b,c,d,e,f,g]). 105 | frame(atom,[defn,name],[atom_defn]). 106 | frame(atom,[defn,arity],[1]). 107 | 108 | frame(struct,[name],[struct]). 109 | frame(struct,[spec],[bag,set]). 110 | frame(struct,[genl],[object]). 111 | frame(struct,[in_dom_of],[insert,delete,member]). 112 | frame(struct,[in_ran_of],[insert,delete]). 113 | frame(struct,[defn,name],[struct_defn]). 114 | %the above get 10 lenats worth 115 | frame(struct,[defn,arity],[1]). 116 | frame(struct,[worth],[200]). 117 | 118 | frame(conjecs,[name],[conjecs]). 119 | frame(conjecs,[genl],[object]). 120 | frame(conjecs,[worth],[300]). 121 | 122 | 123 | frame(set,[name],[set]). 124 | /* NB: a set is NOT a spec of bag frame(set,[genl],[bag]). */ 125 | frame(set,[genl],[struct]). 126 | frame(set,[examples,typ],[[a],[a,b],[a,b,[b,a]],[[[c]]]]). 127 | frame(set,[examples,bnd],[[]]). 128 | frame(set,[in_dom_of], 129 | [set_insert,set_delete]). 130 | frame(set,[in_ran_of], 131 | [set_insert,set_delete]). 132 | frame(set,[worth],[400]). 133 | frame(set,[defn,name],[set_defn]). 134 | frame(set,[defn,arity],[1]). 135 | 136 | frame(bag,[name],[bag]). 137 | frame(bag,[genl],[struct]). 138 | frame(bag,[defn,name],[bag_defn]). 139 | frame(bag,[defn,arity],[1]). 140 | frame(bag,[in_dom_of],[bag_equal,bag_insert,bag_delete,bag_member]). 141 | frame(bag,[in_ran_of],[bag_insert,bag_delete,bag_equal]). 142 | frame(bag,[worth],[400]). 143 | 144 | frame(bag_equal,[name],[bag_equality]). 145 | frame(bag_equal,[genl],[object_equality]). 146 | frame(bag_equal,[defn,name],[bag_equal_defn]). 147 | frame(bag_equal,[defn,arity],[2]). 148 | frame(bag_equal,[dom_range],[[bag,bag]]). 149 | frame(bag_equal,[alg],[bag_equal_defn]). 150 | frame(bag_equal,[worth],[100]). 151 | 152 | 153 | frame(bag_member,[name],[bag_memberity]). 154 | frame(bag_member,[genl],[member]). 155 | frame(bag_member,[defn,name],[bag_member_defn]). 156 | frame(bag_member,[defn,arity],[2]). 157 | frame(bag_member,[dom_range],[[bag,object]]). 158 | frame(bag_member,[alg],[bag_member_defn]). 159 | frame(bag_member,[worth],[100]). 160 | 161 | 162 | frame(bag_insert,[name],[bag_insert]). 163 | frame(bag_insert,[genl],[insert]). 164 | frame(bag_insert,[defn,name],[bag_insert_defn]). 165 | frame(bag_insert,[defn,arity],[3]). 166 | frame(bag_insert,[dom_range],[[object,bag,bag]]). 167 | frame(bag_insert,[alg],[bag_insert_defn]). 168 | frame(bag_insert,[worth],[100]). 169 | 170 | 171 | frame(bag_delete,[name],[bag_delete]). 172 | frame(bag_delete,[genl],[delete]). 173 | frame(bag_delete,[defn,name],[bag_delete_defn]). 174 | frame(bag_delete,[defn,arity],[3]). 175 | frame(bag_delete,[dom_range],[[object,bag,bag]]). 176 | frame(bag_delete,[alg],[bag_delete_defn]). 177 | frame(bag_delete,[worth],[100]). 178 | 179 | 180 | 181 | frame(object_equality,[name],[object_equality]). 182 | frame(object_equality,[genl],[predicate]). 183 | frame(object_equality,[isas],[predicate]). 184 | frame(object_equality,[defn,name],[object_equality_defn]). 185 | frame(object_equality,[dom_range],[[object,object,true_false], 186 | [strut,struct,true_false]]). 187 | frame(object_equality,[algorithms],[object_equality_alg]). 188 | frame(object_equality,[conjecs],[[object_equality_code,X,X], 189 | [structs_not_in,dom_range], 190 | [same_as,object_equality, 191 | object_equality,true]]). 192 | 193 | frame(object_equality,[worth],[200]). 194 | 195 | frame(set_insert,[name],[set_insert]). 196 | frame(set_insert,[defn,name],[set_insert_defn]). 197 | frame(set_insert,[dom_range],[[object,set,set]]). 198 | frame(set_insert,[alg],[set_insert_alg]). 199 | frame(set_insert,[genl],[insert]). 200 | frame(set_insert,[worth],[100]). 201 | 202 | frame(set_delete,[name],[set_delete]). 203 | frame(set_delete,[defn,name],[set_delete_defn]). 204 | frame(set_delete,[dom_range],[[object,set,set]]). 205 | frame(set_delete,[alg],[set_delete_alg]). 206 | frame(set_delete,[genl],[delete]). 207 | frame(set_delete,[worth],[100]). 208 | 209 | frame(set_member,[name],[set_member]). 210 | frame(set_member,[defn,name],[set_member_defn]). 211 | frame(set_member,[dom_range],[[struct,object]]). 212 | frame(set_member,[alg],[set_member_alg]). 213 | frame(set_member,[isas],[operation]). 214 | frame(set_member,[genl],[member]). 215 | frame(set_member,[worth],[100]). 216 | 217 | frame(compose,[name],[compose]). 218 | %frame(compose,[defn,name],[compose_defn]). 219 | %frame(compose,[alg],[compose_alg]). 220 | frame(compose,[genl],[operation]). 221 | frame(compose,[examples,fillin],[h174]). 222 | frame(compose,[examples,check],[h183]). 223 | frame(compose,[dom_range],[[active,active,active], 224 | [operation,active,operation], 225 | [predicate,active,predicate], 226 | [relation,relation,relation]]). 227 | frame(compose,[genl],[operation]). 228 | frame(compose,[isas],[operation]). 229 | frame(compose,[worth],[300]). 230 | 231 | frame(length,[name],[length]). 232 | frame(length,[defn,name],[length_defn]). 233 | frame(length,[alg],[length_defn]). 234 | frame(length,[dom_range],[[struct,struct],[set,struct]]). 235 | frame(length,[genl],[operation]). 236 | frame(length,[isas],[operation]). 237 | frame(length,[worth],[300]). 238 | 239 | %from here on out these are new concepts -marcos 240 | 241 | frame(bag_diff,[name],[bag_diff]). 242 | frame(bag_diff,[defn,name],[bag_diff_defn]). 243 | frame(bag_diff,[dom_range],[[bag,bag, bag]]). 244 | frame(bag_diff,[worth],[100]). 245 | frame(bag_diff,[genl],[difference]). 246 | frame(bag_diff,[defn,arity],[3]). 247 | 248 | frame(difference,[name],[difference]). 249 | frame(difference,[isas],[operation]). 250 | frame(difference,[dom_range],[[struct,struct,struct]]). 251 | frame(difference,[spec],[set_diff,bag_diff,list_diff,oset_diff]). 252 | frame(difference,[worth],[100]). 253 | frame(difference,[defn,name],[difference_defn]). 254 | 255 | frame(set_diff,[name],[set_diff]). 256 | frame(set_diff,[genl],[difference]). 257 | frame(set_diff,[worth],[100]). 258 | frame(set_diff,[dom_range],[[set,set,set]]). 259 | frame(set_diff,[defn,name],[set_diff_defn]). 260 | 261 | frame(list_diff,[name],[list_diff]). 262 | frame(list_diff,[dom_range],[[list,list,list]]). 263 | frame(list_diff,[worth],[100]). 264 | frame(list_diff,[genl],[difference]). 265 | frame(list_diff,[defn,name],[list_diff_defn]). 266 | 267 | frame(oset_diff,[name],[oset_diff]). 268 | frame(oset_diff,[name],[oset_difference]). 269 | frame(oset_diff,[worth],[100]). 270 | frame(oset_diff,[genl],[difference]). 271 | frame(oset_diff,[dom_range],[[oset,oset,oset]]). 272 | frame(oset_diff,[defn,name],[oset_diff_defn]). 273 | 274 | frame(oset,[name],[oset]). 275 | frame(oset,[worth],[400]). 276 | frame(oset,[genl],[ordered_struct,no_mult_elements_struct]). 277 | frame(oset,[in_dom_of],[oset_union,oset_intersect,oset_diff, 278 | oset_insert,oset_delete]). 279 | frame(oset,[in_ran_of],[oset_union,oset_intersect,oset_diff, 280 | oset_insert,oset_delete]). 281 | frame(oset,[defn,name],[oset_defn]). 282 | 283 | frame(bag_intersect,[name],[bag_intersect]). 284 | frame(bag_intersect,[genl],[intersect]). 285 | frame(bag_intersect,[worth],[100]). 286 | frame(bag_intersect,[dom_range],[[bag,bag,bag]]). 287 | frame(bag_intersect,[defn,name],[bag_intersect_defn]). 288 | 289 | frame(bag_union,[name],[bag_union]). 290 | frame(bag_union,[genl],[union]). 291 | frame(bag_union,[dom_range],[[bag,bag,bag]]). 292 | frame(bag_union,[worth],[100]). 293 | frame(bag_union,[defn,name],[bag_union_defn]). 294 | 295 | frame(union,[name],[union]). 296 | frame(union,[isas],[operation]). 297 | frame(union,[spec],[set_union,bag_union,list_union,oset_union]). 298 | frame(union,[worth],[100]). 299 | frame(union,[dom_range],[[struct,struct,struct]]). 300 | frame(union,[defn,name],[union_defn]). 301 | 302 | frame(canonize,[name],[canonize]). 303 | frame(canonize,[dom_range],[[predicate,predicate,operation]]). 304 | frame(canonize,[genl],[operation]). 305 | frame(canonize,[isas],[operation]). 306 | frame(canonize,[worth],[200]). 307 | %frame(canonize,[fillin], 308 | %frame(canonize,[suggest], 309 | %frame(canonize, 310 | 311 | 312 | frame(list_union,[name],[list_union]). 313 | frame(list_union,[dom_range],[[list,list,list]]). 314 | frame(list_union,[genl],[union]). 315 | frame(list_union,[worth],[100]). 316 | frame(list_union,[defn,name],[list_union_defn]). 317 | 318 | frame(list_intersect,[name],[list_intersect]). 319 | frame(list_intersect,[dom_range],[[list,list,list]]). 320 | frame(list_intersect,[genl],[intersect]). 321 | frame(list_intersect,[worth],[100]). 322 | frame(list_intersect,[defn,name],[list_intersect_defn]). 323 | 324 | frame(intersect,[name],[intersect]). 325 | frame(intersect,[dom_range],[[struct,struct,struct]]). 326 | frame(intersect,[isas],[operation]). 327 | frame(intersect,[spec],[set_intersect,bag_intersect,list_intersect, 328 | oset_intersect]). 329 | 330 | frame(intersect,[worth],[100]). 331 | frame(intersect,[defn,name],[intersect_defn]). 332 | 333 | frame(set_union,[name],[set_union]). 334 | frame(set_union,[dom_range],[[set,set,set]]). 335 | frame(set_union,[genl],[union]). 336 | frame(set_union,[worth],[100]). 337 | frame(set_union,[defn,name],[set_union_defn]). 338 | 339 | frame(set_intersect,[name],[set_intersect]). 340 | frame(set_intersect,[genl],[intersect]). 341 | frame(set_intersect,[dom_range],[[set,set,set]]). 342 | frame(set_intersect,[worth],[100]). 343 | frame(set_intersect,[defn,name],[set_intersect_defn]). 344 | 345 | frame(oset_union,[name],[oset_union]). 346 | frame(oset_union,[dom_range],[[oset,oset,oset]]). 347 | frame(oset_union,[genl],[union]). 348 | frame(oset_union,[worth],[100]). 349 | frame(oset_union,[defn,name],[oset_union_defn]). 350 | 351 | frame(oset_intersect,[name],[oset_intersect]). 352 | frame(oset_intersect,[genl],[intersect]). 353 | frame(oset_intersect,[worth],[100]). 354 | frame(oset_intersect,[dom_range],[[oset,oset,oset]]). 355 | frame(oset_intersect,[defn,name],[oset_intersect_defn]). 356 | 357 | frame(oset_insert,[name],[oset_insert]). 358 | frame(oset_insert,[dom_range],[[anything,oset,oset]]). 359 | frame(oset_insert,[genl],[insert]). 360 | frame(oset_insert,[worth],[100]). 361 | frame(oset_insert,[defn,name],[oset_insert_defn]). 362 | 363 | frame(oset_delete,[name],[oset_delete]). 364 | frame(oset_delete,[dom_range],[[anything,oset,oset]]). 365 | frame(oset_delete,[genl],[delete]). 366 | frame(oset_delete,[worth],[100]). 367 | frame(oset_delete,[defn,name],[oset_delete_defn]). 368 | 369 | frame(ordered_struct,[name],[ordered_struct]). 370 | frame(ordered_struct,[spec],[oset,list]). 371 | frame(ordered_struct,[genl],[struct]). 372 | frame(ordered_struct,[worth],[200]). 373 | %frame(ordered_struct,[fillin],[]). 374 | %frame(ordered_struct,[check], 375 | %frame(ordered_struct,[interest], 376 | frame(ordered_struct,[defn,name],[ordered_struct_defn]). 377 | 378 | frame(no_mult_elements_struct,[name],[no_mult_elements_struct]). 379 | frame(no_mult_elements_struct,[spec],[set,oset]). 380 | frame(no_mult_elements_struct,[genl],[struct]). 381 | frame(no_mult_elements_struct,[worth],[200]). 382 | frame(no_mult_elements_struct,[defn,name], 383 | []). 384 | 385 | frame(empty_struct,[name],[empty_struct]). 386 | frame(empty_struct,[genl],[struct]). 387 | frame(empty_struct,[worth],[100]). 388 | frame(empty_struct,[defn,name],[empty_struct_defn]). 389 | 390 | 391 | 392 | frame(nonempty_struct,[name],[nonempty_struct]). 393 | frame(nonempty_struct,[genl],[struct]). 394 | frame(nonempty_struct,[worth],[100]). 395 | frame(nonempty_struct,[in_ran_of],[insert]). 396 | frame(nonempty_struct,[defn,name],[nonempty_struct_defn]). 397 | 398 | 399 | frame(list,[name],[list]). 400 | frame(list,[spec],[ordered_pairs]). 401 | frame(list,[genl],[ordered_struct,multiple_elements_struct]). 402 | frame(list,[worth],[400]). 403 | frame(list,[in_domain_of],[list_union,list_intersect,list_diff,list_insert, 404 | list_delete]). 405 | frame(list,[in_ran_of],[list_union,list_intersect,list_diff,list_insert, 406 | list_delete]). 407 | frame(list,[defn,name],[list_defn]). 408 | 409 | 410 | frame(ordered_pairs,[name],[ordered_pairs]). 411 | frame(ordered_pairs,[in_dom_of],[reverse_ord_pair]). 412 | frame(ordered_pairs,[in_ran_of],[reverse_ord_pair]). 413 | frame(ordered_pairs,[genl],[list]). 414 | frame(ordered_pairs,[worth],[200]). 415 | frame(ordered_pairs,[defn,name],[ordered_pairs_defn]). 416 | 417 | 418 | frame(list_insert,[name],[list_insert]). 419 | frame(list_insert,[dom_range],[[anything,list,list]]). 420 | frame(list_insert,[genl],[insert]). 421 | frame(list_insert,[worth],[100]). 422 | frame(list_insert,[defn,name],[list_insert_defn]). 423 | 424 | frame(multiple_elements_struct,[name],[multiple_elements_struct]). 425 | frame(multiple_elements_struct,[spec],[list,bag]). 426 | frame(multiple_elements_struct,[worth],[200]). 427 | frame(multiple_elements_struct,[genl],[struct]). 428 | frame(multiple_elements_struct,[defn,name],[]). 429 | 430 | frame(first_element,[name],[first_element]). 431 | frame(first_element,[isas],[operation]). 432 | frame(first_element,[worth],[100]). 433 | frame(first_element,[dom_range],[[ordered_struct,anything]]). 434 | frame(first_element,[defn,name],[first_element_defn]). 435 | 436 | frame(last_element,[name],[last_element]). 437 | frame(last_element,[isas],[operation]). 438 | frame(last_element,[worth],[100]). 439 | frame(last_element,[dom_range],[[ordered_struct,anything]]). 440 | frame(last_element,[defn,name],[last_element_defn]). 441 | 442 | /* I have a large problem with the next few concepts, all the 443 | ones with constant-X. My problem is this: are these concepts' 444 | defn's to be used to check other concepts so that we can see 445 | if they produce constant values or are they predicates which produce 446 | constant values? I am going to assume that for the defn they are 447 | like lenat's defn's. That is constant_false takes anything and 448 | gives back false, it is therefore not a category. But I am also going 449 | to include a check function that will weakly check to see if 450 | a concept is a constant function! -marcos 451 | 452 | I have figured out the problem: constant_true and false are examples 453 | of constant_predicate and not really specializations, or at least as 454 | much as any specialization is an example or any example a specialization 455 | by definition. However, because they are not categories of concepts 456 | as so much of these concepts are, they cannot have examples themselves 457 | but only bothers. For example, constant true is an example of the 458 | concept funtions-which-return-true just as the predicate Vx:large(x) & 459 | ~large(x), is an example of funtions-which-return-true but is it an 460 | example of true? Prehaps of truth but true? -marcos 461 | */ 462 | 463 | frame(constant_false,[name],[constant_false]). 464 | frame(constant_false,[dom_range],[[anything,anything,false], 465 | [anything,anything,true_false]]). 466 | frame(constant_false,[genl],[constant_prediate]). 467 | frame(constant_false,[worth],[100]). 468 | frame(constant_false,[defn,name],[constant_false_defn]). 469 | frame(constant_false,[examples,check],[constant_h_1]). 470 | 471 | frame(constant_predicate,[name],[constant_predicate]). 472 | frame(constant_predicate,[dom_range],[[anything,anything,true_false]]). 473 | frame(constant_predicate,[isas],[predicate]). 474 | frame(constant_predicate,[spec],[constant_true,constant_false]). 475 | frame(constant_predicate,[worth],[100]). 476 | /*rather than use lenat's idea of constant_predicate_defn, 477 | i.e. check the constant_predicate.EXs slot, I invent one. 478 | */ 479 | frame(constant_predicate,[defn,name],[constant_predicate_defn]). 480 | 481 | frame(constant_true,[name],[constant_true]). 482 | frame(constant_true,[dom_range],[[anything,anything,true],[anything,anything,true_false]]). 483 | frame(constant_true,[genl],[constant_predicate]). 484 | frame(constant_true,[worth],[100]). 485 | frame(constant_true,[defn,name],[constant_true_defn]). 486 | frame(constant_true,[examples,check],[constant_h_2]). 487 | frame(constant_true,[defn,arity],[1]). 488 | 489 | frame(list_delete,[name],[list_delete]). 490 | frame(list_delete,[dom_range],[[anything,list,list]]). 491 | frame(list_delete,[genl],[delete]). 492 | frame(list_delete,[worth],[100]). 493 | frame(list_delete,[defn,name],[list_delete_defn]). 494 | 495 | frame(first,[name],[first]). 496 | frame(first,[genl],[list_delete]). 497 | frame(first,[dom_range],[[list,list,list],[bag,bag,bag],[struct,struct,struct]]). 498 | 499 | frame(first,[worth],[200]). 500 | frame(first,[defn,name],[first]). 501 | %all of the prolog predicates that are being represented here, built in 502 | %or no, have their name as their defn name -marcos 503 | 504 | frame(rest,[name],[rest]). 505 | frame(rest,[dom_range],[[list,list,list],[bag,bag,bag],[struct,struct,struct], 506 | [list,list,empty_struct],[bag,bag,empty_struct],[struct,struct,empty_struct]]). 507 | frame(rest,[genl],[list_delete]). 508 | frame(rest,[worth], [200]). 509 | frame(rest,[defn,name],[rest_defn]). 510 | 511 | frame(reverse_ord_pair,[name],[reverse_ord_pair]). 512 | frame(reverse_ord_pair,[isas],[operation]). 513 | frame(reverse_ord_pair,[dom_range],[[ordered_pairs,ordered_pairs]]). 514 | frame(reverse_ord_pair,[worth],[100]). 515 | frame(reverse_ord_pair,[defn,name],[reverse_ord_pair_defn]). 516 | 517 | 518 | frame(identity,[name],[identity]). 519 | frame(identity,[dom_range],[[anything,anything],[object,object], 520 | [struct,struct],[active,active]]). 521 | frame(identity,[conjecs],['identity, restricted to objects, is the same as object-equality']). 522 | frame(identity,[genl],[projection1,projection2]). 523 | frame(identity,[worth],[100]). 524 | frame(identity,[defn,name],[identity_defn]). 525 | 526 | 527 | frame(projection1,[name],[projection1]). 528 | frame(projection1,[dom_range],[[X,anything,anything,X]]). 529 | frame(projection1,[spec],[identity]). 530 | frame(projection1,[isas],[operation]). 531 | frame(projection1,[worth],[100]). 532 | frame(projection1,[defn,name],[]). 533 | 534 | frame(projection2,[name],[projection2]). 535 | frame(projection2,[dom_range],[[anything,X,anything,X]]). 536 | frame(projection2,[spec],[identity]). 537 | frame(projection2,[isas],[operation]). 538 | frame(projection2,[worth],[200]). 539 | frame(projection2,[defn,name],[]). 540 | 541 | frame(invert_an_op,[name],[invert_an_op]). 542 | frame(invert_an_op,[isas],[operation]). 543 | frame(invert_an_op,[worth],[300]). 544 | frame(invert_an_op,[dom_range],[[operation,operation],[operation,inverted_op]]). 545 | frame(invert_an_op,[defn,name],[invert_op_defn]). 546 | 547 | frame(inverted_op,[name],[inverted_op]). 548 | frame(inverted_op,[genl],[operation]). 549 | frame(inverted_op,[worth],[200]). 550 | frame(inverted_op,[in_dom_of],[invert]). 551 | frame(inverted_op,[in_ran_of],[invert]). 552 | frame(inverted_op,[defn,name],[inverted_op_defn]). 553 | 554 | frame(logical_combination,[name],[logical_combination]). 555 | frame(logical_combination,[genl],[relation]). 556 | frame(logical_combination,[worth],[200]). 557 | frame(logical_combination,[defn,name],[]). 558 | 559 | frame(parallel_join,[name],[parallel_join]). 560 | frame(parallel_join,[genl],[parallel_join2]). 561 | frame(parallel_join,[worth],[100]). 562 | frame(parallel_join,[dom_range],[[type_of_struct,operation,operation]]). 563 | frame(parallel_join,[defn,name],[]). 564 | 565 | frame(parallel_join2,[name],[parallel_join2]). 566 | frame(parallel_join2,[spec],[parallel_join]). 567 | frame(parallel_join2,[isas],[operation]). 568 | frame(parallel_join2,[worth],[100]). 569 | frame(parallel_join2,[dom_range],[[type_of_struct,type_of_struct,operation]]). 570 | frame(parallel_join2,[defn,name],[]). 571 | 572 | frame(parallel_replace,[name],[parallel_replace]). 573 | frame(parallel_replace,[genl],[parallel_replace2]). 574 | frame(parallel_replace,[worth],[100]). 575 | frame(parallel_replace,[dom_range],[[type_of_struct,operation,operation]]). 576 | frame(parallel_replace,[defn,name],[]). 577 | 578 | frame(parallel_replace2,[name],[parallel_replace2]). 579 | frame(parallel_replace2,[spec],[parallel_replace]). 580 | frame(parallel_replace2,[isas],[operation]). 581 | frame(parallel_replace2,[worth],[100]). 582 | frame(parallel_replace2,[dom_range],[[type_of_struct,type_of_struct,operation]]). 583 | frame(parallel_replace2,[defn,name],[]). 584 | 585 | frame(relation,[name],[relation]). 586 | frame(relation,[genl],[active]). 587 | frame(relation,[spec],[logical_combination]). 588 | frame(relation,[worth],[100]). 589 | frame(relation,[defn,name],[]). 590 | 591 | frame(repeat,[name],[repeat]). 592 | frame(repeat,[genl],[repeat2]). 593 | frame(repeat,[worth],[100]). 594 | frame(repeat,[dom_range],[[type_of_struct,operation,operation]]). 595 | frame(repeat,[defn,name],[]). 596 | 597 | frame(repeat2,[name],[repeat2]). 598 | frame(repeat2,[spec],[repeat]). 599 | frame(repeat2,[isas],[operation]). 600 | frame(repeat2,[worth],[100]). 601 | frame(repeat2,[dom_range],[[type_of_struct,type_of_struct,operation,operation]]). 602 | frame(repeat2,[defn,name],[]). 603 | 604 | frame(restrict,[name],[restrict]). 605 | frame(restrict,[isas],[operation]). 606 | frame(restrict,[worth],[200]). 607 | frame(restrict,[dom_range],[[active,active],[operation,operation],[predicate, 608 | predicate]]). 609 | frame(restrict,[defn,name],[restrict_defn]). 610 | 611 | frame(struct_of_struct,[name],[struct_of_struct]). 612 | frame(struct_of_struct,[genl],[object]). 613 | frame(struct_of_struct,[in_dom_of],[insert,delete,member,empty,nonempty,difference,union,intersect,parallel-replace2,parallel_join2,repeat2]). 614 | frame(struct_of_struct,[in_ran_of],[insert,delete,difference,union,intersect]). 615 | frame(struct_of_struct,[worth],[200]). 616 | frame(struct_of_struct,[spec],[ord_struct,empty_struct,unord_struct,nonempty_struct]). 617 | frame(struct_of_struct,[defn,name],[struct_of_struct_defn]). 618 | 619 | frame(truth_value,[name],[truth_value]). 620 | frame(truth_value,[genl],[atom]). 621 | frame(truth_value,[worth],[100]). 622 | frame(truth_value,[defn,name],[]). 623 | 624 | frame(unord_struct,[name],[unord_struct]). 625 | frame(unord_struct,[genl],[struct]). 626 | frame(unord_struct,[spec],[set,bag]). 627 | frame(unord_struct,[worth],[200]). 628 | frame(unord_struct,[defn,name],[]). 629 | --------------------------------------------------------------------------------