diff --git a/RELEASE b/RELEASE index ed7b3e39d..36baf3e63 100644 --- a/RELEASE +++ b/RELEASE @@ -1,5 +1,6 @@ EYE release +v11.0.0 (2024-12-14) rdfsurfaces are now implemented as N3 rules https://github.com/eyereasoner/rdfsurfaces-tests/blob/main/lib/rdfsurfaces.n3 v10.30.17 (2024-12-11) fixing log:satisfiable v10.30.16 (2024-12-09) fixing string:substring v10.30.15 (2024-12-09) adding log:satisfiable built-in diff --git a/VERSION b/VERSION index 704fdc78e..275283a18 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -10.30.17 +11.0.0 diff --git a/eye.pl b/eye.pl index 16d77984d..4121b8eed 100644 --- a/eye.pl +++ b/eye.pl @@ -22,7 +22,7 @@ :- catch(use_module(library(process)), _, true). :- catch(use_module(library(http/http_open)), _, true). -version_info('EYE v10.30.17 (2024-12-11)'). +version_info('EYE v11.0.0 (2024-12-14)'). license_info('MIT License @@ -5516,330 +5516,7 @@ % rdfsurfaces ( ''(_, _) -> retractall(flag(rdfsurfaces)), - assertz(flag(rdfsurfaces)), - - % assert positive surfaces - assertz(implies(( - ''([], ''([], G)), - \+call(G) - ), G, '<>')), - - % simplify negative surfaces - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - select(''(Z, H), B, K), - getlist(Z, Zl), - is_list(Zl), - is_graph(H), - conj_list(H, M), - list_to_set(M, Ts), - ( T = Ts - ; select(_, Ts, T) - ), - select(''(W, O), T, N), - getlist(W, Wl), - is_list(Wl), - is_graph(O), - ( conj_list(O, D), - append(K, D, E), - conj_list(C, E) - ; length(K, I), - I > 1, - conj_list(F, N), - conj_list(C, [''([], F)|K]) - ), - findvars(H, R, beta), - intersection(Zl, R, X), - X = [], - findvars(O, S, beta), - intersection(Wl, S, Y), - append([Vl, X, Y], U) - ), ''(U, C), '<>')), - - % simplify flat negative surfaces - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, Gl), - \+find_component(Gl, _, _), - \+member(''(_, _), Gl), - \+member(''(_, _), Gl), - makevars([Vl, Gl], [Vv, Gv], beta(Vl)), - select(F, Gv, Gr), - member(F, Gr), - labelvars([Vv, Gr], 0, _, some), - find_graffiti(Vv, Vc), - conj_list(Gc, Gr) - ), ''(Vc, Gc), '<>')), - - % simplify disjunctive negative surfaces - assertz(implies(( - ''(V, G), - is_graph(G), - conj_list(G, Gl), - Gl = [''(U, H), _|_], - forall( - member(M, Gl), - M = ''(U, _) - ), - is_graph(H), - conj_list(H, Hl), - member(Hm, Hl), - forall( - member(''(U, J), Gl), - ( is_graph(J), - conj_list(J, Jl), - member(Hm, Jl) - ) - )), ''(V, ''(U, Hm)), '<>')), - - % simplify negative answer surfaces - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - member(''(_, _), B), - select(''(Z, H), B, K), - getlist(Z, Zl), - is_list(Zl), - is_graph(H), - conj_list(H, M), - list_to_set(M, J), - select(_, J, T), - conj_list(R, T), - conj_list(S, [''(Z, R)|K]) - ), ''(V, S), '<>')), - - % resolve negative surfaces - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - \+find_component(B, _, _), - \+member(''(_, _), B), - findall(1, - ( member(''(_, _), B) - ), - O - ), - length(O, E), - length(B, D), - ( E = 1 - -> D < 4 - ; true - ), - ''(W, F), - getlist(W, Wl), - is_list(Wl), - is_graph(F), - conj_list(F, K), - list_to_set(K, N), - \+find_component(N, _, _), - \+member(''(_, _), N), - length(N, 2), - makevars(N, J, beta(Wl)), - select(''(U, C), J, [P]), - getlist(U, Ul), - is_list(Ul), - is_graph(C), - ( select(''(Z, Q), B, A), - M = [''(Ul, C)|A], - conj_list(Q, R), - memberchk(P, R) - ; select(Q, B, A), - M = [P|A], - conj_list(C, R), - memberchk(Q, R) - ), - list_to_set(M, T), - conj_list(H, T), - ground(''(Vl, H)) - ), ''(Vl, H), '<>')), - - % convert negative surfaces to forward rules - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - \+find_component(B, _, _), - \+member(''(_, _), B), - select(''(Z, H), B, K), - ( H \= ''([], _) - ; Z = [] - ), - conj_list(R, K), - find_graffiti(K, D), - append(Vl, D, U), - makevars([R, H], [Q, S], beta(U)), - makevars(S, I, beta(Z)) - ), ''(Q, I), '<>')), - - % convert negative surfaces to forward contrapositive rules - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - \+find_component(B, _, _), - \+member(''(_, _), B), - \+member(''(_, _), B), - \+member(exopred(_, _, _), B), - ( length(B, O), - O =< 2 - -> select(R, B, J), - J \= [] - ; B = [R|J] - ), - conj_list(T, J), - findvars(R, N, beta), - findall(A, - ( member(A, Vl), - \+member(A, N) - ), - Z - ), - E = ''(Z, T), - find_graffiti([R], D), - append(Vl, D, U), - makevars([R, E], [Q, S], beta(U)), - makevars(S, I, beta(Z)) - ), ''(Q, I), '<>')), - - % convert negative surfaces to backward rules - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - find_component(B, T, K), - conj_list(R, K), - conjify(R, S), - find_graffiti([R], D), - append(Vl, D, U), - makevars([T, S], [Tu, Su], beta(U)), - C = ':-'(Tu, Su), - copy_term_nat(C, CC), - ( \+cc(CC) - -> assertz(cc(CC)), - assertz(C), - retractall(brake) - ; true - )), true, '<>')), - - % convert negative surfaces to universal statements - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - Vl \= [], - is_graph(G), - conj_list(G, [G]), - ( G = ''(Z, H) - -> is_list(Z) - ; Z = [], - H = ''([], G) - ), - findvars(H, R, beta), - intersection(Z, R, X), - conj_list(H, B), - member(M, B), - findall(''(Vl, W), - ( member(W, X) - ), - Y - ), - conj_list(S, Y), - append(Vl, X, U), - makevars([M, S], [Mu, Su], beta(U)), - C = ':-'(Mu, Su), - copy_term_nat(C, CC), - ( \+cc(CC) - -> assertz(cc(CC)), - assertz(C), - retractall(brake) - ; true - )), true, '<>')), - - % convert negative surfaces to answer rules - assertz(implies(( - ''(V, G), - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - list_to_set(L, B), - select(''(_, H), B, K), - ( conj_list(H, [H]), - findvars(H, [], beta), - findall(1, - ( ''(_, Gf), - conj_list(Gf, Lf), - select(''(_, _), Lf, _) - ), - [1] - ) - -> retractall(flag('limited-answer', _)), - assertz(flag('limited-answer', 1)) - ; true - ), - conj_list(I, K), - djiti_answer(answer(H), J), - find_graffiti(K, D), - append(Vl, D, U), - makevars([I, J], [Iu, Ju], beta(U)), - C = implies(Iu, Ju, '<>'), - copy_term_nat(C, CC), - ( \+cc(CC) - -> assertz(cc(CC)), - assertz(C), - retractall(brake) - ; true - )), true, '<>')), - - % blow inference fuse - assertz(implies(( - ''(V, G), - call(( - getlist(V, Vl), - is_list(Vl), - is_graph(G), - conj_list(G, L), - \+find_component(L, _, _), - \+member(''(_, _), L), - makevars(G, H, beta(Vl)), - ( H = ''(_, false), - J = true - ; catch(call(H), _, false), - J = H - ), - ( H = ''(_, C) - -> I = ''(_, C) - ; I = H - ) - )), - J, - ''(_, I) - ), false, '<>')) + assertz(flag(rdfsurfaces)) ; true ), nb_setval(prepare, false). @@ -6843,6 +6520,9 @@ ) ). +''(A, B) :- + findvars(A, B, beta). + ''(A, B) :- when( ( nonvar(A) @@ -6876,6 +6556,9 @@ ) ). +''([A, B], C) :- + makevars(B, C, beta(A)). + ''(A, B) :- when( ( nonvar(A) @@ -12716,43 +12399,6 @@ findvar(A, eta) :- sub_atom(A, 0, _, _, allv). -find_graffiti(A, []) :- - atomic(A), - !. -find_graffiti([], []) :- - !. -find_graffiti([A|B], C) :- - !, - find_graffiti(A, D), - find_graffiti(B, E), - append(D, E, C). -find_graffiti(A, B) :- - A =.. [C, D, E], - regex('^<.*#on.*Surface>$', C, _), - is_list(D), - is_graph(E), - !, - find_graffiti(E, F), - findvars(E, G, beta), - intersection(D, G, H), - append(H, F, B). -find_graffiti(A, B) :- - A =.. C, - find_graffiti(C, B). - -find_component(B, T, K) :- - select(''([], T), B, K), - conj_list(T, [T]), - \+member(''(_, _), K), - \+member(''(_, _), K), - ( T =.. [P, _, _], - ''(P, '') - ; findvars(T, Tv, beta), - findvars(K, Kv, beta), - member(Tm, Tv), - \+member(Tm, Kv) - ). - raw_type(A, '') :- var(A), !. diff --git a/eye.zip b/eye.zip index 47dfdcdc4..5fbec61f7 100644 Binary files a/eye.zip and b/eye.zip differ