/********************************/ /* General Constraint Planner */ /* version 1.0.2 */ /* 9th December 1996 */ /* (c) Roman Bart‡k */ /********************************/ % implements planning algorithm for adding constraints into constraint network % consult Graphs.pr before % for usage look at read_me file :-op(800,xfx,@). add_cons(Cons):- set_mark, add_cons_list([Cons]). add_cons_list([C@P|RestCs]):- collect_vars(C,[],Vs), % najde promenne v podmince eval_vars(Vs,[],EVs), % ohodnoti promenne podle preferenci v grafu add_c(EVs,C,P,RestCs,NewCs), % prida podminku do grafu add_cons_list(NewCs). add_cons_list([]). add_c([V-free|RestVars],C,Pref,Cs,Cs):- is_function([C]), V\=(_-_), prepare_invars(RestVars,Pref,[],InVars,InStar,WalkPref,InGen), add_node(InStar,[],(WalkPref,InVars,[V],[C],(InGen,x))-Pref-f,ID), set_var(V,ID,WalkPref),!. add_c([EV|RestVars],C,Pref,OldCs,NewCs):- is_function([C]), EV=V-VC-VP, stronger(Pref,VP), (ex_c([C],Pref,V,VC,VP,RestVars,OldCs,NewCs) ; try_next_var(VP,RestVars,[C],Pref,[EV],OldCs,NewCs)),!. add_c(Vars,C,Pref,OldCs,NewCs):- % pridani jako testovaci/generativni bunka prepare_output(Vars,Pref,OutVs,Out,RestVs,RetestIn,OldCs,NewCs), diff_vars(RestVs,Pref,PrefVs,StrongerVs), prepare_invars(StrongerVs,Pref,[],InVs,In,Pref,InGen), find_out_test(Out,OutTest), (OutVs=[] -> Cont=(InVs,[C])-Pref-t ; Cont=(Pref,InVs,OutVs,[C],(InGen,OutTest))-Pref-g), add_node(In,Out,Cont,ID), set_vars(OutVs,ID,Pref), set_out_test(RetestIn), add_rest_in_vars(PrefVs,ID,Pref), c(ID,Tin,Tout,_), set_walkabout(Tout), set_in_gen(Tout),set_out_test(Tin), collapse_tests(ID),!. ex_c(C,Pref,V,VC,VP,RestVars,OldCs,NewCs):- prepare_invars(RestVars,Pref,[],InVars,InStar,WalkPref,InGen), find_cycles(VC,[],InStar,[]), % otestuj pritomnost cyklu remove_cell_var(VC,V,RetestIn,Out,OldCs,NewCs), find_out_test(Out,OutTest), add_node(InStar,Out,(WalkPref,InVars,[V],C,(InGen,OutTest))-Pref-f,ID), set_var(V,ID,WalkPref), set_in_gen(Out),set_out_test(RetestIn),set_out_test(InStar), set_walkabout(Out), collapse_tests(ID),!. try_next_var(VP,[EV|RestVars],C,Pref,AuxVs,OldCs,NewCs):- EV=V-VC-VP, ((append(AuxVs,RestVars,Vs),ex_c(C,Pref,V,VC,VP,Vs,OldCs,NewCs)) ; try_next_var(VP,RestVars,C,Pref,[EV|AuxVs],OldCs,NewCs)),!. prepare_output([V-VC-VP|R],Pref,[V|OutVs],Out,RestVs,Retest,OldCs,NewCs):- stronger(Pref,VP), dremove_cell_var(VC,V,Retest1,Out1,OldCs,AuxCs), prepare_output(R,Pref,OutVs,Out2,RestVs,Retest2,AuxCs,NewCs), add_list(Retest1,Retest2,Retest), add_list(Out1,Out2,Out),!. prepare_output([V-free|R],Pref,[V|OutVs],Out,RestVs,RetestIn,OldCs,NewCs):- prepare_output(R,Pref,OutVs,Out,RestVs,RetestIn,OldCs,NewCs),!. prepare_output(Rest,_,[],[],Rest,[],Cs,Cs). add_rest_in_vars([V|T],ID,Pref):- v(V,VC,VP), ((VC=ID ; is_in_var(V,ID)) -> true ; (add_in_var(V,VC,ID), traverse_same([VC],no_cell,Pref,ID))), add_rest_in_vars(T,ID,Pref). add_rest_in_vars([],_,_). traverse_same([H|T],Father,Pref,ID):- c(H,In,Out,Cont), find_pref(Cont,HPref,WalkPref), (stronger(WalkPref,Pref) -> true ; (HPref=Pref -> (Cont=_-gv -> true ; (switch_comm_vars(H,Father), join_nodes(ID,H,_,_,_), set_in_gen([ID]),set_out_test([ID]), (Cont=_-g -> true ; traverse_same(In,no_cell,Pref,ID)))) ; traverse_same(In,H,Pref,ID) )), traverse_same(T,Father,Pref,ID),!. traverse_same([],_,_,_). %% remove_cell_var odstrani bunku urcujici danou promennou %% pokud se ale jedna o bunku pridanou v poslednim pridavacim cyklu, tak neuspeje %% to je kvuli zabraneni cyklickemu pridavani/ubirani bunek remove_cell_var(ID,V,[],[ID|SelOut],Cs,Cs):- c(ID,In,Out,Cont), Cont=(WP,InVs,OutVs,Cnt,(WG,WT))-WP-g, % odstraneni prom. z generativni bunky del_mem(V,OutVs,NewOutVs), remove_in_var(Out,V,ID,SelOut,RestOut), (NewOutVs=[] -> NewCont=([V|InVs],Cnt)-WP-t % zmena na test ; (find_out_test(RestOut,NWT), ((is_function(Cnt),NewOutVs=[_]) -> NewCont=(WP,[V|InVs],NewOutVs,Cnt,(WG,NWT))-WP-f % zmena na funkcn’ ; NewCont=(WP,[V|InVs],NewOutVs,Cnt,(WG,NWT))-WP-g))), % zustava generativn’ retract(c(ID,In,_,Cont)), assert(c(ID,In,RestOut,NewCont)), set_in_gen(RestOut),set_out_test(In),!. remove_cell_var(ID,V,In,Out,OldCs,NewCs):- c(ID,In,Out,Cont), % odstraneni fcn’ bunky nebo promennŽ ((Cont=V-v;Cont=_-gv) -> NewCs=OldCs % volna promenna se vyradi ;(mark(Mk),Mk>ID,Cont=(_,_,[V],ExC,_)-ExP-f,append_cons(ExC,ExP,OldCs,NewCs))), del_node(ID,In,Out,Cont). %% dremove_cell_var odstrani bunku urcujici danou promennou dremove_cell_var(ID,V,In,Out,OldCs,NewCs):- remove_cell_var(ID,V,In,Out,OldCs,NewCs) ; (del_node(ID,In,Out,(_,_,[V],ExC,_)-ExP-f),append_cons(ExC,ExP,OldCs,NewCs)),!. %% ze seznamu bunek vybere ty, ktere maji danou promennou jako vstup a odpoji je %% od dane bunky (pokud to je jejich jedina spolecna promenna) %% vraci take seznam bunek, ktere zustaly k dane bunce pripojeny remove_in_var([H|T],V,ID,SelOut,RestOut):- find_comm_vars(ID,H,CommVs), (mem(V,CommVs) -> (CommVs=[V] -> (disconnect(ID,H), % jedina spolecna promenna SelOut=[H|SelAux],RestOut=RestAux) ; (SelOut=[H|SelAux],RestOut=[H|RestAux])) ; (SelOut=SelAux,RestOut=[H|RestAux])), remove_in_var(T,V,ID,SelAux,RestAux),!. remove_in_var([],V,ID,[],[]). prepare_invars([V-VC-VP|EVs],OldWP,OldIn,[V|Vs],Ns,WP,WT):- min_pref(VP,OldWP,NewWP), (is_in_gen(VC)->WT=g;WT=WT1), add_to_set(VC,OldIn,AuxIn), prepare_invars(EVs,NewWP,AuxIn,Vs,Ns,WP,WT1),!. prepare_invars([V-free|EVs],OldWP,OldIn,[V|Vs],Ns,free,WT):- add_node([],[],V-v,Nid), assert(v(V,Nid,free)), prepare_invars(EVs,free,[Nid|OldIn],Vs,Ns,free,WT),!. prepare_invars([],WP,In,[],In,WP,x). collapse_tests([ID|Rest]):- c(ID,In,Out,Cn), ((Cn=_-g;Cn=_-gv) -> join_test_pathes(ID) ; true), ((Cn=(_,_,_,_,(g,t))-_-f ; (nc(ID),(Cn=_-t;Cn=(_,_,_,_,(g,_))-_-g))) -> add_list(In,Rest,NewL) ; NewL=Rest), collapse_tests(NewL),!. collapse_tests([]):-!. collapse_tests(ID):- assert(nc(ID)), collapse_tests([ID]), retract(nc(ID)), retractall(cpd(_)). join_test_pathes(ID):- not cpd(ID), c(ID,In,Out,Cn), collect_tests(Out,[],Tests), Tests=[_,_|_], join_tests(Tests), assert(cpd(ID)),!. join_test_pathes(_). collect_tests([ID|Rest],Old,New):- c(ID,_,Out,Cn), ((Cn=_-P-t;Cn=_-P-g) -> (ins_test(P,ID,Old,Aux),L=Rest) ; (Aux=Old,(Cn=(_,_,_,_,(_,t))-_-f -> add_list(Out,Rest,L) ; L=Rest))), collect_tests(L,Aux,New). collect_tests([],Tests,Tests). ins_test(P,ID,OL,NL):- OL=[E1|R], E1=P1+ID1, (stronger(P,P1) -> (ins_test(P,ID,R,AL),NL=[E1|AL]) ; (ID1=ID,NL=OL)),!. ins_test(P,ID,L,[P+ID|L]). join_tests([T1|Rest]):- T1=P+ID, join_tests(Rest,P,ID). join_tests([]). join_tests([P+ID1|Rest],P,ID):- join_nodes(ID,ID1,_,_,_), % stejne silne testy se spojuji (tj. ID1 k ID) set_out_test([ID]), (retract(cpd(ID));true), join_tests(Rest,P,ID),!. join_tests([T1|Rest],P,ID):- T1=P1+ID1, % silnejsi test je predrazen slabsim ins_to_path(ID1,P,ID), % slabsi test se proto zaradi na cestu za silnejsi join_test_pathes(ID), join_tests([T1|Rest]). join_tests([],_,ID):- join_test_pathes(ID). ins_to_path(SID,P,ID):- find_next_test(SID,NID) -> (ins_to_path(NID,SID,P,ID) ; (is_test(SID),ins_node(ID,SID,NID), set_out_test([ID]))) ; (is_test(SID),connect(SID,ID),set_out_test([SID])),!. ins_to_path(IDu,IDd,P,ID):- c(IDu,_,Out,_-Pu-_), (stronger(Pu,P) -> ins_to_path(IDu,P,ID) ; (Pu=P,is_test(IDu), join_nodes(ID,IDu,_,_,_),set_out_test([ID]), (retract(cpd(ID));true))),!. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% procedury pro zjistovan’ vlastnost’ bunky/bunek %% vybrani bunek, jejichz vstupni promennŽ obsahuj’ danou promennou %% vraci seznam techto bunek+jeho podmozinu s bunkami, ktere nemaji s danou bunkou %% spolecne promenne find_out_star([H|T],V,ID,Cells,OutStar):- find_in_vars(H,InVs), (mem(V,InVs) -> (Cells=[H|AuxCells], find_comm_vars(ID,H,CommVs), (CommVs=[] -> OutStar=[H|AuxStar] ; OutStar=AuxStar)) ; (Cells=AuxCells,OutStar=AuxStar)), find_out_star(T,V,ID,AuxCells,AuxStar),!. find_out_star([],_,_,[],[]). %% zjisteni preference a pruchozi preference bunky find_pref(_-v,free,free). find_pref(_-P-gv,P,P). find_pref(_-P-t,P,P). find_pref((WP,_,_,_,_)-P-_,P,WP). %% zjisteni, zda nektera z bunek je generativni nebo ma generativni pod sebou find_in_gen([ID|T],InGen):- c(ID,In,Out,C), ((C=_-v;(C=(_,_,_,_,(x,_))-_-f)) -> find_in_gen(T,InGen) ; InGen=g). find_in_gen([],x). %% zjisteni, zda nektera z bunek je testovaci nebo ma testovaci nad sebou find_out_test([ID|T],OutTest):- c(ID,In,Out,C), ((C=_-v;(C=(_,_,_,_,(_,x))-_-f)) -> find_out_test(T,OutTest) ; OutTest=t). find_out_test([],x). %% nalezen’ vstupn’ch promennych danŽ bunky find_in_vars(ID,Vs):- c(ID,_,_,Cont), (Cont=(Vs,_)-_-t ; Cont=(_,Vs,_,_,_)-_-_),!. %% nalezen’ vystupn’ch promennych danŽ bunky find_out_vars(ID,Vs):- c(ID,_,_,Cont), (((Cont=V-v;Cont=V-_-gv),Vs=[V]) ; (Cont=_-t,Vs=[]) ; Cont=(_,_,Vs,_,_)-_-_),!. %% nalezeni spolecnych promennych danych bunek %% tj. prunik vystupu prvni bunky se vstupem druhe find_comm_vars(IDb,IDt,CommVs):- find_out_vars(IDb,OutVs), find_in_vars(IDt,InVars), minus(OutVs,InVs,_,CommVs),!. %% zjisteni, zda dana promenna je vstupni promennou dane bunky is_in_var(V,ID):- find_in_vars(ID,InVars), mem(V,InVars),!. %% zjisteni, zda dana bunka je generativn’ nebo ma generativn’ pod sebou is_in_gen(ID):- c(ID,_,_,C), (C=_-t ; C=_-g ; C=_-gv ; C=(_,_,_,_,(g,_))-_-f),!. %% zjisteni, zda dana bunka je testovaci nebo ma testovaci nad sebou is_out_test(ID):- c(ID,_,_,C), (C=_-t ; C=_-g ; C=_-gv ; C=(_,_,_,_,(_,t))-_-f),!. %% zjisteni, zda bunka je testovaci is_test(ID):- c(ID,_,_,C), (C=_-t ; C=_-g ; C=_-gv),!. %% nalezen’ dalsi testovaci bunky nebo bunky, kter‡ m‡ test nad sebou find_next_test(ID,TestID):- c(ID,_,Out,_), select_next_test(Out,TestID). select_next_test([H|T],TestID):- is_out_test(H) -> TestID=H ; select_next_test(T,TestID). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% procedury pro nastaven’ vlastnost’ bunky/bunek %% nastaven’ pruchoz’ preference u danych bunek (a jejich n‡sledn’ku) set_walkabout([ID|T]):- c(ID,In,Out,Cnt-Pr-Tp), (Tp=t -> NT=T % u testu se nenastavuje pruchoz’ preference ; (Cnt=(WP,I,O,C,GT),calc_walkabout(I,Pr,NewWP), (WP=NewWP -> NT=T ; (retract(c(ID,In,Out,_)), add_list(Out,T,NT), set_vars(O,ID,NewWP), assert(c(ID,In,Out,(NewWP,I,O,C,GT)-Pr-Tp)))))), set_walkabout(NT),!. set_walkabout([]). %% vypocet pruchoz’ preference jako minima preferenci danych promennych calc_walkabout([V|T],Old,New):- v(V,_,P), min_pref(P,Old,Aux), calc_walkabout(T,Aux,New). calc_walkabout([],P,P). %% nastaveni indik‡toru generatoru na vstupu u danych bunek (a jejich n‡sledn’ku) set_in_gen([ID|T]):- Cl=c(ID,In,Out,C), Cl, ((C=_-v;C=_-gv;C=_-t) -> NewT=T % u tohoto typu bunek se InGen nenastavuje ; (find_in_gen(In,InGen), C=(WP,InV,OutV,Cnt,(G,Ts))-P-Tp, (InGen=G -> NewT=T ; (retract(Cl), assert(c(ID,In,Out,(WP,InV,OutV,Cnt,(InGen,Ts))-P-Tp)), add_list(Out,T,NewT))))), set_in_gen(NewT). set_in_gen([]). %% nastaven’ indik‡toru testu na vystupu u danych bunek (a jejich predchudcu) set_out_test([ID|T]):- Cl=c(ID,In,Out,C), Cl, ((C=_-v;C=_-gv;C=_-t) -> NewT=T % u tohoto typu bunek se OutTest nenastavuje ; (find_out_test(Out,OutTest), C=(WP,InV,OutV,Cnt,(G,Ts))-P-Tp, (OutTest=Ts -> NewT=T ; (retract(Cl), assert(c(ID,In,Out,(WP,InV,OutV,Cnt,(G,OutTest))-P-Tp)), add_list(In,T,NewT))))), set_out_test(NewT). set_out_test([]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% procedury pro praci s promennymi v ramci bunky %% dane testovaci nebo generativni bunce prida novou vstupn’ promennou %% a spoji tuto bunku s bunkou, ktera promennou urcuje add_in_var(V,OutID,InID):- retract(c(InID,In,Out,Cnt)), (Cnt=(Vs,C)-P-t -> NCnt=([V|Vs],C)-P-t ; (Cnt=(WP,Vs,OutVs,C,(Gen,Tst))-P-g, (is_in_gen(OutID) -> NGen=g ; NGen=Gen), NCnt=(WP,[V|Vs],OutVs,C,(NGen,Tst))-P-g)), assert(c(InID,In,Out,NCnt)), connect(OutID,InID), set_out_test([OutID]),!. %% prehodi spolecne promenne z vystupu prvni bunky na nove generativn’ bunky, switch_comm_vars(_,no_cell):-!. switch_comm_vars(BID,TID):- find_comm_vars(BID,TID,CommVars), disconnect(BID,TID), retract(c(BID,In,Out,(P,InVs,OutVs,C,(InGen,OutTest))-P-_)), minus(OutVs,CommVars,NewOutVs,_), add_list(CommVars,InVs,NewInVs), (NewOutVs=[] -> NewCnt=(NewInVs,C)-P-t % vznikne testov. bunka ; (((NewOutVs=[_],is_function(C)) -> Type=f % vznikne funkcni bunka ; Type=g), % vznikne gener. bunka NewCnt=(P,NewInVs,NewOutVs,C,(InGen,OutTest))-P-Type)), assert(c(BID,In,Out,NewCnt)), reconnect_vars(CommVars,[TID|Out],BID,P),!. %% prerad’ promennŽ do novych bunek typu generativn’ promenn‡ reconnect_vars([V|T],Cells,ID,P):- find_out_star(Cells,V,ID,GOut,OutStar), disconnect_out_star(OutStar,ID), add_node([],[ID|GOut],V-P-gv,GID), set_var(V,GID,P), set_in_gen(GOut), reconnect_vars(T,Cells,ID,P). reconnect_vars([],_,ID,_):- set_out_test([ID]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% procedury pro pr‡ci s promennymi %% ohodnoceni promennych pruchozi preferenci bunky, ktera je urcuje %% bunky jsou vraceny v neklesajicim poradi eval_vars([V|Vs],Old,EVs):- (v(V,VC,VP) -> EV=(V-VC-VP) ; EV=(V-free)), ins_var(EV,Old,Aux), eval_vars(Vs,Aux,EVs),!. eval_vars([],Vs,Vs). %% rozdelen’ seznamu promennych na promennŽ s danou preferenc’ a silnejs’ promennŽ %% seznam promennych mus’ byt neklesaj’c’ diff_vars([V-VC-Pref|R],Pref,[V|Vs],StrongerVs):- diff_vars(R,Pref,Vs,StrongerVs),!. diff_vars(StrongerVs,_,[],StrongerVs). %%%%% pomocnŽ procedury %%%%%%%%% set_mark:- cn(N), (retract(mark(_)) ; true), assert(mark(N)),!. lab([required,strong,prefer,weak,weakest]). labels(L):- retract(lab(_)), assert(lab(L)). stronger(X,free):-!,X\=free. stronger(L1,L2):- lab(Ls), stronger(L1,L2,Ls). stronger(L1,L2,[L1|T]):-!,L1\=L2. stronger(L1,L2,[L2|T]):-!,fail. stronger(L1,L2,[_|T]):-stronger(L1,L2,T). min_pref(P1,P2,P):- stronger(P1,P2) -> P=P2 ; P=P1. max_pref(P1,P2,P):- stronger(P1,P2) -> P=P1 ; P=P2. collect_vars(Expr,OldVars,NewVars):- compound(Expr), Expr=..[_|Args], collect_list_vars(Args,OldVars,NewVars). collect_vars(Var,OldVars,NewVars):- atom(Var), add_to_set(Var,OldVars,NewVars). collect_vars(Number,Vars,Vars):- number(Number). collect_list_vars([H|T],OldVars,NewVars):- collect_vars(H,OldVars,SVars), collect_list_vars(T,SVars,NewVars). collect_list_vars([],Vars,Vars). add_list([H|T],L,NL):- add_to_set(H,L,SL), add_list(T,SL,NL). add_list([],L,L). ins_var(EV,[EV1|Old],[EV1|New]):- EV=V-VC-VP, (EV1=_-_-VP1 -> stronger(VP,VP1) ; EV1=_-free), ins_var(EV,Old,New),!. ins_var(EV,Old,[EV|Old]). ins_const(C,P,[EC1|Old],[EC1|New]):- EC1=_@P1, stronger(P1,P), ins_const(C,P,Old,New),!. ins_const(C,P,Old,[C@P|Old]). append_cons([C|T],P,Old,New):- ins_const(C,P,Old,Aux), append_cons(T,P,Aux,New),!. append_cons([],_,Cs,Cs):-!. append_cons(C,P,Old,New):- ins_const(C,P,Old,New). set_var(V,ID,WalkPref):- (retract(v(V,_,_)) ; true), assert(v(V,ID,WalkPref)),!. set_vars([V|T],ID,Pref):- set_var(V,ID,Pref), set_vars(T,ID,Pref). set_vars([],_,_). append([H|T],L,[H|NT]):- append(T,L,NT). append([],L,L). %% dotaz zda dany seznam podminek je funkcn’ podm’nka is_function([f(_)]). is_function([_=_]). %% vypocet rozd’lu a pruniku mnozin minus([M|A],B,RestA,Comm):- (mem(M,B) -> (RestA=Rest,Comm=[M|Aux]) ; (RestA=[M|Rest],Comm=Aux)), minus(A,B,Rest,Aux),!. minus([],B,[],[]). %% spojen’ obsahu bunek, vznikaji testovac’ nebo generativn’ bunky join_conts((V1,Cn1)-P-t, (V2,Cn2)-P-t, (V,Cn)-P-t):- add_list(V1,V2,V), append(Cn1,Cn2,Cn),!. join_conts((P,In1,Out1,Cn1,(G1,T1))-P-_, (P,In2,Out2,Cn2,(G2,T2))-P-_, (P,In,Out,Cn,(G,T))-P-g):- append(Cn1,Cn2,Cn), add_list(In1,In2,AuxIn),add_list(Out1,Out2,Out), minus(AuxIn,Out,In,_), ((G1=g;G2=g) -> G=g ; G=x), ((T1=t;T2=t) -> T=t ; T=x),!. join_conts((P,In1,Out,Cn1,(G,T))-P-_, (V2,Cn2)-P-t, (P,In,Out,Cn,(G,T))-P-g):- add_list(In1,V2,AuxIn), minus(AuxIn,Out,In,_), append(Cn1,Cn2,Cn). join_conts((V2,Cn2)-P-t, (P,In1,Out,Cn1,(G,T))-P-_, (P,In,Out,Cn,(G,T))-P-g):- add_list(In1,V2,AuxIn), minus(AuxIn,Out,In,_), append(Cn1,Cn2,Cn).