Różnice

Różnice między wybraną wersją a wersją aktualną.

Odnośnik do tego porównania

Nowa wersja
Poprzednia wersja
pl:miw:miw08_prolog_xml:prolog_api [2008/04/28 18:11]
miw utworzono
pl:miw:miw08_prolog_xml:prolog_api [2019/06/27 15:50] (aktualna)
Linia 1: Linia 1:
 ===== API ===== ===== API =====
 +
 +Plik API do pobrania tutaj:
 +{{:​pl:​miw:​miw08_prolog_xml:​xml_api.pl|plik xml_api.pl}}
 +
 +
 +
 +
 +===== Wersja główna =====
 +
 +
 +
 +==== Predykaty pomocnicze ====
 +<code prolog>
 +
 +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). 
 +
 +</​code>​
 +
 +
 +==== Predykaty związane z nadawaniem id ====
 +<code prolog>
 +
 +:- 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).
 +
 +</​code>​
 +
 +
 +
 +
 +
 +
 +==== Predykaty związane z przeszukiwaniem oraz budowaniem struktury prologowej xml ====
 +<code prolog>
 +
 +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).
 +
 +</​code>​
 +
 +
 +
 +
 +==== Predykaty główne ====
 +<code prolog>
 +
 +% 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).
 +
 +</​code>​
 +
 +
 +
 +
 +
 +==== Predykaty do zapisu, tworzenia pliku xml ====
 +<code prolog>
 +
 +% 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).
 +
 +</​code>​
 +
 +===== Wersja poprzednia - płaska struktura =====
 +<code prolog>
 +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).
 +</​code>​
 +
 +
 +
 +
 +
pl/miw/miw08_prolog_xml/prolog_api.1209399091.txt.gz · ostatnio zmienione: 2019/06/27 15:59 (edycja zewnętrzna)
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0