From 8d3e9baadf395b4668d003242e427851dff7eaec Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Wed, 3 Dec 2008 09:36:39 -0800 Subject: [PATCH] 3 --- agenda.pl | 240 +++++++++++++++++++ am.pl | 69 +++--- amutilities.pl | 601 ------------------------------------------------ clock.pl | 17 ++ common.pl | 326 ++++++++++++++++++++++++++ concepts.pl | 4 +- definitions.pl | 163 +++++++------ descriptions.pl | 15 +- h/h123.pl | 2 +- h/h17.pl | 5 +- h/h174.pl | 9 +- h/h180.pl | 2 +- h/h183.pl | 2 +- h/h204.pl | 3 +- h/h31.pl | 2 +- h/h407.pl | 9 +- h/h6.pl | 5 +- h/h89.pl | 3 +- utilities.pl | 88 ++++--- 19 files changed, 770 insertions(+), 795 deletions(-) create mode 100644 agenda.pl delete mode 100644 amutilities.pl create mode 100644 clock.pl create mode 100644 common.pl diff --git a/agenda.pl b/agenda.pl new file mode 100644 index 0000000..a35804b --- /dev/null +++ b/agenda.pl @@ -0,0 +1,240 @@ +:- public([ + toptask/1,best_worth/1,do_threshold/1,addtoagenda/5, + select_task/2,current_task/1, display_tasks/1,cdisplay/1, + current_worth/1,delete_task/1,user_task/0]). + +% toptask(-Task_record) returns the highest priority task on the agenda. +% The task is removed from the agenda and added to the history when selected +toptask(Task):- + retract(agenda(Agenda)), + split(Agenda,[Task|Agenda2]), + addtohistory(Task), + assertz(agenda(Agenda2)). + +/* best_worth(Worth of top task) gets the worth of the best task */ +best_worth(0):-agenda([]). +best_worth(Worth) :- agenda([[_,_,_,Worth,_]|_]). + +/* do_threshold returns the lowest acceptable value for an + * executable task. + */ + +do_threshold(500). + +/* addtohistory adds a task to the 5 task history stack which is kept by + the system. When a new task is selected for execution it is pushed + onto the stack */ +addtohistory(Task):- + retract(history(History)), + addh1(Task,History,H2), + assertz(history(H2)). + +/* this is a help function used by addtohistory. It adds a new task to the + assertzed history clause, removing the oldest task if there are already 10 */ +addh1(Task,[],[Task]). +addh1(Task,History,[Task|History]):- + length(History,L), + L<10. +addh1(Task,History,[Task|H2]):- + removelast(History,H2). + +/* addtoagenda adds a new task to the agenda if it is not already there. + Its parameters are operation, concept, facet, worth, and reason: + addtoagenda(+Op,+C,+F,+W,+R). */ + +/* if task is already there with same reason, do nothing */ +addtoagenda(Op,C,F,W,R):- + agenda(Agenda), + member([Op,C,F,_,Rlist],Agenda), + member([R,_],Rlist),!. +/* if task has been executed within the last 5 cycles and it's not worthy (<300) +, */ +/* do nothing. */ +addtoagenda(Op,C,F,W,R):- + W<300, + history(History), + member([Op,C,F,_,Rlist],History), + member([R,_],Rlist),!. +/* if task is there with other reasons, add new reason and recompute worth */ +addtoagenda(Op,C,F,W,R):- + agenda(Agenda), + member([Op,C,F,_,Rlist],Agenda), +% nl, cwrite('adding ',[Op,C,F,W,R]), + newworth(Op,C,F,[[R,W]|Rlist],Worth), + remove([Op,C,F,_,_],Agenda,Agenda2), + addinorder([Op,C,F,Worth,[[R,W]|Rlist]],Agenda2,Agenda3), + retract(agenda(_)), + assertz(agenda(Agenda3)),!. +/* if task is not there, add task to agenda */ +addtoagenda(Op,C,F,W,R):- +% cwrite('adding ',[Op,C,F,W,R]), + agenda(Agenda), + newworth(Op,C,F,[[R,W]],Worth), + addinorder([Op,C,F,Worth,[[R,W]]],Agenda,Agenda2), + retract(agenda(_)), + assertz(agenda(Agenda2)),!. + +/* newworth computes the worth of a concept using the formula: + worth=(2*operator worth + 3*concept worth + 5*facet worth) + * sum of reason worths / 1000. */ +newworth(Op,C,F,Rlist,Worth):- + worth(Op,Oworth), + worth(C,Cworth), + worth(F,Fworth), + getrworth(Rlist,Rworth), + Ocf is (2*Oworth)+(3*Cworth)+(5*Fworth), + Worth is (Rworth*Ocf)/1000. + +/* getrworth is a help function for newworth that sums the worths of + the reasons for a task */ +getrworth([],0). +getrworth([[R,W]|Tail],Rworth):- + getrworth(Tail,Rw2), + Rworth is W+Rw2. + +/* addinorder adds a new task to the agenda list in priority order. If + an existing task has the same priority, the new task goes ahead of + it to give recent tasks a slight priority edge */ +addinorder(Task,[],[Task]). +addinorder(Task,Agenda,[Task|Agenda]):- + split(Task,[_,_,_,W,_]), + split(Agenda,[[_,_,_,W2,_]|Tail]), + W>=W2. +addinorder(Task,[H|T],[H|Agenda2]):- + addinorder(Task,T,Agenda2). + +/* select_task allows selecting a task other than the highest priority + task from the agenda. If the task number exceeds the actual number of + tasks in the agenda, the top task is returned. The task is removed from + the agenda and added to the history. + select_task(+Task_number,-Task_record). */ +select_task(N,Task):- + agenda(Agenda), + length(Agenda,L), + N>L, + toptask(Task). +select_task(1,Task):- + toptask(Task). +select_task(N,Task):- + retract(agenda(Agenda)), + nth(Agenda,N,Task), + addtohistory(Task), + remove(Task,Agenda,Agenda2), + assertz(agenda(Agenda2)). + +/* current_task(-Task_record) returns the record of the currently executing + task from the history stack. */ +current_task(Task):- + history([Task|_]). +current_task([]). + +/* display_tasks(+Number_to_display) prints the top N tasks from the agenda + if N exist */ +display_tasks(N):- + agenda(Agenda), + disp(N,1,Agenda). + +/* disp is a help function for display_tasks */ +disp(0,_,_):- + nl,nl. +disp(_,_,[]):- + nl,nl. +disp(N,Count,[H|T]):- + wrtask(H,Count), + N1 is N-1, + C2 is Count+1, + disp(N1,C2,T). + +/* wrtask is a help function that displays the information for a single + task */ +wrtask([Op,C,F,W,Rlist],Count):- + nl, + write('Task # '),write(Count),nl, + write(' operator: '),write(Op),nl, + write(' concept: '),write(C),nl, + write(' facet: '),write(F),nl, + write(' worth: '),write(W),nl, + write(' reasons: '),nl, + writerlist(Rlist). + +/* writerlist is a help function for wrtask which writes out the reason + list */ +writerlist([]). +writerlist([[R,W]|T]):- + write(' '),write(R),write(' '),write(W),nl, + writerlist(T). + +/* cdisplay(+Number_of_Tasks) concisely displays the desired number of tasks + from the top of the agenda. The tasks are displayed one per line; each line + contains the task number, operation, concept, facet, and worth. Reasons are + not displayed. cwrite is used to print a heading. */ +cdisplay(N):- + agenda(Agenda), + length(Agenda,Num), + amformat('~a Tasks on agenda~n',[Num]), + cwrite(' ',['OPERATION','CONCEPT','FACET','WORTH',unused]), + cdisp(N,1,Agenda). + +/* cdisp is a help function for cdisplay */ +cdisp(0,_,_):-nl,nl. +cdisp(_,_,[]):-nl,nl. +cdisp(N,Count,[H|T]):- + cwrite(Count,H), + C1 is Count+1, + N1 is N-1, + cdisp(N1,C1,T). + +/* cwrite writes a one line concise task entry */ +cwrite(N,[Op,C,F,W,_]):- + write(N), + spaces(N,5), + write(Op), + spaces(Op,15), + write(C), + spaces(C,20), + write(F), + spaces(F,30), + write(W),nl. + +/* spaces is a function to fill the difference in length between the length of + a given atom and the print field into which it is being written. It is + used to align atoms for columnar output */ + + +spaces(X,N):- + explode(X,List), + length(List,L), + T is N-L, + tab(T). + +/* current_worth(-W) returns the worth of the currently executing task from + the top of the history. */ +current_worth(0):- + history([]). +current_worth(W):- + history([[_,_,_,W,_]|_]). + +/* delete_task(+task_number) deletes the task numbered N from the agenda. Tasks + are numbered starting with 1 as the highest priority task. */ +delete_task(N):- + agenda(Agenda), + length(Agenda,L), + (N<1;N>L). +delete_task(N):- + retract(agenda(Agenda)), + nth(Agenda,N,Task), + remove(Task,Agenda,Agenda2), + assertz(agenda(Agenda2)). + +/* user_task is invoked to allow the user to define his/her own task. The worth + is fixed at 500 and the reason is fixed. */ +user_task:- + write('Input information about the new task.'),nl, + write('End with a period since the Prolog read is used here.'),nl, + write('Operation: '),ttyflush, + read(Op),nl, + write('Concept: '),ttyflush, + read(C),nl, + write('Facet: '),ttyflush, + read(F),nl, + addtoagenda(Op,C,[F],500,'User Requested Task'). diff --git a/am.pl b/am.pl index f3494ad..ddf283d 100644 --- a/am.pl +++ b/am.pl @@ -1,9 +1,17 @@ -module(am, [am/0]). - -compile([amutilities,utilities]). -consult([descriptions,concepts,definitions]). -load_am_files:-descr(H,_,_), strcat('h/',H,Hfile),consult(Hfile),fail. -load_am_files. +:- public([am/0]). + +load_am_files :- + [common], + [utilities], + [clock], + [agenda], + [descriptions], + [concepts], + [definitions], + descr(H,_,_), + strcat('h/',H,Hfile), + consult(Hfile), + fail. am :- init_am, @@ -12,23 +20,24 @@ fail. init_am :- - abolish(agenda,1), - abolish(time,1), - abolish(history,1), - abolish(do_threshold,1), - abolish(seed,1), - abolish(auto,1), - abolish(cycle,1), - assert(cycle(1)), + load_am_files, + abolish(agenda/1), + abolish(time/1), + abolish(history/1), + abolish(do_threshold/1), + abolish(seed/1), + abolish(auto/1), + abolish(cycle/1), + assertz(cycle(1)), % unless am is broken you shouldn't need to reload the concepts every time -% abolish(frame,3), +% abolish(frame/3), % [concepts], - assert(auto(no)), - assert(seed(13)), - assert(time(0)), - assert(history([])), - assert(do_threshold(500)), - assert(agenda([[fillin,set, [examples],310,[['some reason',10]]], + assertz(auto(no)), + assertz(seed(13)), + assertz(time(0)), + assertz(history([])), + assertz(do_threshold(500)), + assertz(agenda([[fillin,set, [examples],310,[['some reason',10]]], [suggest,set,[examples],300,[['why not',10]]], [fillin,set, [genl], 300,[['whynot',10]]], [fillin,set, [spec], 300,[['reason',10]]], @@ -36,7 +45,7 @@ am_loop:- - retract(cycle(Cycle)),NextCycle is Cycle + 1, assert(cycle(NextCycle)), + retract(cycle(Cycle)),NextCycle is Cycle + 1, assertz(cycle(NextCycle)), amformat('~n---- Cycle ~a: ', [Cycle]), user_selects_task(Task), Task = [Op,Con,Slot,Worth,_], @@ -113,7 +122,7 @@ */ compute_time(Worth) :- T is Worth * 3 / 2, retract(time(_)), - assert(time(T)). + assertz(time(T)). collect_heuristics(Con,[examples,typ],Op,H) :- collect_heuristics(Con,[examples],Op,H). @@ -137,7 +146,7 @@ clock(Start,Elapsed_time), retract(time(T)), T1 is T - Elapsed_time, - assert(time(T1)),!, + assertz(time(T1)),!, execute_heuristics(Con,R). execute_heuristics(_,[]). @@ -152,9 +161,9 @@ apply_heuristic(H,A):- apply(H,A), !. apply_heuristic(_,_). -% This really goes in amutilities.pl but it must be interpreted so it's here -print_put_trace(C,S,V):- - ancestors([G|_]), % find out who's calling put/3, - G=..[H|_], - write([' Adding',V,to,the,S,slot,of,C]), nl, % show change, - !, fail. +%? % This really goes in amutilities.pl but it must be interpreted so it's here +%? print_put_trace(C,S,V):- +%? ancestors([G|_]), % find out who's calling put/3, +%? G=..[H|_], +%? write([' Adding',V,to,the,S,slot,of,C]), nl, % show change, +%? !, fail. diff --git a/amutilities.pl b/amutilities.pl deleted file mode 100644 index ca880c4..0000000 --- a/amutilities.pl +++ /dev/null @@ -1,601 +0,0 @@ -% This file now contains the old files agenda.pl, clock.pl, and common.pl - -%%% AGENDA STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -:-public toptask/1,best_worth/1,do_threshold/1,addtoagenda/5, - select_task/2,current_task/1, display_tasks/1,cdisplay/1, - current_worth/1,delete_task/1,user_task/0. -?-no_style_check(all). - -% toptask(-Task_record) returns the highest priority task on the agenda. -% The task is removed from the agenda and added to the history when selected -toptask(Task):- - retract(agenda(Agenda)), - split(Agenda,[Task|Agenda2]), - addtohistory(Task), - assert(agenda(Agenda2)). - -/* best_worth(Worth of top task) gets the worth of the best task */ -best_worth(0):-agenda([]). -best_worth(Worth) :- agenda([[_,_,_,Worth,_]|_]). - -/* do_threshold returns the lowest acceptable value for an - * executable task. - */ - -do_threshold(500). - -/* addtohistory adds a task to the 5 task history stack which is kept by - the system. When a new task is selected for execution it is pushed - onto the stack */ -addtohistory(Task):- - retract(history(History)), - addh1(Task,History,H2), - assert(history(H2)). - -/* this is a help function used by addtohistory. It adds a new task to the - asserted history clause, removing the oldest task if there are already 10 */ -addh1(Task,[],[Task]). -addh1(Task,History,[Task|History]):- - length(History,L), - L<10. -addh1(Task,History,[Task|H2]):- - removelast(History,H2). - -/* addtoagenda adds a new task to the agenda if it is not already there. - Its parameters are operation, concept, facet, worth, and reason: - addtoagenda(+Op,+C,+F,+W,+R). */ - -/* if task is already there with same reason, do nothing */ -addtoagenda(Op,C,F,W,R):- - agenda(Agenda), - member([Op,C,F,_,Rlist],Agenda), - member([R,_],Rlist),!. -/* if task has been executed within the last 5 cycles and it's not worthy (<300) -, */ -/* do nothing. */ -addtoagenda(Op,C,F,W,R):- - W<300, - history(History), - member([Op,C,F,_,Rlist],History), - member([R,_],Rlist),!. -/* if task is there with other reasons, add new reason and recompute worth */ -addtoagenda(Op,C,F,W,R):- - agenda(Agenda), - member([Op,C,F,_,Rlist],Agenda), -% nl, cwrite('adding ',[Op,C,F,W,R]), - newworth(Op,C,F,[[R,W]|Rlist],Worth), - remove([Op,C,F,_,_],Agenda,Agenda2), - addinorder([Op,C,F,Worth,[[R,W]|Rlist]],Agenda2,Agenda3), - retract(agenda(_)), - assert(agenda(Agenda3)),!. -/* if task is not there, add task to agenda */ -addtoagenda(Op,C,F,W,R):- -% cwrite('adding ',[Op,C,F,W,R]), - agenda(Agenda), - newworth(Op,C,F,[[R,W]],Worth), - addinorder([Op,C,F,Worth,[[R,W]]],Agenda,Agenda2), - retract(agenda(_)), - assert(agenda(Agenda2)),!. - -/* newworth computes the worth of a concept using the formula: - worth=(2*operator worth + 3*concept worth + 5*facet worth) - * sum of reason worths / 1000. */ -newworth(Op,C,F,Rlist,Worth):- - worth(Op,Oworth), - worth(C,Cworth), - worth(F,Fworth), - getrworth(Rlist,Rworth), - Ocf is (2*Oworth)+(3*Cworth)+(5*Fworth), - Worth is (Rworth*Ocf)/1000. - -/* getrworth is a help function for newworth that sums the worths of - the reasons for a task */ -getrworth([],0). -getrworth([[R,W]|Tail],Rworth):- - getrworth(Tail,Rw2), - Rworth is W+Rw2. - -/* addinorder adds a new task to the agenda list in priority order. If - an existing task has the same priority, the new task goes ahead of - it to give recent tasks a slight priority edge */ -addinorder(Task,[],[Task]). -addinorder(Task,Agenda,[Task|Agenda]):- - split(Task,[_,_,_,W,_]), - split(Agenda,[[_,_,_,W2,_]|Tail]), - W>=W2. -addinorder(Task,[H|T],[H|Agenda2]):- - addinorder(Task,T,Agenda2). - -/* select_task allows selecting a task other than the highest priority - task from the agenda. If the task number exceeds the actual number of - tasks in the agenda, the top task is returned. The task is removed from - the agenda and added to the history. - select_task(+Task_number,-Task_record). */ -select_task(N,Task):- - agenda(Agenda), - length(Agenda,L), - N>L, - toptask(Task). -select_task(1,Task):- - toptask(Task). -select_task(N,Task):- - retract(agenda(Agenda)), - nth(Agenda,N,Task), - addtohistory(Task), - remove(Task,Agenda,Agenda2), - assert(agenda(Agenda2)). - -/* current_task(-Task_record) returns the record of the currently executing - task from the history stack. */ -current_task(Task):- - history([Task|_]). -current_task([]). - -/* display_tasks(+Number_to_display) prints the top N tasks from the agenda - if N exist */ -display_tasks(N):- - agenda(Agenda), - disp(N,1,Agenda). - -/* disp is a help function for display_tasks */ -disp(0,_,_):- - nl,nl. -disp(_,_,[]):- - nl,nl. -disp(N,Count,[H|T]):- - wrtask(H,Count), - N1 is N-1, - C2 is Count+1, - disp(N1,C2,T). - -/* wrtask is a help function that displays the information for a single - task */ -wrtask([Op,C,F,W,Rlist],Count):- - nl, - write('Task # '),write(Count),nl, - write(' operator: '),write(Op),nl, - write(' concept: '),write(C),nl, - write(' facet: '),write(F),nl, - write(' worth: '),write(W),nl, - write(' reasons: '),nl, - writerlist(Rlist). - -/* writerlist is a help function for wrtask which writes out the reason - list */ -writerlist([]). -writerlist([[R,W]|T]):- - write(' '),write(R),write(' '),write(W),nl, - writerlist(T). - -/* cdisplay(+Number_of_Tasks) concisely displays the desired number of tasks - from the top of the agenda. The tasks are displayed one per line; each line - contains the task number, operation, concept, facet, and worth. Reasons are - not displayed. cwrite is used to print a heading. */ -cdisplay(N):- - agenda(Agenda), - length(Agenda,Num), - amformat('~a Tasks on agenda~n',[Num]), - cwrite(' ',['OPERATION','CONCEPT','FACET','WORTH',unused]), - cdisp(N,1,Agenda). - -/* cdisp is a help function for cdisplay */ -cdisp(0,_,_):-nl,nl. -cdisp(_,_,[]):-nl,nl. -cdisp(N,Count,[H|T]):- - cwrite(Count,H), - C1 is Count+1, - N1 is N-1, - cdisp(N1,C1,T). - -/* cwrite writes a one line concise task entry */ -cwrite(N,[Op,C,F,W,_]):- - write(N), - spaces(N,5), - write(Op), - spaces(Op,15), - write(C), - spaces(C,20), - write(F), - spaces(F,30), - write(W),nl. - -/* spaces is a function to fill the difference in length between the length of - a given atom and the print field into which it is being written. It is - used to align atoms for columnar output */ - - -spaces(X,N):- - explode(X,List), - length(List,L), - T is N-L, - tab(T). - -/* current_worth(-W) returns the worth of the currently executing task from - the top of the history. */ -current_worth(0):- - history([]). -current_worth(W):- - history([[_,_,_,W,_]|_]). - -/* delete_task(+task_number) deletes the task numbered N from the agenda. Tasks - are numbered starting with 1 as the highest priority task. */ -delete_task(N):- - agenda(Agenda), - length(Agenda,L), - (N<1;N>L). -delete_task(N):- - retract(agenda(Agenda)), - nth(Agenda,N,Task), - remove(Task,Agenda,Agenda2), - assert(agenda(Agenda2)). - -/* user_task is invoked to allow the user to define his/her own task. The worth - is fixed at 500 and the reason is fixed. */ -user_task:- - write('Input information about the new task.'),nl, - write('End with a period since the Prolog read is used here.'),nl, - write('Operation: '),ttyflush, - read(Op),nl, - write('Concept: '),ttyflush, - read(C),nl, - write('Facet: '),ttyflush, - read(F),nl, - addtoagenda(Op,C,[F],500,'User Requested Task'). - -%% End of AGENDA STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% CLOCK STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -clock(S,_) :- var(S), statistics(runtime,[S1,_]), - S is S1 / 100, !. -clock(S,T) :- var(T),nonvar(S), - statistics(runtime,[T1,_]), - T2 is T1 / 100, - T3 is (T2 - S), - ((T3 = 0, T = 1); - T = T3),!. - -/* this predicate is in this file because it does not seem to - compile properly. Clock must be interpreted as well. */ - -:- op(100,fx,c). -c(X) :- makename(X,'.pl',Y),compile(Y). - -%% End of CLOCK STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% COMMON STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -:- public times_up/2, collectclauses/3, makelist/2, - ok_a/2,termination_a/3,cleanup_a/2,addnum_a/1, - check_if_any_found/2,unifyinst/4. - -amhelp:-write('This is AM. It pretends to discover concepts in the domain of set theory.'), - nl,write('Type "am." to prolog to make it go.'),nl, - write('Use examine/0 to browse the concept base'),nl. -browse:-examine. -view:-examine. -:-write('Use view to browse the concepts.'),nl. - -examine:- - write('EXAMINE which concept? (completion supported) '), - aminput(ConToken), - \+member(ConToken,['',q,quit,e,exit]), - name(ConToken,ConString), - frame(Name,_,_), name(Name,FrameString), - append(ConString,_,FrameString), % isa match? - ppframe(Name), - !, examine. - - -/*** times_up succeeds if the elapsed time exceeds the alloted time; -**** else fail. -***/ - -times_up(Alotment,Start):- clock(Start,T),T>Alotment. - -/*** collectclauses forms a list of all clauses with a given mainfunctor. -**** The only tricky part is forming a template which will match the -**** head of each of the clauses (this to satisfy the 'clause' predicate). -***/ - -collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), - bagof([Func,Body], clause(Func,Body), Clauses). -functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. - -/*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ - -makelist(0,[]). -makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). - - -/************************************************************* - * The following set of functions are used to control a - * heuristics which uses backtracking, and produces results - * through side_effects. - */ - -ok_a(Start,Allot) :- clock(Start,T), Allot > T. -ok_a(Start,Allot) :- clock(Start,T), Allot > T,ok_a(Start,Allot). - -makenumcall(H,Var,Call) :- makename(H,num,Funct), Call =.. [Funct,Var]. - -termination_a(H,_,_) :- makenumcall(H,Num,Call),Call,Num>24. -termination_a(_,S,T) :- times_up(S,T). - -cleanup_a(H,Num) :- makenumcall(H,Num,X),retract(X),!. -cleanup_a(_,0). - -addnum_a(H) :- makenumcall(H,Num,Term), retract(Term), - N is Num +1,makenumcall(H,N,New),asserta(New),!. -addnum_a(H) :- makenumcall(H,1,Term), - asserta(Term). - -check_if_any_found(H,C) :- makenumcall(H,Num,Call),Call,integer(Num), - Num > 0, - addtoagenda(check,C,[examples,typ],200,'have found some exs of C'). - -/******************** END OF SET **********************************/ - - -/****************************************************** - * unifyinst is the result of an inconsistency - * in our treatment of examples. The example of an - * object is different from an example of an activity. - * I.e. objects have an arity of 1, with NO dom/ran. - * So we have to unify them differently to get the - * appropriate call. - */ -unifyinst(1,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor,Ex],!. -unifyinst(_,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor|Ex]. - -makeinst(Defn,1,Ex,Call) :- Call =.. [Defn,Ex],!. -makeinst(Defn,_,Ex,Call) :- Call =.. [Defn|Ex]. - -%% End of COMMON STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -:- public allconcepts/1,fillable_slots/1,examples/2,exs/2, - isas/2,genls/2,specs/2,ripple/3,collect/3, - genls_sf/2,specs_sf/2,ripple_sf/3,getarity/2, - get/3,concept/1,put/3,putvals/3,update/3,fremove/3, - fremoveall/2,ppframe/1,ppall/0,worth/2,aminput/1. -?-no_style_check(all). - -/* return all currently defined concepts */ -allconcepts(C) :- - setof(X,Y^frame(X,[name],Y),C). - -/* return all slots that AM has heuristics to fillin */ -fillable_slots(S) :- - S = [[defn],[examples],[genl],[spec],[alg],[dom_range], - [in_domain_of],[in_range_of],[isas]]. -/* collect X.examples since they may live on several sub-slots */ -examples(Con,L) :- - get(Con,[examples,bnd],L1), /* bound changed to bnd, KM 7/24 */ - get(Con,[examples,typ],L2), - append(L1,L2,L). - -/* collect all the examples of Con by collecting the examples - * of all the specs of Con - */ -exs(Con,Examples):- - specs_sf(Con,Specs), % spec*(X)=Specs - removedups(Specs,Specs1), - exs1(Specs1,Exs), % examples(Specs)=Exs - exs2(Exs,Examples),!. % spec*(Exs)=Examples - - -exs1([],[]). -exs1([H|T],L) :- examples(H,L1),exs1(T,L2), union(L1,L2,L). - -exs2([],[]). -exs2([H|T],L) :- ripple(down,H,L1),exs2(T,L2),union(L1,L2,L). - -/* collect the isas according to the formula: - * genl*(isa(genl*(X))) - */ -isas(Con,L1) :- genls_sf(Con,G), - collect([isas],G,Isas1), - removedups(Isas1,Isas2), - isas1(Isas2,L), - removedups(L,L1). - -isas1([],[]). -isas1([H|T],L) :- genls_sf(H,L1),isas1(T,L2),append(L1,L2,L). - -/* collect genls or specs of a concept X by rippling UP or Down in - * the hierarchy - * ripple(+direction,+concept,-list of concepts) - */ - -genls(Con,G) :- ripple(up,Con,G),!. - -specs(Con,S) :- ripple(down,Con,S),!. - -ripple(up,X,Genls) :- ripple1([genl],[X],G),Genls = [X|G]. -ripple(down,X,Specs) :- ripple1([spec],[X],G),Specs = [X|G]. -ripple(_,X,[X]). - -ripple1(_,[],[]):-!. -ripple1(Dir,X,G) :- adjacent_to(Dir,X,G1), - ripple1(Dir,G1,G2), - append(G1,G2,G). - -/* ripple_sf is a safe ripple, that can deal with loops in the tree - * similarly with genls_sf and specs_sf - */ -genls_sf(C,G) :- ripple_sf(up,C,G),!. -specs_sf(C,S) :- ripple_sf(down,C,S),!. - -ripple_sf(up,X,Genls) :- ripple_sf1([genl],[X],[X],G),Genls = [X|G], !. -ripple_sf(down,X,Specs) :- ripple_sf1([spec],[X],[X],G),Specs = [X|G], !. -ripple_sf(_,X,[X]). - -ripple_sf1(_,_,[],[]):-!. -ripple_sf1(Dir,Seen,Level,G) :- - adjacent_to(Dir,Level,Nextlevel), - setdif(Nextlevel,Seen,Neverseen), - append(Seen,Neverseen,Nowseen), - ripple_sf1(Dir,Nowseen,Neverseen,G1), - append(Neverseen,G1,G). - -adjacent_to(_,[],[]):-!. -adjacent_to(Dir,[H|T],G) :- get(H,Dir,G1), - adjacent_to(Dir,T,G2), - append(G1,G2,G). - -/* collect all the entries on Slot for each concept in List - * collect(+Slot,+List_of_cons,-List_of_vals) - */ -collect(_,[],[]):-!. -collect(Slot,[H|T],L) :- - get(H,Slot,L1), - collect(Slot,T,L2), - append(L1,L2,L). - -/* returns the arity of a concept definition */ -getarity(Con,Arity) :- - get(Con,[dom_range],[L|_]), length(L,Arity). -getarity(Con,Arity) :- get(Con,[defn,arity],[Arity]). - -concept(C) :- frame(C,_,_),!. - -get(Name,Slot,Value):- frame(Name,Slot,Value),!. -get(_,[worth],[0]). -get(_,[examples, dif],[0,0]). -get(_,_,[]). -% commented out because they don't work (in my opinion). -%get(Name,Slot,Value) :- nonvar(Value), !, -% get1(Name,Slot,Value). -%get1(Name,Slot,Value) :- frame(Name,Slot,X),!,X = Value. -%get1(Name,Slot,[]). -%to put a single element onto a slot - -% the first clause catches all changes to the concept base and displays them. -put(C,S,V):- - watch_mode_on, % if you want a trace, - print_put_trace(C,S,V). % ! This will fail and backtrack to the real put/3. -put(C,S,V) :- put1(C,S,V),!. - -/* This stuff is duplicated in am.pl so it will be interpreted because it - doesn't work if it's compiled. (another FEATURE of VAX/VMS QP) -print_put_trace(C,S,V):- - ancestors([G|_]), % find out who's calling put/3, - G=..[H|_], - writeln([' ',H,'is adding',V,to,the,S,slot,of,C,nl]), % show change, - !, fail. -*/ - -put1(C,[examples,dif],[N,T]) :- !,nonvar(N),nonvar(T), - ((retract(frame(C,[examples,dif],[N1,T1])), - N2 is N + N1, T2 is T + T1, - assert(frame(C,[examples,dif],[N2,T2]))) - ; - (assert(frame(C,[examples,dif],[N,T])))). -put1(C,[spec],V) :- - put2(C,[spec],V), - put2(V,[genl],C). -put1(C,[genl],V) :- - put2(C,[genl],V), - put2(V,[spec],C). -put1(C,[worth],W) :- - update(C,[worth],[W]). -put1(C,[dom_range],D_r) :- - put_d_r(C,D_r), - put2(C,[dom_range],D_r). -put1(C,[isas],V) :- - put2(C,[isas],V), - put2(V,[examples,typ],C). -put1(C,[examples,T],V) :- - concept(V), - member(T,[bnd,typ]), - put2(C,[examples,T],V), - put2(V,[isas],C). -put1(C,[conjecs],X) :- - put2(C,[conjecs],X), - put1(conjecs,[examples,typ],X). - -put1(C,S,V) :- put2(C,S,V). - -put2(Name,Slot,Item) :- frame(Name,Slot,Value), - member(Item,Value). -put2(Name,Slot,Item) :- retract(frame(Name,Slot,Value)), - assert(frame(Name,Slot,[Item|Value])). -put2(Name,Slot,Item) :- assert(frame(Name,Slot,[Item])). - -put_d_r(C,[R]) :- put(R,[in_range_of],C). -put_d_r(C,[D|R]) :- put(D,[in_domain_of],C),put_d_r(C,R). - -%to add several vals to a slot -putvals(_,_,[]). -putvals(C,S,[H|T]) :- - putvals(C,S,T), - put(C,S,H). - -%update - to replace oldvalue with newvalue -update(Name,Slot,Newval) :- retract(frame(Name,Slot,_)), - assert(frame(Name,Slot,Newval)). -update(Name,Slot,Newval) :- assert(frame(Name,Slot,Newval)). - -%fremove - remove item from values of slot. Fail if not present -fremove(C,S,V) :- fremove0(C,S,V),!. - -fremove0(C,[genl],V) :- - fremove1(C,[genl],V), - fremove1(V,[spec],C). -fremove0(C,[spec],V) :- - fremove1(C,[spec],V), - fremove1(V,[genl],C). -fremove0(C,[isas],V) :- - fremove1(C,[isas],V), - fremove1(V,[examples,typ],C). -fremove0(C,[examples,T],V) :- concept(C),member(T,[typ,bnd]), - fremove1(C,[examples,T],V), - fremove(V,[isas],C). - -fremove0(C,S,V) :- fremove1(C,S,V). - -fremove1(Name,Slot,Item) :- frame(Name,Slot,Val), - remove(Item,Val,Newval), - update(Name,Slot,Newval). -fremove1(_,_,_). - -% remove the entire slot. -fremoveall(Name,Slot) :- retract(frame(Name,Slot,_)). -fremoveall(_,_). - -/* print all concept frames to current stream */ - -ppall :- - allconcepts(X), - member(A,X), - ppframe(A),nl, - fail. -ppall. - -/* print a frame and the values on its slots */ -ppframe(X) :- - mysetof((Y,Z),frame(X,Y,Z),L), - remove(([name],Names),L,L1), - write(X),write(': '),myprint(Names,_),nl, - ppframe1(L1),nl,!. - -ppframe1([(Slot,Vals)|R]) :- - tab(3), myprint(Slot,Len),write(':'), Col is 3 + Len, - ((Col < 25,tab(25 - Col)) - ;true), - tab(3), print(Vals), - nl,ppframe1(R). -ppframe1([]). - - -/* in addition to the worth of a concept, there is an apriori worth - * given to each operation and slot. - */ -worth(A,W) :- frame(A,[worth],[W]). -worth(Operation,300) :- member(Operation,[fillin,check,int,suggest]). -worth(Slot,300). - - -aminput(X):- write('>>'),ttyflush,myinput(X). - diff --git a/clock.pl b/clock.pl new file mode 100644 index 0000000..e0c659f --- /dev/null +++ b/clock.pl @@ -0,0 +1,17 @@ +:- public([clock/2]). + +clock(S,_) :- var(S), statistics(runtime,[S1,_]), + S is S1 / 100, !. +clock(S,T) :- var(T),nonvar(S), + statistics(runtime,[T1,_]), + T2 is T1 / 100, + T3 is (T2 - S), + ((T3 = 0, T = 1); + T = T3),!. + +/* this predicate is in this file because it does not seem to + compile properly. Clock must be interpreted as well. */ + +:- op(100,fx,c). +c(X) :- makename(X,'.pl',Y),compile(Y). + diff --git a/common.pl b/common.pl new file mode 100644 index 0000000..500a19a --- /dev/null +++ b/common.pl @@ -0,0 +1,326 @@ +:- public([ + times_up/2, collectclauses/3, makelist/2, + ok_a/2,termination_a/3,cleanup_a/2,addnum_a/1, + check_if_any_found/2,unifyinst/4, + + allconcepts/1,fillable_slots/1,examples/2,exs/2, + isas/2,genls/2,specs/2,ripple/3,collect/3, + genls_sf/2,specs_sf/2,ripple_sf/3,getarity/2, + get/3,concept/1,put/3,putvals/3,update/3,fremove/3, + fremoveall/2,ppframe/1,ppall/0,worth/2,aminput/1]). + +%Use examine/0 to browse the concept base +examine:- + write('EXAMINE which concept? (completion supported) '), + aminput(ConToken), + \+member(ConToken,['',q,quit,e,exit]), + name(ConToken,ConString), + frame(Name,_,_), name(Name,FrameString), + append(ConString,_,FrameString), % isa match? + ppframe(Name), + !, examine. + + +/*** times_up succeeds if the elapsed time exceeds the alloted time; +**** else fail. +***/ + +times_up(Alotment,Start):- clock(Start,T),T>Alotment. + +/*** collectclauses forms a list of all clauses with a given mainfunctor. +**** The only tricky part is forming a template which will match the +**** head of each of the clauses (this to satisfy the 'clause' predicate). +***/ + +collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), + bagof([Func,Body], clause(Func,Body), Clauses). +functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. + +/*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ + +makelist(0,[]). +makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). + + +/************************************************************* + * The following set of functions are used to control a + * heuristics which uses backtracking, and produces results + * through side_effects. + */ + +ok_a(Start,Allot) :- clock(Start,T), Allot > T. +ok_a(Start,Allot) :- clock(Start,T), Allot > T,ok_a(Start,Allot). + +makenumcall(H,Var,Call) :- makename(H,num,Funct), Call =.. [Funct,Var]. + +termination_a(H,_,_) :- makenumcall(H,Num,Call),Call,Num>24. +termination_a(_,S,T) :- times_up(S,T). + +cleanup_a(H,Num) :- makenumcall(H,Num,X),retract(X),!. +cleanup_a(_,0). + +addnum_a(H) :- makenumcall(H,Num,Term), retract(Term), + N is Num +1,makenumcall(H,N,New),asserta(New),!. +addnum_a(H) :- makenumcall(H,1,Term), + asserta(Term). + +check_if_any_found(H,C) :- makenumcall(H,Num,Call),Call,integer(Num), + Num > 0, + addtoagenda(check,C,[examples,typ],200,'have found some exs of C'). + +/******************** END OF SET **********************************/ + + +/****************************************************** + * unifyinst is the result of an inconsistency + * in our treatment of examples. The example of an + * object is different from an example of an activity. + * I.e. objects have an arity of 1, with NO dom/ran. + * So we have to unify them differently to get the + * appropriate call. + */ +unifyinst(1,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor,Ex],!. +unifyinst(_,Inst,Mainfunctor,Ex) :- Inst =.. [Mainfunctor|Ex]. + +makeinst(Defn,1,Ex,Call) :- Call =.. [Defn,Ex],!. +makeinst(Defn,_,Ex,Call) :- Call =.. [Defn|Ex]. + +%% End of COMMON STUFF %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +/* return all currently defined concepts */ +allconcepts(C) :- + setof(X,Y^frame(X,[name],Y),C). + +/* return all slots that AM has heuristics to fillin */ +fillable_slots(S) :- + S = [[defn],[examples],[genl],[spec],[alg],[dom_range], + [in_domain_of],[in_range_of],[isas]]. +/* collect X.examples since they may live on several sub-slots */ +examples(Con,L) :- + get(Con,[examples,bnd],L1), /* bound changed to bnd, KM 7/24 */ + get(Con,[examples,typ],L2), + append(L1,L2,L). + +/* collect all the examples of Con by collecting the examples + * of all the specs of Con + */ +exs(Con,Examples):- + specs_sf(Con,Specs), % spec*(X)=Specs + removedups(Specs,Specs1), + exs1(Specs1,Exs), % examples(Specs)=Exs + exs2(Exs,Examples),!. % spec*(Exs)=Examples + + +exs1([],[]). +exs1([H|T],L) :- examples(H,L1),exs1(T,L2), union(L1,L2,L). + +exs2([],[]). +exs2([H|T],L) :- ripple(down,H,L1),exs2(T,L2),union(L1,L2,L). + +/* collect the isas according to the formula: + * genl*(isa(genl*(X))) + */ +isas(Con,L1) :- genls_sf(Con,G), + collect([isas],G,Isas1), + removedups(Isas1,Isas2), + isas1(Isas2,L), + removedups(L,L1). + +isas1([],[]). +isas1([H|T],L) :- genls_sf(H,L1),isas1(T,L2),append(L1,L2,L). + +/* collect genls or specs of a concept X by rippling UP or Down in + * the hierarchy + * ripple(+direction,+concept,-list of concepts) + */ + +genls(Con,G) :- ripple(up,Con,G),!. + +specs(Con,S) :- ripple(down,Con,S),!. + +ripple(up,X,Genls) :- ripple1([genl],[X],G),Genls = [X|G]. +ripple(down,X,Specs) :- ripple1([spec],[X],G),Specs = [X|G]. +ripple(_,X,[X]). + +ripple1(_,[],[]):-!. +ripple1(Dir,X,G) :- adjacent_to(Dir,X,G1), + ripple1(Dir,G1,G2), + append(G1,G2,G). + +/* ripple_sf is a safe ripple, that can deal with loops in the tree + * similarly with genls_sf and specs_sf + */ +genls_sf(C,G) :- ripple_sf(up,C,G),!. +specs_sf(C,S) :- ripple_sf(down,C,S),!. + +ripple_sf(up,X,Genls) :- ripple_sf1([genl],[X],[X],G),Genls = [X|G], !. +ripple_sf(down,X,Specs) :- ripple_sf1([spec],[X],[X],G),Specs = [X|G], !. +ripple_sf(_,X,[X]). + +ripple_sf1(_,_,[],[]):-!. +ripple_sf1(Dir,Seen,Level,G) :- + adjacent_to(Dir,Level,Nextlevel), + setdif(Nextlevel,Seen,Neverseen), + append(Seen,Neverseen,Nowseen), + ripple_sf1(Dir,Nowseen,Neverseen,G1), + append(Neverseen,G1,G). + +adjacent_to(_,[],[]):-!. +adjacent_to(Dir,[H|T],G) :- get(H,Dir,G1), + adjacent_to(Dir,T,G2), + append(G1,G2,G). + +/* collect all the entries on Slot for each concept in List + * collect(+Slot,+List_of_cons,-List_of_vals) + */ +collect(_,[],[]):-!. +collect(Slot,[H|T],L) :- + get(H,Slot,L1), + collect(Slot,T,L2), + append(L1,L2,L). + +/* returns the arity of a concept definition */ +getarity(Con,Arity) :- + get(Con,[dom_range],[L|_]), length(L,Arity). +getarity(Con,Arity) :- get(Con,[defn,arity],[Arity]). + +concept(C) :- frame(C,_,_),!. + +get(Name,Slot,Value):- frame(Name,Slot,Value),!. +get(_,[worth],[0]). +get(_,[examples, dif],[0,0]). +get(_,_,[]). +% commented out because they don't work (in my opinion). +%get(Name,Slot,Value) :- nonvar(Value), !, +% get1(Name,Slot,Value). +%get1(Name,Slot,Value) :- frame(Name,Slot,X),!,X = Value. +%get1(Name,Slot,[]). +%to put a single element onto a slot + +% the first clause catches all changes to the concept base and displays them. +put(C,S,V):- + watch_mode_on, % if you want a trace, + print_put_trace(C,S,V). % ! This will fail and backtrack to the real put/3. +put(C,S,V) :- put1(C,S,V),!. + +/* This stuff is duplicated in am.pl so it will be interpreted because it + doesn't work if it's compiled. (another FEATURE of VAX/VMS QP) */ +print_put_trace(C,S,V):- + ancestors([G|_]), % find out who's calling put/3, + G=..[H|_], + writeln([' ',H,'is adding',V,to,the,S,slot,of,C,nl]), % show change, + !, fail. + +put1(C,[examples,dif],[N,T]) :- !,nonvar(N),nonvar(T), + ((retract(frame(C,[examples,dif],[N1,T1])), + N2 is N + N1, T2 is T + T1, + assertz(frame(C,[examples,dif],[N2,T2]))) + ; + (assertz(frame(C,[examples,dif],[N,T])))). +put1(C,[spec],V) :- + put2(C,[spec],V), + put2(V,[genl],C). +put1(C,[genl],V) :- + put2(C,[genl],V), + put2(V,[spec],C). +put1(C,[worth],W) :- + update(C,[worth],[W]). +put1(C,[dom_range],D_r) :- + put_d_r(C,D_r), + put2(C,[dom_range],D_r). +put1(C,[isas],V) :- + put2(C,[isas],V), + put2(V,[examples,typ],C). +put1(C,[examples,T],V) :- + concept(V), + member(T,[bnd,typ]), + put2(C,[examples,T],V), + put2(V,[isas],C). +put1(C,[conjecs],X) :- + put2(C,[conjecs],X), + put1(conjecs,[examples,typ],X). + +put1(C,S,V) :- put2(C,S,V). + +put2(Name,Slot,Item) :- frame(Name,Slot,Value), + member(Item,Value). +put2(Name,Slot,Item) :- retract(frame(Name,Slot,Value)), + assertz(frame(Name,Slot,[Item|Value])). +put2(Name,Slot,Item) :- assertz(frame(Name,Slot,[Item])). + +put_d_r(C,[R]) :- put(R,[in_range_of],C). +put_d_r(C,[D|R]) :- put(D,[in_domain_of],C),put_d_r(C,R). + +%to add several vals to a slot +putvals(_,_,[]). +putvals(C,S,[H|T]) :- + putvals(C,S,T), + put(C,S,H). + +%update - to replace oldvalue with newvalue +update(Name,Slot,Newval) :- retract(frame(Name,Slot,_)), + assertz(frame(Name,Slot,Newval)). +update(Name,Slot,Newval) :- assertz(frame(Name,Slot,Newval)). + +%fremove - remove item from values of slot. Fail if not present +fremove(C,S,V) :- fremove0(C,S,V),!. + +fremove0(C,[genl],V) :- + fremove1(C,[genl],V), + fremove1(V,[spec],C). +fremove0(C,[spec],V) :- + fremove1(C,[spec],V), + fremove1(V,[genl],C). +fremove0(C,[isas],V) :- + fremove1(C,[isas],V), + fremove1(V,[examples,typ],C). +fremove0(C,[examples,T],V) :- concept(C),member(T,[typ,bnd]), + fremove1(C,[examples,T],V), + fremove(V,[isas],C). + +fremove0(C,S,V) :- fremove1(C,S,V). + +fremove1(Name,Slot,Item) :- frame(Name,Slot,Val), + remove(Item,Val,Newval), + update(Name,Slot,Newval). +fremove1(_,_,_). + +% remove the entire slot. +fremoveall(Name,Slot) :- retract(frame(Name,Slot,_)). +fremoveall(_,_). + +/* print all concept frames to current stream */ + +ppall :- + allconcepts(X), + member(A,X), + ppframe(A),nl, + fail. +ppall. + +/* print a frame and the values on its slots */ +ppframe(X) :- + mysetof((Y,Z),frame(X,Y,Z),L), + remove(([name],Names),L,L1), + write(X),write(': '),myprint(Names,_),nl, + ppframe1(L1),nl,!. + +ppframe1([(Slot,Vals)|R]) :- + tab(3), myprint(Slot,Len),write(':'), Col is 3 + Len, + ((Col < 25,tab(25 - Col)) + ;true), + tab(3), print(Vals), + nl,ppframe1(R). +ppframe1([]). + + +/* in addition to the worth of a concept, there is an apriori worth + * given to each operation and slot. + */ +worth(A,W) :- frame(A,[worth],[W]). +worth(Operation,300) :- member(Operation,[fillin,check,int,suggest]). +worth(Slot,300). + + +aminput(X):- write('>>'),ttyflush,myinput(X). + diff --git a/concepts.pl b/concepts.pl index 4dcb5ee..07cf560 100644 --- a/concepts.pl +++ b/concepts.pl @@ -6,9 +6,7 @@ -mv LaPolla (marcos) */ -:- public frame/3. -:- dynamic frame/3. -?-no_style_check(all). +:- dynamic(frame/3). frame(anything,[name],[anything]). frame(anything,[spec],[any_concept,non_concept]). diff --git a/definitions.pl b/definitions.pl index 987fb85..5fcd1c3 100755 --- a/definitions.pl +++ b/definitions.pl @@ -1,4 +1,3 @@ - /* To make sure this list of dynamic definitions is complete: 1. Erase this list 2. Consult the buffer of definitions @@ -7,87 +6,87 @@ 5. Replace all occurrences of "]" with "." and presto! all your defn's are dynamic. -Todd */ -:-dynamic basecase/0. -:-dynamic notmember/2. -:-dynamic myvar/1. -:-dynamic makedif/2. -:-dynamic makedif1/3. -:-dynamic anything_defn/1. -:-dynamic any_concept_defn/1. -:-dynamic atom_defn/1. -:-dynamic object_equality_defn/2. -:-dynamic normalize/2. -:-dynamic asort/2. -:-dynamic ainsert/3. -:-dynamic delete_alg/3. -:-dynamic delete_defn/3. -:-dynamic member_alg/2. -:-dynamic member_defn/2. -:-dynamic set_member_defn/2. -:-dynamic set_member_alg/2. -:-dynamic length_defn/2. -:-dynamic length_alg/2. -:-dynamic set_defn/1. -:-dynamic set_alg/1. -:-dynamic insert_defn/3. -:-dynamic insert_defn2/3. -:-dynamic set_insert_defn/3. -:-dynamic set_insert_alg/3. -:-dynamic set_delete_defn/3. -:-dynamic set_equal_defn/2. -:-dynamic set_delete_alg/3. -:-dynamic bag_defn/1. -:-dynamic bag_alg/1. -:-dynamic bag_member_defn/2. -:-dynamic bag_insert_defn/3. -:-dynamic bag_equal_defn/2. -:-dynamic bag_delete_defn/3. -:-dynamic compose_defn/2. -:-dynamic getValues/4. -:-dynamic runF1values/2. -:-dynamic getDom/2. -:-dynamic struct_defn/1. -:-dynamic coalesce_defn/2. -:-dynamic compare_dR/2. -:-dynamic compare1_dR/2. -:-dynamic itdR/4. -:-dynamic equality_defn/2. -:-dynamic first_element_defn/2. -:-dynamic last_element_defn/2. -:-dynamic rest_defn/2. -:-dynamic bag_diff_defn/3. -:-dynamic bag_intersect_defn/3. -:-dynamic bag_union_defn/3. -:-dynamic constant_pred_defn/1. -:-dynamic check_true/1. -:-dynamic check_false/1. -:-dynamic constant_h_1/1. -:-dynamic constant_h_2/1. -:-dynamic constant_true_defn/1. -:-dynamic constant_false_defn/1. -:-dynamic difference_defn/3. -:-dynamic empty_struct_defn/1. -:-dynamic nonempty_struct_defn/1. -:-dynamic intersect_defn/3. -:-dynamic list_intersect_defn/3. -:-dynamic list_diff_defn/3. -:-dynamic list_delete_defn/3. -:-dynamic list_union_defn/3. -:-dynamic list_defn/1. -:-dynamic ordered_pairs_defn/1. -:-dynamic predicate_defn/1. -:-dynamic check_range/2. -:-dynamic list_insert_defn/3. -:-dynamic set_diff_defn/3. -:-dynamic oset_diff_defn/3. -:-dynamic oset_defn/1. -:-dynamic identity_defn/2. -:-dynamic object_defn/1. -:-dynamic reverse_ord_pair_defn/2. -:-dynamic invert_an_op_defn/2. -:-dynamic set_intersect_defn/3. -:-dynamic set_union_defn/3. -:-dynamic struct_of_struct_defn/1. +:- dynamic(basecase/0). +:- dynamic(notmember/2). +:- dynamic(myvar/1). +:- dynamic(makedif/2). +:- dynamic(makedif1/3). +:- dynamic(anything_defn/1). +:- dynamic(any_concept_defn/1). +:- dynamic(atom_defn/1). +:- dynamic(object_equality_defn/2). +:- dynamic(normalize/2). +:- dynamic(asort/2). +:- dynamic(ainsert/3). +:- dynamic(delete_alg/3). +:- dynamic(delete_defn/3). +:- dynamic(member_alg/2). +:- dynamic(member_defn/2). +:- dynamic(set_member_defn/2). +:- dynamic(set_member_alg/2). +:- dynamic(length_defn/2). +:- dynamic(length_alg/2). +:- dynamic(set_defn/1). +:- dynamic(set_alg/1). +:- dynamic(insert_defn/3). +:- dynamic(insert_defn2/3). +:- dynamic(set_insert_defn/3). +:- dynamic(set_insert_alg/3). +:- dynamic(set_delete_defn/3). +:- dynamic(set_equal_defn/2). +:- dynamic(set_delete_alg/3). +:- dynamic(bag_defn/1). +:- dynamic(bag_alg/1). +:- dynamic(bag_member_defn/2). +:- dynamic(bag_insert_defn/3). +:- dynamic(bag_equal_defn/2). +:- dynamic(bag_delete_defn/3). +:- dynamic(compose_defn/2). +:- dynamic(getValues/4). +:- dynamic(runF1values/2). +:- dynamic(getDom/2). +:- dynamic(struct_defn/1). +:- dynamic(coalesce_defn/2). +:- dynamic(compare_dR/2). +:- dynamic(compare1_dR/2). +:- dynamic(itdR/4). +:- dynamic(equality_defn/2). +:- dynamic(first_element_defn/2). +:- dynamic(last_element_defn/2). +:- dynamic(rest_defn/2). +:- dynamic(bag_diff_defn/3). +:- dynamic(bag_intersect_defn/3). +:- dynamic(bag_union_defn/3). +:- dynamic(constant_pred_defn/1). +:- dynamic(check_true/1). +:- dynamic(check_false/1). +:- dynamic(constant_h_1/1). +:- dynamic(constant_h_2/1). +:- dynamic(constant_true_defn/1). +:- dynamic(constant_false_defn/1). +:- dynamic(difference_defn/3). +:- dynamic(empty_struct_defn/1). +:- dynamic(nonempty_struct_defn/1). +:- dynamic(intersect_defn/3). +:- dynamic(list_intersect_defn/3). +:- dynamic(list_diff_defn/3). +:- dynamic(list_delete_defn/3). +:- dynamic(list_union_defn/3). +:- dynamic(list_defn/1). +:- dynamic(ordered_pairs_defn/1). +:- dynamic(predicate_defn/1). +:- dynamic(check_range/2). +:- dynamic(list_insert_defn/3). +:- dynamic(set_diff_defn/3). +:- dynamic(oset_diff_defn/3). +:- dynamic(oset_defn/1). +:- dynamic(identity_defn/2). +:- dynamic(object_defn/1). +:- dynamic(reverse_ord_pair_defn/2). +:- dynamic(invert_an_op_defn/2). +:- dynamic(set_intersect_defn/3). +:- dynamic(set_union_defn/3). +:- dynamic(struct_of_struct_defn/1). /* I am going to change all of these definitions into (Pure) Pure Prolog so that they will run backwards as well as forwards. This way I can easily diff --git a/descriptions.pl b/descriptions.pl index dc14fa3..d3013f2 100644 --- a/descriptions.pl +++ b/descriptions.pl @@ -15,8 +15,7 @@ descr(h12,'Fillin all blank facets -go get some coffee',adam). descr(h14,'After dealing with C, boost Cons that use C',adam). descr(h17,'C is interesting if C.conjecs has interesting entries',martin). -descr(h20,'C is interesting if its boundary corresponds another con', - martin). +descr(h20,'C is interesting if its boundary corresponds another con', martin). descr(h23,'C is interesting if it satisfies some rare predicate',martin). descr(h28, 'Same idea as 114',marcos). descr(h29,'Find exs of X by looking at exs of more gen cons',ken). @@ -25,8 +24,7 @@ descr(h34b,'Find exs of X by looking at ops whose domain is X',ken). descr(h36, 'h36',marcos). descr(h40,'Find exs of X by looking at first cousins of X',ken). -descr(h43,'If X and Y share many examples, then create their intersection', - adam). +descr(h43,'If X and Y share many examples, then create their intersection', adam). descr(h44,'If there are very few exs of C, then generalize it',adam). descr(h45,'If there are very many exs of C, then specialize it',adam). descr(h46,'If there are no exs of C, then find some',adam). @@ -40,10 +38,8 @@ descr(h89,'Generalize C by dropping conjuncts',bruce). descr(h92,'Specialize C by dropping disjuncts',bruce). descr(h110,'Make sure that no specs of S are the same',annanya). -descr(h111,'If a gen & spec of C have a common elem, they may be the same', - annanya). -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). +descr(h111,'If a gen & spec of C have a common elem, they may be the same', annanya). +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). descr(h114a, 'Same idea as 114 with a few mods',marcos). descr(h116,'Fillin in_dom_of by finding what can be run on C',annanya). descr(h117,'Fillin in_ran_of by finding ops that yield Cs',annanya). @@ -54,8 +50,7 @@ descr(h183,'Check that FoG is different than F or G',ray). descr(h199,'Coalesce C',annanya). descr(h204,'Creating f-itself',annanya). -descr(h240,'Find exs of mult elem by repeating elems of no-mult-elem', - annanya). +descr(h240,'Find exs of mult elem by repeating elems of no-mult-elem', annanya). descr(h300,'Generalize concept definition by generalizing a predicate',todd). descr(h301,'Specialize concept definition by specializing a predicate',kim). diff --git a/h/h123.pl b/h/h123.pl index 0a5b8dc..79cdf06 100644 --- a/h/h123.pl +++ b/h/h123.pl @@ -1,4 +1,4 @@ -:- public h123/1. +:- public(h123/1). /********************************************************************** * * h123 finds examples of active concept Con by collecting examples diff --git a/h/h17.pl b/h/h17.pl index 5ac09da..c993937 100644 --- a/h/h17.pl +++ b/h/h17.pl @@ -5,9 +5,10 @@ h17(Con) :- isas(Con, Con_set), - collect([conjectures,interest],Con_set,Conjecs_lst). - h17_int_conjecs(Conjecs_lst,[],Int_conjs). + collect([conjectures,interest],Con_set,Conjecs_lst), + h17_int_conjecs(Conjecs_lst,[],Int_conjs), non_null_list(Int_conjs). +/* akkartik: replaced periods with commas to respect indentation. */ /* The following takes a list of conjectures and adds those that are interesting to the list Oj, yielding the list, diff --git a/h/h174.pl b/h/h174.pl index e59047f..a2e3d54 100755 --- a/h/h174.pl +++ b/h/h174.pl @@ -1,5 +1,4 @@ -:-public h174/2. -?-no_style_check(all). +:-public(h174/2). /* h174 creates a new operation by composing two existing operations.In clausal form, the composition is expressed as fog(a,b,c,y):-g(a,b,c,x),f(x,y) which @@ -264,15 +263,13 @@ assert(gensymed_concepts(Newname,Alg,none)). check_with_user2(F,G,Newname,Alg,Newname2):- nl,nl, - write('I have created a new concept definition which is a composition of -'),nl, + write('I have created a new concept definition which is a composition of '),nl, write(F),write(' and '),write(G),nl, write('This concept is defined as follows:'),nl, write(Alg),nl, write('Do you want to keep this new concept (y/n)? '), nl,aminput('y'), - write('Please type new name for this concept or to keep the current - name: '), + write('Please type new name for this concept or to keep the current name: '), nl,aminput(X), ((X='',Newname2=Newname); (\+ X='',Newname2=X)). diff --git a/h/h180.pl b/h/h180.pl index b93b3c5..2f84011 100644 --- a/h/h180.pl +++ b/h/h180.pl @@ -1,4 +1,4 @@ -:-public h180/1. +:-public(h180/1). /* h180 finds examples of the composite operation f o g by using existing examples of f and g. First the examples of f and g are gathered. Then a diff --git a/h/h183.pl b/h/h183.pl index 35f71bd..071c39c 100644 --- a/h/h183.pl +++ b/h/h183.pl @@ -1,4 +1,4 @@ -:-public h183/1. +:-public(h183/1). /* h183 checks to see if f o g (or actually ANY concept) might be the same as another concept by comparing their examples. Neighboring concepts are diff --git a/h/h204.pl b/h/h204.pl index 43ad302..b1292e5 100644 --- a/h/h204.pl +++ b/h/h204.pl @@ -21,8 +21,7 @@ put(coalesce,[examples,typ],N), put(C,[spec],N), put(C,[coalesce],N), - addtoagenda(fillin,N,[examples,typ],200,'No examples of concept ex -ist'). + addtoagenda(fillin,N,[examples,typ],200,'No examples of concept exist'). h204assert(Name,Alg) :- Body =.. [Alg,X,X], diff --git a/h/h31.pl b/h/h31.pl index 8d5bfe6..638b603 100644 --- a/h/h31.pl +++ b/h/h31.pl @@ -1,4 +1,4 @@ -:- public h31/1. +:- public(h31/1). /*********************************************************** * h31 anyconcept.examples.fillin diff --git a/h/h407.pl b/h/h407.pl index 104936d..3f17b90 100644 --- a/h/h407.pl +++ b/h/h407.pl @@ -1,3 +1,4 @@ +:- public(h407/1). /* if a concept is worthwhile then compose it with itself; this is short of like Lenat's repetition heuristic. However, the only way that that @@ -9,21 +10,21 @@ Worth > 200, assert(flag), getarity(F,N1), N is N1 -1, - loop_composit(F,F,N,[],Glist,[],FoGdr,1), + loop_composit2(F,F,N,[],Glist,[],FoGdr,1), makename(F,'_o_',Temp), loopmakename(Temp,Glist,SeedName), loop_make_composit(F,SeedName,Glist,FoGdr,Newname,Algorogo,N,0),!, assert(flag), create_composite_concept2(F,Glist,Newname,Algorogo,FoGdr). -loop_composit(F,G,N,X,X,Y,Y,_):- +loop_composit2(F,G,N,X,X,Y,Y,_):- N = 0. -loop_composit(F,G,N,Glist,New_Glist,Old_FoGdr,New_FoGdr,It) :- +loop_composit2(F,G,N,Glist,New_Glist,Old_FoGdr,New_FoGdr,It) :- get(F,[dom_range],Fdr), get(F,[dom_range],Gdr), get_composite_dr(Fdr,Gdr,FoGdr,It), N1 is N - 1, It2 is It + 1, - loop_composit(F,F,N1,[G|Glist],New_Glist,[FoGdr|Old_FoGdr], + loop_composit2(F,F,N1,[G|Glist],New_Glist,[FoGdr|Old_FoGdr], New_FoGdr,It2). diff --git a/h/h6.pl b/h/h6.pl index f0fbc88..6e13f1e 100644 --- a/h/h6.pl +++ b/h/h6.pl @@ -9,9 +9,10 @@ * interesting if X.Conjecs contains some interesting entries" */ h6(X) :- - collect([conjectures,interest],[X],Conjecs_lst). - h6_int_conjecs(Conjecs_lst,[],Int_conjs). + collect([conjectures,interest],[X],Conjecs_lst), + h6_int_conjecs(Conjecs_lst,[],Int_conjs), non_null_list(Int_conjs). +/* akkartik: replaced periods with commas to respect indentation. */ /* The following takes a list of conjectures and adds those that are interesting to the list Oj, yielding the list, diff --git a/h/h89.pl b/h/h89.pl index 5657133..6527d22 100644 --- a/h/h89.pl +++ b/h/h89.pl @@ -1,7 +1,6 @@ %break% mutate.pl 527388122 409 20 100644 16899 ` -:-public h89/1, h92/1, h300/1, h301/1. -?-no_style_check(all). +:-public([h89/1, h92/1, h300/1, h301/1]). /**************************************************************************** * diff --git a/utilities.pl b/utilities.pl index 6264cea..c58e72d 100644 --- a/utilities.pl +++ b/utilities.pl @@ -1,26 +1,21 @@ -%break% utilities.pl 526014807 409 20 100644 14107 ` - -%contains old files: gutils,common(fnctions that were really common),newgut - - -:-public split/2,null/1,not_null_list/1,consp/1,cons/3,split_last/3, +:- public([ + split/2,null/1,not_null_list/1,consp/1,cons/3,split_last/3, firstn/3,reverse/2,removeall/3,remove/3, remove_or_die/3, removelast/2,nth/3,wrlist/1,myinput/1,list/1,flatten/2, lastof/2,append/3,concat/3,replace/4,assoclist/3,union/3, setdiff/3,intersection/3, - makeset/2,merge/3,setmember/2. + makeset/2,merge/3,setmember/2, -:-public member/2,seteq/2,delete/3,absval/2,mysetof/3,mybagof/3, - ucall/1,clock/2,gensym/2,myprint/2,pp/1,printstring/1, - printstrings/1,makename/3. + member/2,seteq/2,delete/3,absval/2,mysetof/3,mybagof/3, + /*ucall/1,*/clock/2,gensym/2,myprint/2,pp/1,printstring/1, + printstrings/1,makename/3, -:- public collectclauses/3, makelist/2, if/2, if/3. + collectclauses/3, makelist/2, if/2, if/3, -:- public explode/2,random/2,removedups/2,removetop/3,setdif/3, - apply/2,format/3,format/2,prompt_and_read/3,randomelement/2, - remove_random/2,randombreak/3,remove_nth/3. -?-no_style_check(all). + explode/2,random/2,removedups/2,removetop/3,setdif/3, + apply/2,format/3,format/2,prompt_and_read/3,randomelement/2, + remove_random/2,randombreak/3,remove_nth/3]). split(X,X). @@ -41,9 +36,9 @@ -reverse(L,L1):- reverse_concat(L,[],L1). -reverse_concat([X|L1],L2,L3):- reverse_concat(L1,[X|L2],L3). -reverse_concat([],L,L). +%? reverse(L,L1):- reverse_concat(L,[],L1). +%? reverse_concat([X|L1],L2,L3):- reverse_concat(L1,[X|L2],L3). +%? reverse_concat([],L,L). removeall(Set1,[],Set1). @@ -60,9 +55,9 @@ removelast([X],[]). removelast([X|Y],[X|Z]) :- removelast(Y,Z). -nth(L,P,V):- nth2(L,P,V,1). -nth2([H|T],N,H,N). -nth2([H|T],P,V,N):- \+P=N, N1 is N+1, nth2(T,P,V,N1). +%? nth(L,P,V):- nth2(L,P,V,1). +%? nth2([H|T],N,H,N). +%? nth2([H|T],P,V,N):- \+P=N, N1 is N+1, nth2(T,P,V,N1). %length([],0). %length([X|Y],N) :- length(Y,N1), N is N1 + 1. @@ -70,8 +65,8 @@ wrlist([]). wrlist([H|Rest]):- write(' '),write(H),nl,wrlist(Rest). -list([]). -list([_|_]). +%? list([]). +%? list([_|_]). flatten(Atom,Atom):- \+list(Atom). flatten(L,F):- list(L), flatten2(L,F),!. @@ -90,8 +85,8 @@ myread2([C|Prev],More),!. myread2(A,A):- !. -append([],L,L). -append([A|B], L2, [A|L3]):- append(B,L2,L3). +%? append([],L,L). +%? append([A|B], L2, [A|L3]):- append(B,L2,L3). concat([X|L1],L2,[X|L3]):- concat(L1,L2,L3). concat([],L,L). @@ -155,15 +150,15 @@ setmember(H,[H1|L]):-seteq(H,H1). setmember(H,[_|L]):-setmember(H,L). -member(X,[X|T]). -member(X,[_|T]):-member(X,T). +%? member(X,[X|T]). +%? member(X,[_|T]):-member(X,T). seteq([],[]). seteq([A|B],C):-delete(A,C,C1),seteq(B,C1). -delete(A,[A|B],B). -delete(A,[B|C],[B|C1]):-delete(A,C,C1). +%? delete(A,[A|B],B). +%? delete(A,[B|C],[B|C1]):-delete(A,C,C1). absval(N,N):- integer(N), \+N<0. absval(N,AbsN):- integer(N), N<0, AbsN is -1*N. @@ -209,8 +204,8 @@ /*** **** turn a list into a function call ***/ -:-op(100,fx,ucall). -ucall(X) :- Z =.. X ,Z. +%? :-op(100,fx,ucall). +%? ucall(X) :- Z =.. X ,Z. /* Create a new atom starting with a root provided and * finishing with a unique number. @@ -288,19 +283,19 @@ -/*** collectclauses forms a list of all clauses with a given mainfunctor. -**** The only tricky part is forming a template which will match the -**** head of each of the clauses (this to satisfy the 'clause' predicate). -***/ - -collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), - bagof([Func,Body], clause(Func,Body), Clauses). -functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. - -/*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ - -makelist(0,[]). -makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). +%? /*** collectclauses forms a list of all clauses with a given mainfunctor. +%? **** The only tricky part is forming a template which will match the +%? **** head of each of the clauses (this to satisfy the 'clause' predicate). +%? ***/ +%? +%? collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func), +%? bagof([Func,Body], clause(Func,Body), Clauses). +%? functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L]. +%? +%? /*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */ +%? +%? makelist(0,[]). +%? makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L). @@ -329,7 +324,7 @@ Newseed is (125 * S + 1) mod 4096, asserta(seed(Newseed)),!. -:- dynamic seed/1. +dynamic(seed/1). seed(13). /* remove duplicate entries from a list, maintaining original order */ @@ -475,8 +470,7 @@ test(X) :- X1 is X + 1, X2 is X + 2, X3 is X + 3, - amformat([],'~a testing foo ~n bar ~s - baz ~a testing ~a', [X1, X2, X3]), nl, + amformat([],'~a testing foo ~n bar ~s baz ~a testing ~a', [X1, X2, X3]), nl, amformat(foo,'/* foo written ~n this is formatprint */ ~l ',[formatprint]), amformat(t,'~n /* this is test */ ~n ~l ', [test]), told,