AIwiki

delete(A, [A|B], B).
delete(B, [A|C], [A|D]) :-
        delete(B, C, D).
 
add(A, B, [A|B]).
 
 
make_node(Name,List) :-
        add(element(Name, [], []), [], List),
        X=..List,
        assert(X),
        write(List).
 
make_node(Name, Attr, Cont, List) :-
        add(element(Name, Attr, Cont), [], List),
        X=..List,
        assert(X),
        write(List).
 
add_child(Parent,Child,Nlist):-
	element(Parent,A,C),
	retract(element(Parent,A,C)),
	add(element(Child,[],[]),C,L),
	make_node(Parent,A,L,Nlist).
 
add_child(Parent,Child,Ch_att,Ch_cont,Nlist):-
	element(Parent,A,C),
	retract(element(Parent,A,C)),
	add(element(Child,Ch_att,Ch_cont),C,L),
	make_node(Parent,A,L,Nlist).
 
make_list(List) :-
	bagof(A,element(A,B,C),A),
	L=..A,
	add(element(L,B,C),[],List),
	write(List).
 
save :-
	tell('wiedza.pl'),
	listing(element),
	told.
 
prolog2xml(List,File):-
	tell(File),
	open(File,write,S),
	xml_write(S,List,[]),
	told,
	close(S).
 
----------------------------------
 
add_child(Parent,Child,Nlist):-
	element(Parent,A,C),
	element(Child,Chatt,Chcont),
	retract(element(Parent,A,C)),
	retract(element(Child,Chatt,Chcont)),
	add(element(Child,Chatt,Chcont),C,L),
	make_node(Parent,A,L,Nlist).
 
add_child(Parent,A,Child,Chatt,Nlist):-
	element(Parent,A,C),
	element(Child,Chatt,Chcont),
	retract(element(Parent,A,C)),
	retract(element(Child,Chatt,Chcont)),
	add(element(Child,Chatt,Chcont),C,L),
	make_node(Parent,A,L,Nlist).

add(A, B, [A|B]).
 
add2end(X,[H|T],[H|NewT]):-add2end(X,T,NewT).
add2end(X,[],[X]).
 
append([], A, A).
append([A|B], C, [A|D]) :-
        append(B, C, D).
 
remove(A, [A|B], B).
remove(B, [A|C], [A|D]) :-
        remove(B, C, D).
 
belongs(*,[]).
belongs(X,[X|_]).
belongs(X,[_|Yogon]) :-
	belongs(X,Yogon).
 
first(_,L):- 
	L == [],!. 
first(E,L) :-
	L \= [],
	append([],[E|_],L).
 
max([], A, A).
max([H|T], A, M) :- 
	H > A, 
	max(T, H, M).
max([H|T], A, M) :- 
	H =< A, 
	max(T, A, M).

:- dynamic current_id/2.
 
current_id(hml,0).
current_id(type_set,0).
current_id(property_set,0).
current_id(property,0).
current_id(attref,0).
current_id(attribute_set,0).
current_id(att,0).
current_id(tph,0).
current_id(trans,0).
current_id(ard,0).
current_id(dep,0).
 
id(hml,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['h','m','l','_'|N]),
	string_to_atom(Ids,Id).
 
id(type_set,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['t','y','p','_','s','_'|N]),
	string_to_atom(Ids,Id).
 
id(property_set,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['p','r','p','_','s','_'|N]),
	string_to_atom(Ids,Id).
 
id(property,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['p','r','p','_'|N]),
	string_to_atom(Ids,Id).
 
id(attref,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['a','t','t','_','r','_'|N]),
	string_to_atom(Ids,Id).
 
id(attribute_set,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['a','t','t','_','s','_'|N]),
	string_to_atom(Ids,Id).
 
id(att,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['a','t','t','_'|N]),
	string_to_atom(Ids,Id).
 
id(tph,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['t','p','h','_'|N]),
	string_to_atom(Ids,Id).
 
id(trans,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['t','r','n','_'|N]),
	string_to_atom(Ids,Id).
 
id(ard,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['a','r','d','_'|N]),
	string_to_atom(Ids,Id).
 
id(dep,X,Id):-
	number_chars(X,N),
	string_to_list(Ids,['d','e','p','_'|N]),
	string_to_atom(Ids,Id).

search(N,LA,LN,_,P_id):-
	bagof(N,element(N,LA,LN),_),
	belongs(P_id,LA).
 
search(N,LA,LN,P1,P_id):-
	element(X,X1,L),
	X\=N,
	member2(element(_,_,_),L,element(X,X1,[]),P1,P2),!,
	Pn is P2,
	retract(element(X,X1,L)),
	assert(element(X,X1,[])),
	search(N,LA,LN,Pn,P_id).
 
maxo(X):-
	findall(X,wezel(_,_,X),L),
	max(L,0,X).
 
what(X,Y,Q):-wezel(_,element(X,Y,_),Q).
 
build(0):-!.	
build(L):-
	wezel(element(A,B,C),element(A1,B1,C1),L),
	element(W,W1,W2),
	first(ID1,W1),
	first(ID2,B1),
	( W == A
	-> 
	   add(element(W,W1,W2),C1,NL),
	   assert(element(A1,B1,NL)),
	   retract(element(W,W1,W2)),
	   Ln is L-1,
	   build(Ln) 
	;  
		%zgadza sie nazwa
		( W == A1
	   	->     % zgadza sie id
                       ( ID1 == ID2
			->
		     		add(element(A,B,C),W2,New),
		     		assert(element(W,W1,New)),
	   	     		retract(element(W,W1,W2)),
		     		what(W,W1,Q),
		     		%jesli nie nalezy do root
		     		( Q \= 1
		     		-> 	retract(wezel(element(W,W1,_),element(R,R1,R2),R4)),
		        	   	assert(wezel(element(W,W1,New),element(R,R1,R2),R4)),
	   	        		Ln is L-1,
	              		        build(Ln)
		     		;  	Ln is L-1,
	              		        build(Ln)
		     		)
			;	
				add(element(A,B,C),C1,New),
		     		assert(element(A1,B1,New)),
	   	     		retract(element(W,W1,W2)),
		     		what(A1,B1,Q),
		     		%jesli nie nalezy do root
		     		( Q \= 1
		     		-> 	retract(wezel(element(A1,B1,_),element(R,R1,R2),R4)),
		        		assert(wezel(element(A1,B1,New),element(R,R1,R2),R4)),
	   	        		Ln is L-1,
	              		        build(Ln)
		     		;  	Ln is L-1,
	              		        build(Ln)
		     		)
			)
		; 
		     add(element(A,B,C),C1,New),
		     assert(element(A1,B1,New)),
	   	     retract(element(W,W1,W2)),
		     what(A1,B1,Q),
		     %jesli nie nalezy do root
		     ( Q \= 1
		     ->      retract(wezel(element(A1,B1,_),element(R,R1,R2),R4)),
		             assert(wezel(element(A1,B1,New),element(R,R1,R2),R4)),
	   	             Ln is L-1,
	                     build(Ln)
		     ;       Ln is L-1,
	                     build(Ln)
		     )
		)
	). 
 
build1(X):-
	assert(element(*,[id=0],[])),
	build(X).
 
 
member2(D,L,O,P,P3):-
	L\=[],
	P > 0,
	belongs(D,L),
	assert(D),
	assert(wezel(D,O,P)),
	P2 is P + 1,
	remove(D,L,Ln),
	retractall(bylem(_)),
	assert(bylem(1)),
	( Ln ==[]
	-> P3 is P2,true
	; first(E,Ln),
	  member2(E,Ln,O,P2,P3)
	 ).

% tworzenie korzenia dokumentu
create_root(Name):-
	current_id(Name,N),
	id(Name,N,ID),
	Nn is N + 1,
	assert(element(Name,[id=ID],[])),
	assert(current_id(Name,Nn)),
	retract(current_id(Name,N)).
 
% dodawanie dzieci do wybranego rodzica o wybranym id
app_child(Parent,P_id, Child):-
	Parent\=Child,
	assert(bylem(0)),
	search(Parent,A,L,1,P_id),
	current_id(Child,CI),
	id(Child,CI,ID),
	CIn is CI + 1,
	add2end(element(Child,[id=ID],[]),L,L1),
	retract(element(Parent,A,L)),
	assert(element(Parent,A,L1)),
	bylem(Q),
	( Q==1
	-> retract(wezel(element(Parent,A,L),Z,P)),
	   assert(wezel(element(Parent,A,L1),Z,P)),
	   retractall(element(_,_,_)),
	   maxo(I),
	   build1(I),
	   retractall(wezel(_,_,_)),
	   retractall(bylem(_))
	;  !
	),
	retract(current_id(Child,CI)),
	assert(current_id(Child,CIn)).
 
% dodawanie dzieci do wybranego rodzica o wybranym id - wersja z mozliwym 
% okresleniem ilosci dodawanych dzieci
app_child(Parent,P_id, Child,0):-true.
app_child(Parent,P_id, Child,How_much):-
	How_much > 0,
	app_child(Parent,P_id, Child),
	New is How_much - 1,
	app_child(Parent,P_id, Child,New).	 
 
% dodawanie atrybutu do elementu o zadanym id
add_attribute(Parent,P_id,Attr):-
	assert(bylem(0)),
	search(Parent,AttL,L,1,P_id),
	add2end(Attr,AttL,A1),
	retract(element(Parent,AttL,L)),
	assert(element(Parent,A1,L)),
	bylem(Q),
	( Q==1
	-> retract(wezel(element(Parent,AttL,L),Z,P)),
	   assert(wezel(element(Parent,A1,L),Z,P)),
	   retractall(element(_,_,_)),
	   maxo(I),
	   build1(I),
	   retractall(wezel(_,_,_)),
	   retractall(bylem(_))
	;
	   true
	).

% tworzenie listy potrzebnej do zapisu do pliku xml
make_list(List) :-
	bagof(A,element(A,B,C),A),
	L=..A,
	add(element(L,B,C),[],List).
 
% zapisywanie bazy wiedzy - struktury xml oraz stanu id
zapisz(File) :-
	tell(File),
	listing(element),
	listing(current_id),
	told.
 
% tworzenie pliku xml
prolog2xml(File):-
	make_list(List),
	tell(File),
	open(File,write,S),
	xml_write(S,List,[]),
	told,
	close(S).