API
Wersja główna
Predykaty pomocnicze
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).
Predykaty związane z nadawaniem id
:- dynamic current_id/2.
current_id(*,0).
create_id(X,ID):-
current_id(X,N),
N1 is N + 1,
retractall(current_id(X,_)),
assert(current_id(X,N1)),
string_concat(X,'_',ID1),
string_concat(ID1,N1,ID2),
string_to_atom(ID2,ID).
create_id(X,ID):-
assert(current_id(X,0)),
string_concat(X,'_',ID1),
string_concat(ID1,0,ID2),
string_to_atom(ID2,ID).
Predykaty związane z przeszukiwaniem oraz budowaniem struktury prologowej xml
check_need_build(X,_,_,_,_,_):-
X == 0,!.
check_need_build(X,P,P1,P2,L,W):-
X == 1,
W == 1,
retract(pair(element(P,P1,P2),Z,Z1)),
assert(pair(element(P,P1,L),Z,Z1)),
retractall(element(_,_,_)),
maxo(I),
build1(I),
retractall(pair(_,_,_)),
retractall(need_build(_)).
check_need_build(X,P,P1,P2,L,W):-
X == 1,
W == 2,
retract(pair(element(P,P1,L),Z,Z1)),
assert(pair(element(P,P2,L),Z,Z1)),
retractall(element(_,_,_)),
maxo(I),
build1(I),
retractall(pair(_,_,_)),
retractall(need_build(_)).
search(N,LA,LN,_,P_id):-
element(N,LA,LN),
%bagof(N,element(N,LA,LN),_),
belongs(P_id,LA).
search(N,LA,LN,P1,P_id):-
element(X,X1,L),
X\=N,
member3(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,pair(_,_,X),L),
max(L,0,X).
check_pair(X,Y,N,L):-
pair(_,element(X,Y,_),Q),
Q \= 1,
retract(pair(element(X,Y,_),element(R,R1,R2),R4)),
assert(pair(element(X,Y,N),element(R,R1,R2),R4)),
Ln is L-1,
build(Ln).
check_pair(X,Y,_,L):-
pair(_,element(X,Y,_),Q),
Q == 1,
Ln is L-1,
build(Ln).
check_id2(X,Y,A,B,C,_,_,_,W,W1,W2,L):-
X == Y,
add(element(A,B,C),W2,New),
assert(element(W,W1,New)),
retract(element(W,W1,W2)),
check_pair(W,W1,New,L).
check_id2(X,Y,A,B,C,A1,B1,C1,W,W1,W2,L):-
X \= Y,
add(element(A,B,C),C1,New),
assert(element(A1,B1,New)),
retract(element(W,W1,W2)),
check_pair(A1,B1,New,L).
check_id1(X,Y,_,_,_,_,A1,B1,C1,W,W1,W2,L):-
X == Y,
add(element(W,W1,W2),C1,NL),
assert(element(A1,B1,NL)),
retract(element(W,W1,W2)),
Ln is L-1,
build(Ln).
check_id1(X,Y,Z,A,B,C,A1,B1,C1,W,W1,W2,L):-
X \= Y,
check_id2(X,Z,A,B,C,A1,B1,C1,W,W1,W2,L).
build(0):-!.
build(L):-
pair(element(A,B,C),element(A1,B1,C1),L),
element(W,W1,W2),
first(ID1,W1),
first(ID2,B1),
first(ID3,B),
check_id1(ID1,ID3,ID2,A,B,C,A1,B1,C1,W,W1,W2,L).
build1(X):-
assert(element(*,[id=0],[])),
build(X).
member3(_,L,_,P,P3):-L == [],P3 is P,!.
member3(D,L,O,P,P3):-
L\=[],
belongs(D,L),
assert(D),
assert(pair(D,O,P)),
P2 is P + 1,
remove(D,L,Ln),
retractall(need_build(_)),
assert(need_build(1)),
first(E,Ln),
member3(E,Ln,O,P2,P3).
Predykaty główne
% tworzenie korzenia dokumentu
create_root(Name,ID_name):-
create_id(ID_name,ID),
assert(element(Name,[id=ID],[])).
% dodawanie dzieci do wybranego rodzica o wybranym id
app_child(Parent,P_id,Child,ChildIdName):-
Parent\=Child,
assert(need_build(0)),
search(Parent,A,L,1,P_id),
create_id(ChildIdName,ID),
add2end(element(Child,[id=ID],[]),L,L1),
retract(element(Parent,A,L)),
assert(element(Parent,A,L1)),
need_build(Q),
check_need_build(Q,Parent,A,L,L1,1).
% dodawanie dzieci do wybranego rodzica o wybranym id - wersja z mozliwym
% okresleniem ilosci dodawanych dzieci
app_child(_,_,_,_,0).
app_child(Parent,P_id,Child,ChildIdName,How_much):-
How_much > 0,
app_child(Parent,P_id,Child,ChildIdName),
New is How_much - 1,
app_child(Parent,P_id,Child,ChildIdName,New).
% dodawanie atrybutu do elementu o zadanym id
add_attribute(Parent,P_id,Attr):-
assert(need_build(0)),
search(Parent,AttL,L,1,P_id),
add2end(Attr,AttL,A1),
retract(element(Parent,AttL,L)),
assert(element(Parent,A1,L)),
need_build(Q),
check_need_build(Q,Parent,AttL,A1,L,2).
Predykaty do zapisu, tworzenia pliku xml
% 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).
Wersja poprzednia - płaska struktura
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).