diff --git a/RELEASE b/RELEASE index 021538a06..beefa8471 100644 --- a/RELEASE +++ b/RELEASE @@ -1,5 +1,6 @@ EYE release +v9.0.7 (2023-12-06) using linear lists for lingua v9.0.6 (2023-12-03) detecting malformed rdf lists and dropping --rdf-list-input option v9.0.5 (2023-12-02) doing lingua without lingua:graph functor and backward rules were the culprit v9.0.4 (2023-12-02) using lingua:graph in the lingua output diff --git a/VERSION b/VERSION index 61fd81a36..83c2a1c89 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -9.0.6 +9.0.7 diff --git a/eye.pl b/eye.pl index 2e53dc689..badf7fd69 100644 --- a/eye.pl +++ b/eye.pl @@ -21,7 +21,7 @@ :- use_module(library(pcre)). :- catch(use_module(library(http/http_open)), _, true). -version_info('EYE v9.0.6 (2023-12-03)'). +version_info('EYE v9.0.7 (2023-12-06)'). license_info('MIT License @@ -3840,10 +3840,7 @@ ; wt(C) ), ws(C), - ( flag(lingua) - -> true - ; write('.') - ), + write('.'), nl, cnt(output_statements), fail @@ -4364,7 +4361,8 @@ write(' true') ; wt(X), ws(X), - ( flag(lingua) + ( flag(lingua), + \+nb_getval(indentation, 0) -> true ; write('.') ), @@ -4398,26 +4396,10 @@ indentation(-4), indent, write(']') - ; ( flag(lingua), - is_lott([X|Y]) - -> write('('), - indentation(4), - forall( - member(Z, [X|Y]), - ( nl, - indent, - wt(Z) - ) - ), - indentation(-4), - nl, - indent, - write(')') - ; write('('), - wg(X), - wl(Y), - write(')') - ) + ; write('('), + wg(X), + wl(Y), + write(')') ). wt2(literal(X, lang(Y))) :- !, @@ -4675,23 +4657,11 @@ -> write('"'), writeq(X), write('"') - ; ( flag(lingua), - \+nb_getval(indentation, 0) - -> write('(') - ; true - ), - wg(S), + ; wg(S), write(' '), wp(P), write(' '), - wg(O), - ( flag(lingua) - -> ( \+nb_getval(indentation, 0) - -> write(')') - ; write('.') - ) - ; true - ) + wg(O) ). wtn(exopred(P, S, O)) :- @@ -4699,23 +4669,11 @@ ( atom(P) -> X =.. [P, S, O], wt2(X) - ; ( flag(lingua), - \+nb_getval(indentation, 0) - -> write('(') - ; true - ), - wg(S), + ; wg(S), write(' '), wg(P), write(' '), - wg(O), - ( flag(lingua) - -> ( \+nb_getval(indentation, 0) - -> write(')') - ; write('.') - ) - ; true - ) + wg(O) ). wtn(triple(S, P, O)) :- !, @@ -5434,11 +5392,11 @@ !, djiti_conc(answer(B, void, void), D). djiti_conc(answer(A, void, void), answer(B, void, void)) :- - is_lott(A), + list_lott(A, _), !, getconj(A, B). djiti_conc(A, B) :- - is_lott(A), + list_lott(A, _), !, getconj(A, B). djiti_conc(A, A). @@ -6541,7 +6499,19 @@ ), ( getconj(A, Ag), conj_list(Ag, C), - member(B, C) + getconj(B, Bg), + member(Bg, C) + ) + ). + +''(A, B) :- + when( + ( nonvar(A) + ), + ( getconj(A, Ag), + conj_list(Ag, C), + getconj(B, Bg), + \+member(Bg, C) ) ). @@ -6593,6 +6563,9 @@ ''([A|B], [A, B]). +''(A, B) :- + list_lott(A, B). + ''(A, B) :- when( ( nonvar(B) @@ -11195,10 +11168,10 @@ is_graph(A) :- is_gl(A). -is_lott([]). -is_lott([[_, P, _]|A]) :- - \+is_list(P), - is_lott(A). +list_lott([], []). +list_lott([A, B, C|D], [[A, B, C]|E]) :- + \+is_list(B), + list_lott(D, E). unify(A, B) :- nonvar(A), @@ -12372,35 +12345,34 @@ var(A), !. getterm(A, B) :- - is_lott(A), + list_lott(A, C), !, findall(_, - ( member([D, E, F], A), + ( member([D, E, F], C), memberchk(E, ['', '']), Z =.. [E, D, F], assertz(Z) ), _ ), - findall([D, E, F], - ( member([G, E, H], A), + findall([G, E, H], + ( member([D, E, F], C), E \= '', E \= '', - getterm(G, D), - getterm(H, F) + getterm(D, G), + getterm(F, H) ), - B + I ), findall(_, - ( member([D, E, F], A), + ( member([D, E, F], C), memberchk(E, ['', '']), Z =.. [E, D, F], retract(Z) ), _ - ). -getterm([], []) :- - !. + ), + list_lott(B, I). getterm('', []) :- !. getterm([A|B], [C|D]) :- @@ -12440,10 +12412,10 @@ !. getconj([], true) :- !. -getconj([[S, P, O]], A) :- +getconj([S, P, O], A) :- !, A =.. [P, S, O]. -getconj([[S, P, O]|A], (B, C)) :- +getconj([S, P, O|A], (B, C)) :- !, B =.. [P, S, O], getconj(A, C). diff --git a/eye.zip b/eye.zip index 472b48daa..54b9eb13c 100644 Binary files a/eye.zip and b/eye.zip differ diff --git a/lingua/4color/4color.ttl b/lingua/4color/4color.ttl index 15214c855..a2b3227f9 100644 --- a/lingua/4color/4color.ttl +++ b/lingua/4color/4color.ttl @@ -38,7 +38,7 @@ :places_rule1 a lingua:BackwardRule; lingua:vars (); lingua:conclusion ( - (() :places true) + () :places true ); lingua:premise (). @@ -53,17 +53,21 @@ _:SCOPE ); lingua:conclusion ( - (_:PLACES :places true) + _:PLACES :places true ); lingua:premise ( - (_:PLACES list:firstRest ((_:PLACE _:COLOR) _:TAIL)) - (_:TAIL :places true) - (_:PLACE :neighbours _:NEIGHBOURS) - ((:red :green :blue :yellow) list:member _:COLOR) - ((1 ( - (_:TAIL list:member (_:NEIGHBOUR _:COLOR)) - (_:NEIGHBOURS list:member _:NEIGHBOUR) - ) ()) log:collectAllIn _:SCOPE) + _:PLACES list:firstRest ((_:PLACE _:COLOR) _:TAIL) + _:TAIL :places true + _:PLACE :neighbours _:NEIGHBOURS + (:red :green :blue :yellow) list:member _:COLOR + ( + 1 + ( + _:TAIL list:member (_:NEIGHBOUR _:COLOR) + _:NEIGHBOURS list:member _:NEIGHBOUR + ) + () + ) log:collectAllIn _:SCOPE ). # query @@ -77,10 +81,16 @@ _:PLACES ); lingua:premise ( - (((_:PLACE _:COLOR) ((_:PLACE :neighbours _:NEIGHBOURS)) _:LIST) log:collectAllIn _:SCOPE) - ((_:LIST) func:reverse _:PLACES) - (_:PLACES :places true) + ( + (_:PLACE _:COLOR) + ( + _:PLACE :neighbours _:NEIGHBOURS + ) + _:LIST + ) log:collectAllIn _:SCOPE + (_:LIST) func:reverse _:PLACES + _:PLACES :places true ); lingua:conclusion ( - (_:PLACES :coloring true) + _:PLACES :coloring true ). diff --git a/lingua/acp/acp.ttl b/lingua/acp/acp.ttl index f68ba523a..1111e349a 100644 --- a/lingua/acp/acp.ttl +++ b/lingua/acp/acp.ttl @@ -22,12 +22,19 @@ _:X ); lingua:conclusion ( - (_:Pol :pass :allOfTest) + _:Pol :pass :allOfTest ); lingua:premise ( - (_:Test :policy _:Pol) - (_:Pol rdf:type :Policy) - ((((_:Pol :allOf _:Field)) ((_:Test :has _:Field))) log:forAllIn _:X) + _:Test :policy _:Pol + _:Pol rdf:type :Policy + ( + ( + _:Pol :allOf _:Field + ) + ( + _:Test :has _:Field + ) + ) log:forAllIn _:X ). :acp_rule2 a lingua:BackwardRule; @@ -39,14 +46,21 @@ _:X _:L );lingua:conclusion ( - (_:Pol :pass :anyOfTest) + _:Pol :pass :anyOfTest ); lingua:premise ( - (_:Test :policy _:Pol) - (_:Pol rdf:type :Policy) - ((_:Field ((_:Pol :anyOf _:Field) (_:Test :has _:Field)) _:List) log:collectAllIn _:X) - (_:List list:length _:L) - (_:L log:notEqualTo 0) + _:Test :policy _:Pol + _:Pol rdf:type :Policy + ( + _:Field + ( + _:Pol :anyOf _:Field + _:Test :has _:Field + ) + _:List + ) log:collectAllIn _:X + _:List list:length _:L + _:L log:notEqualTo 0 ). :acp_rule3 a lingua:BackwardRule; @@ -59,14 +73,17 @@ _:L ); lingua:conclusion ( - (_:Pol :pass :noneOfTest) + _:Pol :pass :noneOfTest ); lingua:premise ( - (_:Test :policy _:Pol) - (_:Pol rdf:type :Policy) - ((_:Field ((_:Pol :noneOf _:Field) (_:Test :has _:Field)) _:List) log:collectAllIn _:X) - (_:List list:length _:L) - (_:L log:equalTo 0) + _:Test :policy _:Pol + _:Pol rdf:type :Policy + (_:Field ( + _:Pol :noneOf _:Field + _:Test :has _:Field + ) _:List) log:collectAllIn _:X + _:List list:length _:L + _:L log:equalTo 0 ). # query @@ -75,12 +92,12 @@ _:Pol ); lingua:premise ( - (_:Pol rdf:type :Policy) - (_:Pol :pass :allOfTest) - (_:Pol :pass :anyOfTest) - (_:Pol :pass :noneOfTest) + _:Pol rdf:type :Policy + _:Pol :pass :allOfTest + _:Pol :pass :anyOfTest + _:Pol :pass :noneOfTest ); lingua:conclusion ( - (:test :for _:Pol) - (:test :is true) + :test :for _:Pol + :test :is true ). diff --git a/lingua/complex/complex.ttl b/lingua/complex/complex.ttl index dc6fa2630..b4e7faede 100644 --- a/lingua/complex/complex.ttl +++ b/lingua/complex/complex.ttl @@ -26,22 +26,22 @@ _:Z10 ); lingua:conclusion ( - (((_:A _:B) (_:C _:D)) complex:exponentiation (_:E _:F)) + ((_:A _:B) (_:C _:D)) complex:exponentiation (_:E _:F) ); lingua:premise ( - ((_:A _:B) complex:polar (_:R _:T)) - ((_:R _:C) math:exponentiation _:Z1) - (_:D math:negation _:Z2) - ((_:Z2 _:T) math:product _:Z3) - ((2.718281828459045 _:Z3) math:exponentiation _:Z4) - ((2.718281828459045 _:Z5) math:exponentiation _:R) - ((_:D _:Z5) math:product _:Z6) - ((_:C _:T) math:product _:Z7) - ((_:Z6 _:Z7) math:sum _:Z8) - (_:Z8 math:cos _:Z9) - ((_:Z1 _:Z4 _:Z9) math:product _:E) - (_:Z8 math:sin _:Z10) - ((_:Z1 _:Z4 _:Z10) math:product _:F) + (_:A _:B) complex:polar (_:R _:T) + (_:R _:C) math:exponentiation _:Z1 + _:D math:negation _:Z2 + (_:Z2 _:T) math:product _:Z3 + (2.718281828459045 _:Z3) math:exponentiation _:Z4 + (2.718281828459045 _:Z5) math:exponentiation _:R + (_:D _:Z5) math:product _:Z6 + (_:C _:T) math:product _:Z7 + (_:Z6 _:Z7) math:sum _:Z8 + _:Z8 math:cos _:Z9 + (_:Z1 _:Z4 _:Z9) math:product _:E + _:Z8 math:sin _:Z10 + (_:Z1 _:Z4 _:Z10) math:product _:F ). # asin @@ -70,28 +70,28 @@ _:Z15 ); lingua:conclusion ( - ((_:A _:B) complex:asin (_:C _:D)) + (_:A _:B) complex:asin (_:C _:D) ); lingua:premise ( - ((1 _:A) math:sum _:Z1) - ((_:Z1 2) math:exponentiation _:Z2) - ((_:B 2) math:exponentiation _:Z3) - ((_:Z2 _:Z3) math:sum _:Z4) - ((_:Z4 0.5) math:exponentiation _:Z5) - ((1 _:A) math:difference _:Z6) - ((_:Z6 2) math:exponentiation _:Z7) - ((_:Z7 _:Z3) math:sum _:Z8) - ((_:Z8 0.5) math:exponentiation _:Z9) - ((_:Z5 _:Z9) math:difference _:Z10) - ((_:Z10 2) math:quotient _:E) - ((_:Z5 _:Z9) math:sum _:Z11) - ((_:Z11 2) math:quotient _:F) - (_:E math:asin _:C) - ((_:F 2) math:exponentiation _:Z12) - ((_:Z12 1) math:difference _:Z13) - ((_:Z13 0.5) math:exponentiation _:Z14) - ((_:F _:Z14) math:sum _:Z15) - ((2.718281828459045 _:D) math:exponentiation _:Z15) + (1 _:A) math:sum _:Z1 + (_:Z1 2) math:exponentiation _:Z2 + (_:B 2) math:exponentiation _:Z3 + (_:Z2 _:Z3) math:sum _:Z4 + (_:Z4 0.5) math:exponentiation _:Z5 + (1 _:A) math:difference _:Z6 + (_:Z6 2) math:exponentiation _:Z7 + (_:Z7 _:Z3) math:sum _:Z8 + (_:Z8 0.5) math:exponentiation _:Z9 + (_:Z5 _:Z9) math:difference _:Z10 + (_:Z10 2) math:quotient _:E + (_:Z5 _:Z9) math:sum _:Z11 + (_:Z11 2) math:quotient _:F + _:E math:asin _:C + (_:F 2) math:exponentiation _:Z12 + (_:Z12 1) math:difference _:Z13 + (_:Z13 0.5) math:exponentiation _:Z14 + (_:F _:Z14) math:sum _:Z15 + (2.718281828459045 _:D) math:exponentiation _:Z15 ). # acos @@ -121,29 +121,29 @@ _:U ); lingua:conclusion ( - ((_:A _:B) complex:acos (_:C _:D)) + (_:A _:B) complex:acos (_:C _:D) ); lingua:premise ( - ((1 _:A) math:sum _:Z1) - ((_:Z1 2) math:exponentiation _:Z2) - ((_:B 2) math:exponentiation _:Z3) - ((_:Z2 _:Z3) math:sum _:Z4) - ((_:Z4 0.5) math:exponentiation _:Z5) - ((1 _:A) math:difference _:Z6) - ((_:Z6 2) math:exponentiation _:Z7) - ((_:Z7 _:Z3) math:sum _:Z8) - ((_:Z8 0.5) math:exponentiation _:Z9) - ((_:Z5 _:Z9) math:difference _:Z10) - ((_:Z10 2) math:quotient _:E) - ((_:Z5 _:Z9) math:sum _:Z11) - ((_:Z11 2) math:quotient _:F) - (_:E math:acos _:C) - ((_:F 2) math:exponentiation _:Z12) - ((_:Z12 1) math:difference _:Z13) - ((_:Z13 0.5) math:exponentiation _:Z14) - ((_:F _:Z14) math:sum _:Z15) - ((2.718281828459045 _:U) math:exponentiation _:Z15) - (_:U math:negation _:D) + (1 _:A) math:sum _:Z1 + (_:Z1 2) math:exponentiation _:Z2 + (_:B 2) math:exponentiation _:Z3 + (_:Z2 _:Z3) math:sum _:Z4 + (_:Z4 0.5) math:exponentiation _:Z5 + (1 _:A) math:difference _:Z6 + (_:Z6 2) math:exponentiation _:Z7 + (_:Z7 _:Z3) math:sum _:Z8 + (_:Z8 0.5) math:exponentiation _:Z9 + (_:Z5 _:Z9) math:difference _:Z10 + (_:Z10 2) math:quotient _:E + (_:Z5 _:Z9) math:sum _:Z11 + (_:Z11 2) math:quotient _:F + _:E math:acos _:C + (_:F 2) math:exponentiation _:Z12 + (_:Z12 1) math:difference _:Z13 + (_:Z13 0.5) math:exponentiation _:Z14 + (_:F _:Z14) math:sum _:Z15 + (2.718281828459045 _:U) math:exponentiation _:Z15 + _:U math:negation _:D ). # polar @@ -161,17 +161,17 @@ _:T ); lingua:conclusion ( - ((_:X _:Y) complex:polar(_:R _:Tp)) + (_:X _:Y) complex:polar(_:R _:Tp) ); lingua:premise ( - ((_:X 2) math:exponentiation _:Z1) - ((_:Y 2) math:exponentiation _:Z2) - ((_:Z1 _:Z2) math:sum _:Z3) - ((_:Z3 0.5) math:exponentiation _:R) - (_:X math:absoluteValue _:Z4) - ((_:Z4 _:R) math:quotient _:Z5) - (_:Z5 math:acos _:T) - ((_:X _:Y _:T) complex:dial _:Tp) + (_:X 2) math:exponentiation _:Z1 + (_:Y 2) math:exponentiation _:Z2 + (_:Z1 _:Z2) math:sum _:Z3 + (_:Z3 0.5) math:exponentiation _:R + _:X math:absoluteValue _:Z4 + (_:Z4 _:R) math:quotient _:Z5 + _:Z5 math:acos _:T + (_:X _:Y _:T) complex:dial _:Tp ). # dial @@ -183,12 +183,12 @@ _:Tp ); lingua:conclusion ( - ((_:X _:Y _:T) complex:dial _:Tp) + (_:X _:Y _:T) complex:dial _:Tp ); lingua:premise ( - (_:X math:notLessThan 0) - (_:Y math:notLessThan 0) - ((0 _:T) math:sum _:Tp) + _:X math:notLessThan 0 + _:Y math:notLessThan 0 + (0 _:T) math:sum _:Tp ). :complex_numbers_dial_rule2 a lingua:BackwardRule; @@ -199,12 +199,12 @@ _:Tp ); lingua:conclusion ( - ((_:X _:Y _:T) complex:dial _:Tp) + (_:X _:Y _:T) complex:dial _:Tp ); lingua:premise ( - (_:X math:lessThan 0) - (_:Y math:notLessThan 0) - ((3.141592653589793 _:T) math:difference _:Tp) + _:X math:lessThan 0 + _:Y math:notLessThan 0 + (3.141592653589793 _:T) math:difference _:Tp ). :complex_numbers_dial_rule3 a lingua:BackwardRule; @@ -215,12 +215,12 @@ _:Tp ); lingua:conclusion ( - ((_:X _:Y _:T) complex:dial _:Tp) + (_:X _:Y _:T) complex:dial _:Tp ); lingua:premise ( - (_:X math:lessThan 0) - (_:Y math:lessThan 0) - ((3.141592653589793 _:T) math:sum _:Tp) + _:X math:lessThan 0 + _:Y math:lessThan 0 + (3.141592653589793 _:T) math:sum _:Tp ). :complex_numbers_dial_rule4 a lingua:BackwardRule; @@ -232,13 +232,13 @@ _:Z1 ); lingua:conclusion ( - ((_:X _:Y _:T) complex:dial _:Tp) + (_:X _:Y _:T) complex:dial _:Tp ); lingua:premise ( - (_:X math:notLessThan 0) - (_:Y math:lessThan 0) - ((3.141592653589793 2) math:product _:Z1) - ((_:Z1 _:T) math:difference _:Tp) + _:X math:notLessThan 0 + _:Y math:lessThan 0 + (3.141592653589793 2) math:product _:Z1 + (_:Z1 _:T) math:difference _:Tp ). # query @@ -252,18 +252,18 @@ _:C6 ); lingua:premise ( - (((-1 0) (0.5 0)) complex:exponentiation _:C1) - (((2.718281828459045 0) (0 3.141592653589793)) complex:exponentiation _:C2) - (((0 1) (0 1)) complex:exponentiation _:C3) - (((2.718281828459045 0) (-1.57079632679 0)) complex:exponentiation _:C4) - ((2 0) complex:asin _:C5) - ((2 0) complex:acos _:C6) + ((-1 0) (0.5 0)) complex:exponentiation _:C1 + ((2.718281828459045 0) (0 3.141592653589793)) complex:exponentiation _:C2 + ((0 1) (0 1)) complex:exponentiation _:C3 + ((2.718281828459045 0) (-1.57079632679 0)) complex:exponentiation _:C4 + (2 0) complex:asin _:C5 + (2 0) complex:acos _:C6 ); lingua:conclusion ( - (((-1 0) (0.5 0)) complex:exponentiation _:C1) - (((2.718281828459045 0) (0 3.141592653589793)) complex:exponentiation _:C2) - (((0 1) (0 1)) complex:exponentiation _:C3) - (((2.718281828459045 0) (-1.57079632679 0)) complex:exponentiation _:C4) - ((2 0) complex:asin _:C5) - ((2 0) complex:acos _:C6) + ((-1 0) (0.5 0)) complex:exponentiation _:C1 + ((2.718281828459045 0) (0 3.141592653589793)) complex:exponentiation _:C2 + ((0 1) (0 1)) complex:exponentiation _:C3 + ((2.718281828459045 0) (-1.57079632679 0)) complex:exponentiation _:C4 + (2 0) complex:asin _:C5 + (2 0) complex:acos _:C6 ). diff --git a/lingua/control/control.ttl b/lingua/control/control.ttl index 8e73fb8e8..d2eda89d5 100644 --- a/lingua/control/control.ttl +++ b/lingua/control/control.ttl @@ -30,15 +30,15 @@ _:C ); lingua:premise ( - (:input1 :measurement10 _:M1) - (:input2 :measurement2 true) - (:disturbance1 :measurement3 _:D1) - ((_:M1 19.6) math:product _:C1) # proportial part - ((10 _:C2) math:exponentiation _:D1) # compensation part - ((_:C1 _:C2) math:difference _:C) # simple feedforward control + :input1 :measurement10 _:M1 + :input2 :measurement2 true + :disturbance1 :measurement3 _:D1 + (_:M1 19.6) math:product _:C1 # proportial part + (10 _:C2) math:exponentiation _:D1 # compensation part + (_:C1 _:C2) math:difference _:C # simple feedforward control ); lingua:conclusion ( - (:actuator1 :control1 _:C) + :actuator1 :control1 _:C ). :control_rule2 a lingua:ForwardRule; @@ -55,19 +55,19 @@ _:C ); lingua:premise ( - (:input3 :measurement3 _:M3) - (:state3 :observation3 _:P3) - (:output2 :measurement4 _:M4) - (:output2 :target2 _:T2) - ((_:T2 _:M4) math:difference _:E) # error - ((_:P3 _:M4) math:difference _:D) # differential error - ((5.8 _:E) math:product _:C1) # proportial part - ((7.3 _:E) math:quotient _:N) # nonlinear factor - ((_:N _:D) math:product _:C2) # nonlinear differential part - ((_:C1 _:C2) math:sum _:C) # PND feedback control + :input3 :measurement3 _:M3 + :state3 :observation3 _:P3 + :output2 :measurement4 _:M4 + :output2 :target2 _:T2 + (_:T2 _:M4) math:difference _:E # error + (_:P3 _:M4) math:difference _:D # differential error + (5.8 _:E) math:product _:C1 # proportial part + (7.3 _:E) math:quotient _:N # nonlinear factor + (_:N _:D) math:product _:C2 # nonlinear differential part + (_:C1 _:C2) math:sum _:C # PND feedback control ); lingua:conclusion ( - (:actuator2 :control1 _:C) + :actuator2 :control1 _:C ). # backward rules @@ -81,13 +81,13 @@ _:M ); lingua:conclusion ( - (_:I :measurement10 _:M) + _:I :measurement10 _:M ); lingua:premise ( - (_:I :measurement1 (_:M1 _:M2)) - (_:M1 math:lessThan _:M2) - ((_:M2 _:M1) math:difference _:M3) - ((_:M3 0.5) math:exponentiation _:M) + _:I :measurement1 (_:M1 _:M2) + _:M1 math:lessThan _:M2 + (_:M2 _:M1) math:difference _:M3 + (_:M3 0.5) math:exponentiation _:M ). :control_rule4 a lingua:BackwardRule; @@ -97,11 +97,11 @@ _:M2 ); lingua:conclusion ( - (_:I :measurement10 _:M1) + _:I :measurement10 _:M1 ); lingua:premise ( - (_:I :measurement1 (_:M1 _:M2)) - (_:M1 math:notLessThan _:M2) + _:I :measurement1 (_:M1 _:M2) + _:M1 math:notLessThan _:M2 ). # query @@ -111,8 +111,8 @@ _:C ); lingua:premise ( - (_:O :control1 _:C) + _:O :control1 _:C ); lingua:conclusion ( - (_:O :control1 _:C) + _:O :control1 _:C ). diff --git a/lingua/control/out/control.ttl b/lingua/control/out/control.ttl index 376128498..5c3abc78c 100644 --- a/lingua/control/out/control.ttl +++ b/lingua/control/out/control.ttl @@ -5,6 +5,6 @@ :control_rule1 lingua:bindings (2.23606797749979 35766 43.82693235899588 4.553470372213121 39.27346198678276). :control_rule2 lingua:bindings (56967 22 24 29 5 -2 29.0 1.46 -2.92 26.08). :control_query lingua:bindings (:actuator1 39.27346198678276). -:actuator1 :control1 39.27346198678276. +:actuator1 :control1 39.27346198678276 . :control_query lingua:bindings (:actuator2 26.08). -:actuator2 :control1 26.08. +:actuator2 :control1 26.08 . diff --git a/lingua/fibonacci/fibonacci.ttl b/lingua/fibonacci/fibonacci.ttl index 7ab4d0481..e70203e54 100644 --- a/lingua/fibonacci/fibonacci.ttl +++ b/lingua/fibonacci/fibonacci.ttl @@ -9,10 +9,10 @@ _:Y ); lingua:conclusion ( - (_:X :fibonacci _:Y) + _:X :fibonacci _:Y ); lingua:premise ( - ((_:X 0 1) :fib _:Y) + (_:X 0 1) :fib _:Y ). :fibonacci_rule2 a lingua:BackwardRule; @@ -21,7 +21,7 @@ _:B ); lingua:conclusion ( - ((0 _:A _:B) :fib _:A) + (0 _:A _:B) :fib _:A ); lingua:premise (). @@ -31,7 +31,7 @@ _:B ); lingua:conclusion ( - ((1 _:A _:B) :fib _:B) + (1 _:A _:B) :fib _:B ); lingua:premise (). @@ -45,13 +45,13 @@ _:D ); lingua:conclusion ( - ((_:X _:A _:B) :fib _:Y) + (_:X _:A _:B) :fib _:Y ); lingua:premise ( - (_:X math:greaterThan 1) - ((_:X 1) math:difference _:C) - ((_:A _:B) math:sum _:D) - ((_:C _:B _:D) :fib _:Y) + _:X math:greaterThan 1 + (_:X 1) math:difference _:C + (_:A _:B) math:sum _:D + (_:C _:B _:D) :fib _:Y ). # query @@ -64,16 +64,16 @@ _:F5 ); lingua:premise ( - (0 :fibonacci _:F1) - (1 :fibonacci _:F2) - (6 :fibonacci _:F3) - (91 :fibonacci _:F4) - (283 :fibonacci _:F5) + 0 :fibonacci _:F1 + 1 :fibonacci _:F2 + 6 :fibonacci _:F3 + 91 :fibonacci _:F4 + 283 :fibonacci _:F5 ); lingua:conclusion ( - (() :fibonacci (0 _:F1)) - (() :fibonacci (1 _:F2)) - (() :fibonacci (6 _:F3)) - (() :fibonacci (91 _:F4)) - (() :fibonacci (283 _:F5)) + () :fibonacci (0 _:F1) + () :fibonacci (1 _:F2) + () :fibonacci (6 _:F3) + () :fibonacci (91 _:F4) + () :fibonacci (283 _:F5) ). diff --git a/lingua/gps/gps.ttl b/lingua/gps/gps.ttl index 147b1c8e2..83328e731 100644 --- a/lingua/gps/gps.ttl +++ b/lingua/gps/gps.ttl @@ -20,12 +20,12 @@ _:MinComfort ); lingua:conclusion ( - (() gps:findpath (_:Goal _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort))) + () gps:findpath (_:Goal _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort)) ); lingua:premise ( - (() gps:findpaths (() _:Goal () 0.0 0.0 1.0 1.0 _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort 1))) + () gps:findpaths (() _:Goal () 0.0 0.0 1.0 1.0 _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort 1)) ). :gps_rule2 a lingua:BackwardRule; @@ -43,12 +43,12 @@ _:MaxStagecount ); lingua:conclusion ( - (() gps:findpath (_:Goal _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount))) + () gps:findpath (_:Goal _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)) ); lingua:premise ( - (() gps:findpaths (() _:Goal () 0.0 0.0 1.0 1.0 _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount))) + () gps:findpaths (() _:Goal () 0.0 0.0 1.0 1.0 _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)) ). :gps_rule3 a lingua:BackwardRule; @@ -67,11 +67,11 @@ _:MaxStagecount ); lingua:conclusion ( - (() gps:findpaths (_:Maps _:Goal _:Path _:Duration _:Cost _:Belief _:Comfort _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount))) + () gps:findpaths (_:Maps _:Goal _:Path _:Duration _:Cost _:Belief _:Comfort _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)) ); lingua:premise ( - (_:Goal log:callWithCleanup ()) + _:Goal log:call true ). :gps_rule4 a lingua:BackwardRule; @@ -111,33 +111,37 @@ _:Path_t ); lingua:conclusion ( - (() gps:findpaths (_:Maps_s _:Goal _:Path_s _:Duration_s _:Cost_s _:Belief_s _:Comfort_s _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount))) + () gps:findpaths (_:Maps_s _:Goal _:Path_s _:Duration_s _:Cost_s _:Belief_s _:Comfort_s _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)) ); lingua:premise ( - (_:Map gps:description (_:From _:Transition _:To _:Action _:Duration_n _:Cost_n _:Belief_n _:Comfort_n)) - ((_:Maps_s (_:Map)) list:append _:Maps_t) - (_:Maps_t gps:stagecount _:Stagecount) - (_:Stagecount math:notGreaterThan _:MaxStagecount) - ((_:Duration_s _:Duration_n) math:sum _:Duration_t) - (_:Duration_t math:notGreaterThan _:MaxDuration) - ((_:Cost_s _:Cost_n) math:sum _:Cost_t) - (_:Cost_t math:notGreaterThan _:MaxCost) - ((_:Belief_s _:Belief_n) math:product _:Belief_t) - (_:Belief_t math:notLessThan _:MinBelief) - ((_:Comfort_s _:Comfort_n) math:product _:Comfort_t) - (_:Comfort_t math:notLessThan _:MinComfort) - ((_:Path_s (_:Action)) list:append _:Path_t) - (_:From log:becomes _:To) - (((() gps:findpaths (_:Maps_t _:Goal _:Path_t _:Duration_t _:Cost_t _:Belief_t _:Comfort_t _:Path _:Duration _:Cost _:Belief _:Comfort - (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)))) log:callWithCleanup ((_:To log:becomes _:From))) + _:Map gps:description (_:From _:Transition _:To _:Action _:Duration_n _:Cost_n _:Belief_n _:Comfort_n) + (_:Maps_s (_:Map)) list:append _:Maps_t + _:Maps_t gps:stagecount _:Stagecount + _:Stagecount math:notGreaterThan _:MaxStagecount + (_:Duration_s _:Duration_n) math:sum _:Duration_t + _:Duration_t math:notGreaterThan _:MaxDuration + (_:Cost_s _:Cost_n) math:sum _:Cost_t + _:Cost_t math:notGreaterThan _:MaxCost + (_:Belief_s _:Belief_n) math:product _:Belief_t + _:Belief_t math:notLessThan _:MinBelief + (_:Comfort_s _:Comfort_n) math:product _:Comfort_t + _:Comfort_t math:notLessThan _:MinComfort + (_:Path_s (_:Action)) list:append _:Path_t + _:From log:becomes _:To + ( + () gps:findpaths (_:Maps_t _:Goal _:Path_t _:Duration_t _:Cost_t _:Belief_t _:Comfort_t _:Path _:Duration _:Cost _:Belief _:Comfort + (_:MaxDuration _:MaxCost _:MinBelief _:MinComfort _:MaxStagecount)) + ) log:callWithCleanup ( + _:To log:becomes _:From + ) ). # counting the number of stages (a stage is a sequence of steps in the same map) :gps_rule5 a lingua:BackwardRule; lingua:vars (); lingua:conclusion ( - (() gps:stagecount 1) + () gps:stagecount 1 ); lingua:premise (). @@ -152,14 +156,14 @@ _:G ); lingua:conclusion ( - (_:A gps:stagecount _:B) + _:A gps:stagecount _:B ); lingua:premise ( - (_:A list:firstRest (_:C _:D)) - (_:D list:firstRest (_:E _:F)) - (_:C log:notEqualTo _:E) - (_:D gps:stagecount _:G) - ((_:G 1) math:sum _:B) + _:A list:firstRest (_:C _:D) + _:D list:firstRest (_:E _:F) + _:C log:notEqualTo _:E + _:D gps:stagecount _:G + (_:G 1) math:sum _:B ). :gps_rule7 a lingua:BackwardRule; @@ -170,11 +174,11 @@ _:D ); lingua:conclusion ( - (_:A gps:stagecount _:B) + _:A gps:stagecount _:B ); lingua:premise ( - (_:A list:firstRest (_:C _:D)) - (_:D gps:stagecount _:B) + _:A list:firstRest (_:C _:D) + _:D gps:stagecount _:B ). # current state as practical example @@ -187,10 +191,10 @@ _:L ); lingua:conclusion ( - (:map-BE gps:description (((_:S :location :Gent)) () ((_:S :location :Brugge)) :drive_gent_brugge 1500.0 0.006 0.96 0.99)) + :map-BE gps:description ((_:S :location :Gent) () (_:S :location :Brugge) :drive_gent_brugge 1500.0 0.006 0.96 0.99) ); lingua:premise ( - (_:S :location _:L) + _:S :location _:L ). :gps_rule9 a lingua:BackwardRule; @@ -199,10 +203,10 @@ _:L ); lingua:conclusion ( - (:map-BE gps:description (((_:S :location :Gent)) () ((_:S :location :Kortrijk)) :drive_gent_kortrijk 1600.0 0.007 0.96 0.99)) + :map-BE gps:description ((_:S :location :Gent) () (_:S :location :Kortrijk) :drive_gent_kortrijk 1600.0 0.007 0.96 0.99) ); lingua:premise ( - (_:S :location _:L) + _:S :location _:L ). :gps_rule10 a lingua:BackwardRule; @@ -211,10 +215,10 @@ _:L ); lingua:conclusion ( - (:map-BE gps:description (((_:S :location :Kortrijk)) () ((_:S :location :Brugge)) :drive_kortrijk_brugge 1600.0 0.007 0.96 0.99)) + :map-BE gps:description ((_:S :location :Kortrijk) () (_:S :location :Brugge) :drive_kortrijk_brugge 1600.0 0.007 0.96 0.99) ); lingua:premise ( - (_:S :location _:L) + _:S :location _:L ). :gps_rule11 a lingua:BackwardRule; @@ -223,10 +227,10 @@ _:L ); lingua:conclusion ( - (:map-BE gps:description (((_:S :location :Brugge)) () ((_:S :location :Oostende)) :drive_brugge_oostende 900.0 0.004 0.98 1.0)) + :map-BE gps:description ((_:S :location :Brugge) () (_:S :location :Oostende) :drive_brugge_oostende 900.0 0.004 0.98 1.0) ); lingua:premise ( - (_:S :location _:L) + _:S :location _:L ). # query @@ -240,8 +244,8 @@ _:COMFORT ); lingua:premise ( - (() gps:findpath (((_:SUBJECT :location :Oostende)) _:PATH _:DURATION _:COST _:BELIEF _:COMFORT (5000.0 5.0 0.2 0.4 1))) + () gps:findpath ((_:SUBJECT :location :Oostende) _:PATH _:DURATION _:COST _:BELIEF _:COMFORT (5000.0 5.0 0.2 0.4 1)) ); lingua:conclusion ( - (_:SUBJECT gps:path (_:PATH _:DURATION _:COST _:BELIEF _:COMFORT)) + _:SUBJECT gps:path (_:PATH _:DURATION _:COST _:BELIEF _:COMFORT) ). diff --git a/lingua/gps/out/gps.ttl b/lingua/gps/out/gps.ttl index ac2a02055..000d7085d 100644 --- a/lingua/gps/out/gps.ttl +++ b/lingua/gps/out/gps.ttl @@ -10,26 +10,10 @@ :gps_rule9 lingua:bindings (:i1 :Brugge). :gps_rule10 lingua:bindings (:i1 :Brugge). :gps_rule11 lingua:bindings (:i1 :Brugge). -:gps_rule3 lingua:bindings ((:map-BE :map-BE) ( - (:i1 :location :Oostende) -) (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1). -:gps_rule4 lingua:bindings ((:map-BE) ( - (:i1 :location :Oostende) -) (:drive_gent_brugge) 1500.0 0.006 0.96 0.99 (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1 :map-BE ( - (:i1 :location :Brugge) -) () ( - (:i1 :location :Oostende) -) :drive_brugge_oostende 900.0 0.004 0.98 1.0 (:map-BE :map-BE) 1 2400.0 0.01 0.9408 0.99 (:drive_gent_brugge :drive_brugge_oostende)). -:gps_rule4 lingua:bindings (() ( - (:i1 :location :Oostende) -) () 0.0 0.0 1.0 1.0 (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1 :map-BE ( - (:i1 :location :Gent) -) () ( - (:i1 :location :Brugge) -) :drive_gent_brugge 1500.0 0.006 0.96 0.99 (:map-BE) 1 1500.0 0.006 0.96 0.99 (:drive_gent_brugge)). -:gps_rule2 lingua:bindings (( - (:i1 :location :Oostende) -) (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1). +:gps_rule3 lingua:bindings ((:map-BE :map-BE) (:i1 :location :Oostende) (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1). +:gps_rule4 lingua:bindings ((:map-BE) (:i1 :location :Oostende) (:drive_gent_brugge) 1500.0 0.006 0.96 0.99 (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1 :map-BE (:i1 :location :Brugge) () (:i1 :location :Oostende) :drive_brugge_oostende 900.0 0.004 0.98 1.0 (:map-BE :map-BE) 1 2400.0 0.01 0.9408 0.99 (:drive_gent_brugge :drive_brugge_oostende)). +:gps_rule4 lingua:bindings (() (:i1 :location :Oostende) () 0.0 0.0 1.0 1.0 (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1 :map-BE (:i1 :location :Gent) () (:i1 :location :Brugge) :drive_gent_brugge 1500.0 0.006 0.96 0.99 (:map-BE) 1 1500.0 0.006 0.96 0.99 (:drive_gent_brugge)). +:gps_rule2 lingua:bindings ((:i1 :location :Oostende) (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99 5000.0 5.0 0.2 0.4 1). :gps_query lingua:bindings (:i1 (:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99). :i1 gps:path ((:drive_gent_brugge :drive_brugge_oostende) 2400.0 0.01 0.9408 0.99). :gps_rule8 lingua:bindings (:i1 :Oostende). @@ -41,33 +25,11 @@ :gps_rule8 lingua:bindings (:i1 :Kortrijk). :gps_rule9 lingua:bindings (:i1 :Kortrijk). :gps_rule10 lingua:bindings (:i1 :Kortrijk). -:gps_rule3 lingua:bindings ((:map-BE :map-BE :map-BE) ( - (:i1 :location :Oostende) -) (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1). -:gps_rule4 lingua:bindings ((:map-BE :map-BE) ( - (:i1 :location :Oostende) -) (:drive_gent_kortrijk :drive_kortrijk_brugge) 3200.0 0.014 0.9216 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE ( - (:i1 :location :Brugge) -) () ( - (:i1 :location :Oostende) -) :drive_brugge_oostende 900.0 0.004 0.98 1.0 (:map-BE :map-BE :map-BE) 1 4100.0 0.018000000000000002 0.903168 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende)). -:gps_rule4 lingua:bindings ((:map-BE) ( - (:i1 :location :Oostende) -) (:drive_gent_kortrijk) 1600.0 0.007 0.96 0.99 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE ( - (:i1 :location :Kortrijk) -) () ( - (:i1 :location :Brugge) -) :drive_kortrijk_brugge 1600.0 0.007 0.96 0.99 (:map-BE :map-BE) 1 3200.0 0.014 0.9216 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge)). -:gps_rule4 lingua:bindings (() ( - (:i1 :location :Oostende) -) () 0.0 0.0 1.0 1.0 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE ( - (:i1 :location :Gent) -) () ( - (:i1 :location :Kortrijk) -) :drive_gent_kortrijk 1600.0 0.007 0.96 0.99 (:map-BE) 1 1600.0 0.007 0.96 0.99 (:drive_gent_kortrijk)). -:gps_rule2 lingua:bindings (( - (:i1 :location :Oostende) -) (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1). +:gps_rule3 lingua:bindings ((:map-BE :map-BE :map-BE) (:i1 :location :Oostende) (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1). +:gps_rule4 lingua:bindings ((:map-BE :map-BE) (:i1 :location :Oostende) (:drive_gent_kortrijk :drive_kortrijk_brugge) 3200.0 0.014 0.9216 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE (:i1 :location :Brugge) () (:i1 :location :Oostende) :drive_brugge_oostende 900.0 0.004 0.98 1.0 (:map-BE :map-BE :map-BE) 1 4100.0 0.018000000000000002 0.903168 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende)). +:gps_rule4 lingua:bindings ((:map-BE) (:i1 :location :Oostende) (:drive_gent_kortrijk) 1600.0 0.007 0.96 0.99 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE (:i1 :location :Kortrijk) () (:i1 :location :Brugge) :drive_kortrijk_brugge 1600.0 0.007 0.96 0.99 (:map-BE :map-BE) 1 3200.0 0.014 0.9216 0.9801 (:drive_gent_kortrijk :drive_kortrijk_brugge)). +:gps_rule4 lingua:bindings (() (:i1 :location :Oostende) () 0.0 0.0 1.0 1.0 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1 :map-BE (:i1 :location :Gent) () (:i1 :location :Kortrijk) :drive_gent_kortrijk 1600.0 0.007 0.96 0.99 (:map-BE) 1 1600.0 0.007 0.96 0.99 (:drive_gent_kortrijk)). +:gps_rule2 lingua:bindings ((:i1 :location :Oostende) (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801 5000.0 5.0 0.2 0.4 1). :gps_query lingua:bindings (:i1 (:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801). :i1 gps:path ((:drive_gent_kortrijk :drive_kortrijk_brugge :drive_brugge_oostende) 4100.0 0.018000000000000002 0.903168 0.9801). :gps_rule7 lingua:bindings ((:map-BE :map-BE :map-BE :map-BE) 1 :map-BE (:map-BE :map-BE :map-BE)). diff --git a/lingua/graph/graph.ttl b/lingua/graph/graph.ttl index e6857b1f9..1961e4cac 100644 --- a/lingua/graph/graph.ttl +++ b/lingua/graph/graph.ttl @@ -20,10 +20,10 @@ _:B ); lingua:premise ( - (_:A :oneway _:B) + _:A :oneway _:B ); lingua:conclusion ( - (_:A :path _:B) + _:A :path _:B ). # path transitive property @@ -34,11 +34,11 @@ _:C ); lingua:premise ( - (_:A :path _:B) - (_:B :path _:C) + _:A :path _:B + _:B :path _:C ); lingua:conclusion ( - (_:A :path _:C) + _:A :path _:C ). # query @@ -47,8 +47,8 @@ _:A ); lingua:premise ( - (_:A :path :nantes) + _:A :path :nantes ); lingua:conclusion ( - (_:A :path :nantes) + _:A :path :nantes ). diff --git a/lingua/hanoi/hanoi.ttl b/lingua/hanoi/hanoi.ttl index 78db5ef31..74897f22c 100644 --- a/lingua/hanoi/hanoi.ttl +++ b/lingua/hanoi/hanoi.ttl @@ -16,14 +16,14 @@ _:M2 ); lingua:conclusion ( - ((_:N _:X _:Y _:Z) :moves _:M) + (_:N _:X _:Y _:Z) :moves _:M ); lingua:premise ( - (_:N math:greaterThan 1) - ((_:N 1) math:difference _:N1) - ((_:N1 _:X _:Z _:Y) :moves _:M1) - ((_:N1 _:Z _:Y _:X) :moves _:M2) - ((_:M1 ((_:X _:Y)) _:M2) list:append _:M) + _:N math:greaterThan 1 + (_:N 1) math:difference _:N1 + (_:N1 _:X _:Z _:Y) :moves _:M1 + (_:N1 _:Z _:Y _:X) :moves _:M2 + (_:M1 ((_:X _:Y)) _:M2) list:append _:M ). :hanoi_rule2 a lingua:BackwardRule; @@ -33,7 +33,7 @@ _:Z ); lingua:conclusion ( - ((1 _:X _:Y _:Z) :moves ((_:X _:Y))) + (1 _:X _:Y _:Z) :moves ((_:X _:Y)) ); lingua:premise (). @@ -43,8 +43,8 @@ _:M ); lingua:premise ( - ((7 :left :right :center) :moves _:M) + (7 :left :right :center) :moves _:M ); lingua:conclusion ( - ((7 :left :right :center) :moves _:M) + (7 :left :right :center) :moves _:M ). diff --git a/lingua/negation/negation.ttl b/lingua/negation/negation.ttl index 7ffb27d3c..9bf672ebf 100644 --- a/lingua/negation/negation.ttl +++ b/lingua/negation/negation.ttl @@ -7,10 +7,10 @@ _:S ); lingua:premise ( - (_:S :saying :A) + _:S :saying :A ); lingua:conclusion ( - (_:S :saying :C) + _:S :saying :C ). :negation_predicates_rule2 a lingua:ForwardRule; @@ -18,10 +18,10 @@ _:S ); lingua:premise ( - (_:S :not_saying :C) + _:S :not_saying :C ); lingua:conclusion ( - (_:S :not_saying :A) + _:S :not_saying :A ). # saying B means saying C @@ -30,18 +30,18 @@ _:S ); lingua:premise ( - (_:S :saying :B) + _:S :saying :B ); lingua:conclusion ( - (_:S :saying :C) + _:S :saying :C ). :negation_predicates_rule4 a lingua:ForwardRule; lingua:premise ( - (_:S :not_saying :C) + _:S :not_saying :C ); lingua:conclusion ( - (_:S :not_saying :B) + _:S :not_saying :B ). # saying A or saying B @@ -50,10 +50,10 @@ _:S ); lingua:premise ( - (_:S :not_saying :A) + _:S :not_saying :A ); lingua:conclusion ( - (_:S :saying :B) + _:S :saying :B ). :negation_predicates_rule6 a lingua:ForwardRule; @@ -61,10 +61,10 @@ _:S ); lingua:premise ( - (_:S :not_saying :B) + _:S :not_saying :B ); lingua:conclusion ( - (_:S :saying :A) + _:S :saying :A ). # assuming the negation of the query so that @@ -75,8 +75,8 @@ :negation_predicates_query a lingua:QueryRule; lingua:vars (); lingua:premise ( - (:alice :saying :C) + :alice :saying :C ); lingua:conclusion ( - (:alice :saying :C) + :alice :saying :C ). diff --git a/lingua/peano/peano.ttl b/lingua/peano/peano.ttl index 2e740de56..97fca3802 100644 --- a/lingua/peano/peano.ttl +++ b/lingua/peano/peano.ttl @@ -7,7 +7,7 @@ _:A ); lingua:conclusion ( - ((_:A 0) :add _:A) + (_:A 0) :add _:A ); lingua:premise (). @@ -18,10 +18,10 @@ _:C ); lingua:premise ( - ((_:A _:B) :add _:C) + (_:A _:B) :add _:C ); lingua:conclusion ( - ((_:A (:s _:B)) :add (:s _:C)) + (_:A (:s _:B)) :add (:s _:C) ). # multiply @@ -30,7 +30,7 @@ _:A ); lingua:conclusion ( - ((_:A 0) :multiply 0) + (_:A 0) :multiply 0 ); lingua:premise (). @@ -42,11 +42,11 @@ _:D ); lingua:conclusion ( - ((_:A (:s _:B)) :multiply _:C) + (_:A (:s _:B)) :multiply _:C ); lingua:premise ( - ((_:A _:B) :multiply _:D) - ((_:A _:D) :add _:C) + (_:A _:B) :multiply _:D + (_:A _:D) :add _:C ). # factorial @@ -56,10 +56,10 @@ _:B ); lingua:conclusion ( - (_:A :factorial _:B) + _:A :factorial _:B ); lingua:premise ( - ((_:A (:s 0)) :fac _:B) + (_:A (:s 0)) :fac _:B ). :peano_factorial_rule2 a lingua:BackwardRule; @@ -67,7 +67,7 @@ _:A ); lingua:conclusion ( - ((0 _:A) :fac _:A) + (0 _:A) :fac _:A ); lingua:premise (). @@ -79,11 +79,11 @@ _:D ); lingua:conclusion ( - (((:s _:A) _:B) :fac _:C) + ((:s _:A) _:B) :fac _:C ); lingua:premise ( - ((_:B (:s _:A)) :multiply _:D) - ((_:A _:D) :fac _:C) + (_:B (:s _:A)) :multiply _:D + (_:A _:D) :fac _:C ). # query @@ -94,10 +94,10 @@ _:C ); lingua:premise ( - (((:s 0) (:s 0)) :add _:A) - ((_:A (:s (:s 0))) :multiply _:B) - (_:B :factorial _:C) + ((:s 0) (:s 0)) :add _:A + (_:A (:s (:s 0))) :multiply _:B + _:B :factorial _:C ); lingua:conclusion ( - (:result :is _:C) + :result :is _:C ). diff --git a/lingua/pi/pi.ttl b/lingua/pi/pi.ttl index d50364628..074d9bfb0 100644 --- a/lingua/pi/pi.ttl +++ b/lingua/pi/pi.ttl @@ -10,12 +10,12 @@ _:A ); lingua:conclusion ( - ((_:N _:Pi) :pi true) + (_:N _:Pi) :pi true ); lingua:premise ( - ((1 _:N 0 _:P 1) :pi true) - ((4 _:P) math:product _:A) - ((3 _:A) math:sum _:Pi) + (1 _:N 0 _:P 1) :pi true + (4 _:P) math:product _:A + (3 _:A) math:sum _:Pi ). :pi_rule2 a lingua:BackwardRule; @@ -25,7 +25,7 @@ _:S ); lingua:conclusion ( - ((_:N _:N _:P _:P _:S) :pi true) + (_:N _:N _:P _:P _:S) :pi true ); lingua:premise (). @@ -46,19 +46,19 @@ _:S1 ); lingua:conclusion ( - ((_:K _:N _:P0 _:P _:S) :pi true) + (_:K _:N _:P0 _:P _:S) :pi true ); lingua:premise ( - (_:K math:notEqualTo _:N) - ((_:K 1) math:sum _:K1) - ((2 _:K) math:product _:K2) - ((_:K2 1) math:sum _:A) - ((_:K2 2) math:sum _:B) - ((_:K2 _:A _:B) math:product _:C) - ((_:S _:C) math:quotient _:D) - ((_:P0 _:D) math:sum _:P1) - (_:S math:negation _:S1) - ((_:K1 _:N _:P1 _:P _:S1) :pi true) + _:K math:notEqualTo _:N + (_:K 1) math:sum _:K1 + (2 _:K) math:product _:K2 + (_:K2 1) math:sum _:A + (_:K2 2) math:sum _:B + (_:K2 _:A _:B) math:product _:C + (_:S _:C) math:quotient _:D + (_:P0 _:D) math:sum _:P1 + _:S math:negation _:S1 + (_:K1 _:N _:P1 _:P _:S1) :pi true ). # query @@ -67,8 +67,8 @@ _:Pi ); lingua:premise ( - ((1000 _:Pi) :pi true) + (1000 _:Pi) :pi true ); lingua:conclusion ( - ((1000 _:Pi) :pi true) + (1000 _:Pi) :pi true ). diff --git a/lingua/sdcoding/sdcoding.ttl b/lingua/sdcoding/sdcoding.ttl index 9b6142ccd..260779a0d 100644 --- a/lingua/sdcoding/sdcoding.ttl +++ b/lingua/sdcoding/sdcoding.ttl @@ -4,37 +4,37 @@ @prefix lingua: . @prefix : . -# |R) = |0, 0) + |1, 1) +# |R) = |0, 0) + |1, 1 :FALSE :r :FALSE. :TRUE :r :TRUE. -# |S) = |0, 1) + |1, 0) +# |S) = |0, 1) + |1, 0 :FALSE :s :TRUE. :TRUE :s :FALSE. -# |U) = |0, 0) + |1, 0) + |1, 1) +# |U) = |0, 0) + |1, 0) + |1, 1 :FALSE :u :FALSE. :TRUE :u :FALSE. :TRUE :u :TRUE. -# |V ) = |0, 0) + |0, 1) + |1, 0) +# |V ) = |0, 0) + |0, 1) + |1, 0 :FALSE :v :FALSE. :FALSE :v :TRUE. :TRUE :v :FALSE. -# 1 |0) = |0) +# 1 |0) = |0 :FALSE :id :FALSE. -# 1 |1) = |1) +# 1 |1) = |1 :TRUE :id :TRUE. -# G |0) = |1) +# G |0) = |1 :FALSE :g :TRUE. -# G |1) = |0) +# G |1) = |0 :TRUE :g :FALSE. -# K |0) = |0) +# K |0) = |0 :FALSE :k :FALSE. -# K |1) = |0) + |1) +# K |1) = |0) + |1 :TRUE :k :FALSE. :TRUE :k :TRUE. @@ -46,11 +46,11 @@ _:Z ); lingua:conclusion ( - (_:X :kg _:Y) + _:X :kg _:Y ); lingua:premise ( - (_:X :g _:Z) - (_:Z :k _:Y) + _:X :g _:Z + _:Z :k _:Y ). # GK @@ -61,11 +61,11 @@ _:Z ); lingua:conclusion ( - (_:X :gk _:Y) + _:X :gk _:Y ); lingua:premise ( - (_:X :k _:Z) - (_:Z :g _:Y) + _:X :k _:Z + _:Z :g _:Y ). # Alice @@ -75,10 +75,10 @@ _:Y ); lingua:conclusion ( - (0 :alice (_:X _:Y)) + 0 :alice (_:X _:Y) ); lingua:premise ( - (_:X :id _:Y) + _:X :id _:Y ). :sdcoding_rule4 a lingua:BackwardRule; @@ -87,10 +87,10 @@ _:Y ); lingua:conclusion ( - (1 :alice (_:X _:Y)) + 1 :alice (_:X _:Y) ); lingua:premise ( - (_:X :g _:Y) + _:X :g _:Y ). :sdcoding_rule5 a lingua:BackwardRule; @@ -99,10 +99,10 @@ _:Y ); lingua:conclusion ( - (2 :alice (_:X _:Y)) + 2 :alice (_:X _:Y) ); lingua:premise ( - (_:X :k _:Y) + _:X :k _:Y ). :sdcoding_rule6 a lingua:BackwardRule; @@ -111,10 +111,10 @@ _:Y ); lingua:conclusion ( - (3 :alice (_:X _:Y)) + 3 :alice (_:X _:Y) ); lingua:premise ( - (_:X :kg _:Y) + _:X :kg _:Y ). # Bob @@ -124,10 +124,10 @@ _:Y ); lingua:conclusion ( - ((_:X _:Y) :bob 0) + (_:X _:Y) :bob 0 ); lingua:premise ( - (_:X :gk _:Y) + _:X :gk _:Y ). :sdcoding_rule8 a lingua:BackwardRule; @@ -136,10 +136,10 @@ _:Y ); lingua:conclusion ( - ((_:X _:Y) :bob 1) + (_:X _:Y) :bob 1 ); lingua:premise ( - (_:X :k _:Y) + _:X :k _:Y ). :sdcoding_rule9 a lingua:BackwardRule; @@ -148,10 +148,10 @@ _:Y ); lingua:conclusion ( - ((_:X _:Y) :bob 2) + (_:X _:Y) :bob 2 ); lingua:premise ( - (_:X :g _:Y) + _:X :g _:Y ). :sdcoding_rule10 a lingua:BackwardRule; @@ -160,10 +160,10 @@ _:Y ); lingua:conclusion ( - ((_:X _:Y) :bob 3) + (_:X _:Y) :bob 3 ); lingua:premise ( - (_:X :id _:Y) + _:X :id _:Y ). # superdense coding @@ -181,14 +181,22 @@ _:I ); lingua:premise ( - (_:N :alice _:A) - (_:B :bob _:M) - ((1 ((_:X :r _:Y) (_:N :alice (_:X _:Z)) ((_:Z _:Y) :bob _:M)) _:L) log:collectAllIn _:S) - (_:L list:length _:I) - ((_:I 2) math:remainder 1) + _:N :alice _:A + _:B :bob _:M + ( + 1 + ( + _:X :r _:Y + _:N :alice (_:X _:Z) + (_:Z _:Y) :bob _:M + ) + _:L + ) log:collectAllIn _:S + _:L list:length _:I + (_:I 2) math:remainder 1 ); lingua:conclusion ( - (_:N :sdcoding _:M) + _:N :sdcoding _:M ). # query @@ -198,8 +206,8 @@ _:M ); lingua:premise ( - (_:N :sdcoding _:M) + _:N :sdcoding _:M ); lingua:conclusion ( - (() :sdcoding (_:N _:M)) + () :sdcoding (_:N _:M) ). diff --git a/lingua/socrates/socrates.ttl b/lingua/socrates/socrates.ttl index b502f292a..2d0b36313 100644 --- a/lingua/socrates/socrates.ttl +++ b/lingua/socrates/socrates.ttl @@ -15,11 +15,11 @@ _:S ); lingua:premise ( - (_:A rdfs:subClassOf _:B) - (_:S rdf:type _:A) + _:A rdfs:subClassOf _:B + _:S rdf:type _:A ); lingua:conclusion ( - (_:S rdf:type _:B) + _:S rdf:type _:B ). # query @@ -28,8 +28,8 @@ _:S ); lingua:premise ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ); lingua:conclusion ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ). diff --git a/lingua/temp/append.ttl b/lingua/temp/append.ttl index ebd3effa1..0fd6c9ac6 100644 --- a/lingua/temp/append.ttl +++ b/lingua/temp/append.ttl @@ -4,14 +4,14 @@ @prefix : . :Let :param1 ( - (:A :B :C) - (:A :X :C) - (:D :E :F) + :A :B :C + :A :X :C + :D :E :F ). :Let :param2 ( - (:A :Y :C) - (:A :B :C) + :A :Y :C + :A :B :C ). # query @@ -22,10 +22,10 @@ _:Y ); lingua:premise ( - (:Let :param1 _:X1) - (:Let :param2 _:X2) - ((_:X1 _:X2) list:append _:Y) + :Let :param1 _:X1 + :Let :param2 _:X2 + (_:X1 _:X2) list:append _:Y ); lingua:conclusion ( - ((_:X1 _:X2) :append _:Y) + (_:X1 _:X2) :append _:Y ). diff --git a/lingua/temp/backward.ttl b/lingua/temp/backward.ttl index e569b8677..c63fa0be5 100644 --- a/lingua/temp/backward.ttl +++ b/lingua/temp/backward.ttl @@ -10,18 +10,18 @@ _:Y ); lingua:conclusion ( - (_:X :moreInterestingThan _:Y) + _:X :moreInterestingThan _:Y ); lingua:premise ( - (_:X math:greaterThan _:Y) + _:X math:greaterThan _:Y ). # query :backward_query a lingua:QueryRule; lingua:vars (); lingua:premise ( - (5 :moreInterestingThan 3) + 5 :moreInterestingThan 3 ); lingua:conclusion ( - (:result :is (5 :moreInterestingThan 3)) + :result :is (5 :moreInterestingThan 3) ). diff --git a/lingua/temp/forward.ttl b/lingua/temp/forward.ttl index 400b1d29f..3881aff56 100644 --- a/lingua/temp/forward.ttl +++ b/lingua/temp/forward.ttl @@ -11,10 +11,10 @@ _:S ); lingua:premise ( - (_:S rdf:type :Human) + _:S rdf:type :Human ); lingua:conclusion ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ). # query @@ -23,8 +23,8 @@ _:S ); lingua:premise ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ); lingua:conclusion ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ). diff --git a/lingua/temp/fuse.ttl b/lingua/temp/fuse.ttl index 2eba51a39..8d0f4014e 100644 --- a/lingua/temp/fuse.ttl +++ b/lingua/temp/fuse.ttl @@ -15,11 +15,11 @@ _:S ); lingua:premise ( - (_:A rdfs:subClassOf _:B) - (_:S rdf:type _:A) + _:A rdfs:subClassOf _:B + _:S rdf:type _:A ); lingua:conclusion ( - (_:S rdf:type _:B) + _:S rdf:type _:B ). # inference fuse @@ -28,8 +28,8 @@ _:S ); lingua:premise ( - (_:S rdf:type :Mortal) - (_:S rdf:type :Immortal) + _:S rdf:type :Mortal + _:S rdf:type :Immortal ); lingua:conclusion false. @@ -39,8 +39,8 @@ _:S ); lingua:premise ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ); lingua:conclusion ( - (_:S rdf:type :Mortal) + _:S rdf:type :Mortal ). diff --git a/lingua/temp/gen.ttl b/lingua/temp/gen.ttl index e24f8cd15..c3b0534d9 100644 --- a/lingua/temp/gen.ttl +++ b/lingua/temp/gen.ttl @@ -7,29 +7,29 @@ lingua:vars (); lingua:premise (); lingua:conclusion ( - (:Socrates rdf:type :Human) - (:Human rdfs:subClassOf :Mortal) - (:rdfs_subclass_rule rdf:type lingua:ForwardRule) - (:rdfs_subclass_rule lingua:vars ( + :Socrates rdf:type :Human + :Human rdfs:subClassOf :Mortal + :rdfs_subclass_rule rdf:type lingua:ForwardRule + :rdfs_subclass_rule lingua:vars ( _:A _:B _:S - )) - (:rdfs_subclass_rule lingua:premise ( - (_:A rdfs:subClassOf _:B) - (_:S rdf:type _:A) - )) - (:rdfs_subclass_rule lingua:conclusion ( - (_:S rdf:type _:B) - )) - (:socrates_query rdf:type lingua:QueryRule) - (:socrates_query lingua:vars ( + ) + :rdfs_subclass_rule lingua:premise ( + _:A rdfs:subClassOf _:B + _:S rdf:type _:A + ) + :rdfs_subclass_rule lingua:conclusion ( + _:S rdf:type _:B + ) + :socrates_query rdf:type lingua:QueryRule + :socrates_query lingua:vars ( _:S - )) - (:socrates_query lingua:premise ( - (_:S rdf:type :Mortal) - )) - (:socrates_query lingua:conclusion ( - (_:S rdf:type :Mortal) - )) + ) + :socrates_query lingua:premise ( + _:S rdf:type :Mortal + ) + :socrates_query lingua:conclusion ( + _:S rdf:type :Mortal + ) ). diff --git a/lingua/temp/notequal.ttl b/lingua/temp/notequal.ttl index 61cfbe97d..eddc70e59 100644 --- a/lingua/temp/notequal.ttl +++ b/lingua/temp/notequal.ttl @@ -4,16 +4,16 @@ @prefix : . :Let :param1 ( - (:A :B :C) + :A :B :C ). :Let :param2 ( - (:D :E :F) + :D :E :F ). :Let :param3 ( - (:A :B :C) - (:D :E :F) + :A :B :C + :D :E :F ). #query @@ -27,14 +27,14 @@ _:X3_RT ); lingua:premise ( - (:Let :param1 _:X1) - (:Let :param2 _:X2) - (:Let :param3 _:X3) - ((_:X1 _:X2) graph:union _:Y) - (_:Y log:rawType _:Y_RT) - (_:X3 log:rawType _:X3_RT) - (_:Y log:notEqualTo _:X3) + :Let :param1 _:X1 + :Let :param2 _:X2 + :Let :param3 _:X3 + (_:X1 _:X2) graph:union _:Y + _:Y log:rawType _:Y_RT + _:X3 log:rawType _:X3_RT + _:Y log:notEqualTo _:X3 ); lingua:conclusion ( - (:test :is true) + :test :is true ). diff --git a/lingua/temp/out/append.ttl b/lingua/temp/out/append.ttl index 6ec7ffe41..c19a71621 100644 --- a/lingua/temp/out/append.ttl +++ b/lingua/temp/out/append.ttl @@ -1,31 +1,5 @@ @prefix : . @prefix lingua: . -:append_query lingua:bindings (( - (:A :B :C) - (:A :X :C) - (:D :E :F) -) ( - (:A :Y :C) - (:A :B :C) -) ( - (:A :B :C) - (:A :X :C) - (:D :E :F) - (:A :Y :C) - (:A :B :C) -)). -(( - (:A :B :C) - (:A :X :C) - (:D :E :F) -) ( - (:A :Y :C) - (:A :B :C) -)) :append ( - (:A :B :C) - (:A :X :C) - (:D :E :F) - (:A :Y :C) - (:A :B :C) -). +:append_query lingua:bindings ((:A :B :C :A :X :C :D :E :F) (:A :Y :C :A :B :C) (:A :B :C :A :X :C :D :E :F :A :Y :C :A :B :C)). +((:A :B :C :A :X :C :D :E :F) (:A :Y :C :A :B :C)) :append (:A :B :C :A :X :C :D :E :F :A :Y :C :A :B :C). diff --git a/lingua/temp/out/fuse.ttl.txt b/lingua/temp/out/fuse.ttl.txt index 1db450896..c04223553 100644 --- a/lingua/temp/out/fuse.ttl.txt +++ b/lingua/temp/out/fuse.ttl.txt @@ -1,4 +1,4 @@ ** ERROR ** eam ** inference_fuse(( - (:Socrates a :Mortal) - (:Socrates a :Immortal) + :Socrates a :Mortal + :Socrates a :Immortal ) => false) diff --git a/lingua/temp/out/notequal.ttl b/lingua/temp/out/notequal.ttl index f95eb65bd..1b877b115 100644 --- a/lingua/temp/out/notequal.ttl +++ b/lingua/temp/out/notequal.ttl @@ -2,15 +2,8 @@ @prefix lingua: . @prefix log: . -:union_query lingua:bindings (( - (:A :B :C) -) ( - (:D :E :F) -) ( - (:A :B :C) - (:D :E :F) -) ( - (:A :B :C) - (:D :E :F) +:union_query lingua:bindings ((:A :B :C) (:D :E :F) (:A :B :C :D :E :F) ( + :A :B :C + :D :E :F ) log:Formula ). :test :is true. diff --git a/lingua/temp/out/union.ttl b/lingua/temp/out/union.ttl index f11cc20de..70ade3c61 100644 --- a/lingua/temp/out/union.ttl +++ b/lingua/temp/out/union.ttl @@ -1,29 +1,15 @@ @prefix : . @prefix lingua: . -:union_query lingua:bindings (( - (:A :B :C) - (:A :X :C) - (:D :E :F) -) ( - (:A :Y :C) - (:A :B :C) -) ( - (:A :B :C) - (:A :X :C) - (:D :E :F) - (:A :Y :C) +:union_query lingua:bindings ((:A :B :C :A :X :C :D :E :F) (:A :Y :C :A :B :C) ( + :A :B :C + :A :X :C + :D :E :F + :A :Y :C )). -(( - (:A :B :C) - (:A :X :C) - (:D :E :F) -) ( - (:A :Y :C) - (:A :B :C) -)) :union ( - (:A :B :C) - (:A :X :C) - (:D :E :F) - (:A :Y :C) +((:A :B :C :A :X :C :D :E :F) (:A :Y :C :A :B :C)) :union ( + :A :B :C + :A :X :C + :D :E :F + :A :Y :C ). diff --git a/lingua/temp/sha512.ttl b/lingua/temp/sha512.ttl index c26915368..b6ad78515 100644 --- a/lingua/temp/sha512.ttl +++ b/lingua/temp/sha512.ttl @@ -11,9 +11,9 @@ _:Y ); lingua:premise ( - (:Let :param _:X) - (_:X crypto:sha512 _:Y) + :Let :param _:X + _:X crypto:sha512 _:Y ); lingua:conclusion ( - (() :sha512 (_:X _:Y)) + () :sha512 (_:X _:Y) ). diff --git a/lingua/temp/union.ttl b/lingua/temp/union.ttl index 438264698..d531952cb 100644 --- a/lingua/temp/union.ttl +++ b/lingua/temp/union.ttl @@ -4,14 +4,14 @@ @prefix : . :Let :param1 ( - (:A :B :C) - (:A :X :C) - (:D :E :F) + :A :B :C + :A :X :C + :D :E :F ). :Let :param2 ( - (:A :Y :C) - (:A :B :C) + :A :Y :C + :A :B :C ). #query @@ -22,10 +22,10 @@ _:Y ); lingua:premise ( - (:Let :param1 _:X1) - (:Let :param2 _:X2) - ((_:X1 _:X2) graph:union _:Y) + :Let :param1 _:X1 + :Let :param2 _:X2 + (_:X1 _:X2) graph:union _:Y ); lingua:conclusion ( - ((_:X1 _:X2) :union _:Y) + (_:X1 _:X2) :union _:Y ). diff --git a/lingua/turing/turing.ttl b/lingua/turing/turing.ttl index 6f29e0b0d..5bad6ae64 100644 --- a/lingua/turing/turing.ttl +++ b/lingua/turing/turing.ttl @@ -11,11 +11,11 @@ _:I ); lingua:conclusion ( - (() :compute _:OutTape) + () :compute _:OutTape ); lingua:premise ( - (_:Machine :start _:I) - ((_:I () "#" ()) :find _:OutTape) + _:Machine :start _:I + (_:I () "#" ()) :find _:OutTape ). :turing_rule2 a lingua:BackwardRule; @@ -28,12 +28,12 @@ _:I ); lingua:conclusion ( - (_:List :compute _:OutTape) + _:List :compute _:OutTape ); lingua:premise ( - (_:List list:firstRest (_:Head _:Tail)) - (_:Machine :start _:I) - ((_:I () _:Head _:Tail) :find _:OutTape) + _:List list:firstRest (_:Head _:Tail) + _:Machine :start _:I + (_:I () _:Head _:Tail) :find _:OutTape ). :turing_rule3 a lingua:BackwardRule; @@ -51,12 +51,12 @@ _:C ); lingua:conclusion ( - ((_:State _:Left _:Cell _:Right) :find _:OutTape) + (_:State _:Left _:Cell _:Right) :find _:OutTape ); lingua:premise ( - ((_:State _:Cell _:Write _:Move) :tape _:Next) - ((_:Move _:Left _:Write _:Right _:A _:B _:C) :move true) - ((_:Next _:A _:B _:C) :continue _:OutTape) + (_:State _:Cell _:Write _:Move) :tape _:Next + (_:Move _:Left _:Write _:Right _:A _:B _:C) :move true + (_:Next _:A _:B _:C) :continue _:OutTape ). :turing_rule4 a lingua:BackwardRule; @@ -69,12 +69,12 @@ _:List ); lingua:conclusion ( - ((:halt _:Left _:Cell _:Right) :continue _:OutTape) + (:halt _:Left _:Cell _:Right) :continue _:OutTape ); lingua:premise ( - (_:Left :reverse _:R) - (_:List list:firstRest (_:Cell _:Right)) - ((_:R _:List) list:append _:OutTape) + _:Left :reverse _:R + _:List list:firstRest (_:Cell _:Right) + (_:R _:List) list:append _:OutTape ). :turing_rule5 a lingua:BackwardRule; @@ -86,10 +86,10 @@ _:OutTape ); lingua:conclusion ( - ((_:State _:Left _:Cell _:Right) :continue _:OutTape) + (_:State _:Left _:Cell _:Right) :continue _:OutTape ); lingua:premise ( - ((_:State _:Left _:Cell _:Right) :find _:OutTape) + (_:State _:Left _:Cell _:Right) :find _:OutTape ). :turing_rule6 a lingua:BackwardRule; @@ -99,10 +99,10 @@ _:L ); lingua:conclusion ( - ((:left () _:Cell _:Right () "#" _:L) :move true) + (:left () _:Cell _:Right () "#" _:L) :move true ); lingua:premise ( - (_:L list:firstRest (_:Cell _:Right)) + _:L list:firstRest (_:Cell _:Right) ). :turing_rule7 a lingua:BackwardRule; @@ -115,11 +115,11 @@ _:L ); lingua:conclusion ( - ((:left _:List _:Cell _:Right _:Tail _:Head _:L) :move true) + (:left _:List _:Cell _:Right _:Tail _:Head _:L) :move true ); lingua:premise ( - (_:List list:firstRest (_:Head _:Tail)) - (_:L list:firstRest (_:Cell _:Right)) + _:List list:firstRest (_:Head _:Tail) + _:L list:firstRest (_:Cell _:Right) ). :turing_rule8 a lingua:BackwardRule; @@ -129,7 +129,7 @@ _:Right ); lingua:conclusion ( - ((:stop _:Left _:Cell _:Right _:Left _:Cell _:Right) :move true) + (:stop _:Left _:Cell _:Right _:Left _:Cell _:Right) :move true ); lingua:premise (). @@ -140,10 +140,10 @@ _:L ); lingua:conclusion ( - ((:right _:Left _:Cell () _:L "#" ()) :move true) + (:right _:Left _:Cell () _:L "#" ()) :move true ); lingua:premise ( - (_:L list:firstRest (_:Cell _:Left)) + _:L list:firstRest (_:Cell _:Left) ). :turing_rule10 a lingua:BackwardRule; @@ -156,17 +156,17 @@ _:Tail ); lingua:conclusion ( - ((:right _:Left _:Cell _:List _:L _:Head _:Tail) :move true) + (:right _:Left _:Cell _:List _:L _:Head _:Tail) :move true ); lingua:premise ( - (_:List list:firstRest (_:Head _:Tail)) - (_:L list:firstRest (_:Cell _:Left)) + _:List list:firstRest (_:Head _:Tail) + _:L list:firstRest (_:Cell _:Left) ). :turing_rule11 a lingua:BackwardRule; lingua:vars (); lingua:conclusion ( - (() :reverse ()) + () :reverse () ); lingua:premise (). @@ -179,12 +179,12 @@ _:R ); lingua:conclusion ( - (_:List :reverse _:Reverse) + _:List :reverse _:Reverse ); lingua:premise ( - (_:List list:firstRest (_:Head _:Tail)) - (_:Tail :reverse _:R) - ((_:R (_:Head)) list:append _:Reverse) + _:List list:firstRest (_:Head _:Tail) + _:Tail :reverse _:R + (_:R (_:Head)) list:append _:Reverse ). # a Turing machine to add 1 to a binary number @@ -206,14 +206,14 @@ _:A4 ); lingua:premise ( - ((1 0 1 0 0 1) :compute _:A1) - ((1 0 1 1 1 1) :compute _:A2) - ((1 1 1 1 1 1) :compute _:A3) - (() :compute _:A4) + (1 0 1 0 0 1) :compute _:A1 + (1 0 1 1 1 1) :compute _:A2 + (1 1 1 1 1 1) :compute _:A3 + () :compute _:A4 ); lingua:conclusion ( - ((1 0 1 0 0 1) :compute _:A1) - ((1 0 1 1 1 1) :compute _:A2) - ((1 1 1 1 1 1) :compute _:A3) - (() :compute _:A4) + (1 0 1 0 0 1) :compute _:A1 + (1 0 1 1 1 1) :compute _:A2 + (1 1 1 1 1 1) :compute _:A3 + () :compute _:A4 ). diff --git a/lingua/universal/universal.ttl b/lingua/universal/universal.ttl index f77171fb0..59d94421a 100644 --- a/lingua/universal/universal.ttl +++ b/lingua/universal/universal.ttl @@ -4,13 +4,13 @@ @prefix lingua: . @prefix : . -# \Every x: type(x, Resource) +# \Every x: type(x, Resource :universal_statements_rule1 a lingua:BackwardRule; lingua:vars ( _:X ); lingua:conclusion ( - (_:X rdf:type rdfs:Resource) + _:X rdf:type rdfs:Resource ); lingua:premise (). @@ -21,10 +21,10 @@ _:B ); lingua:conclusion ( - (_:A :loves _:B) + _:A :loves _:B ); lingua:premise ( - ((_:A) log:skolem _:B) + (_:A) log:skolem _:B ). :universal_statements_rule3 a lingua:BackwardRule; @@ -33,20 +33,20 @@ _:A ); lingua:conclusion ( - (_:B :is :lonely) + _:B :is :lonely ); lingua:premise ( - ((_:A) log:skolem _:B) + (_:A) log:skolem _:B ). # queries :universal_statements_query1 a lingua:QueryRule; lingua:vars (); lingua:premise ( - (:pat rdf:type rdfs:Resource) + :pat rdf:type rdfs:Resource ); lingua:conclusion ( - (:pat rdf:type rdfs:Resource) + :pat rdf:type rdfs:Resource ). :universal_statements_query2 a lingua:QueryRule; @@ -54,10 +54,10 @@ _:X ); lingua:premise ( - (:bob :loves _:X) - (_:X :is :lonely) + :bob :loves _:X + _:X :is :lonely ); lingua:conclusion ( - (:bob :loves _:X) - (_:X :is :lonely) + :bob :loves _:X + _:X :is :lonely ). diff --git a/lingua/unpack/unpack.ttl b/lingua/unpack/unpack.ttl index 14f69842a..de5a792f3 100644 --- a/lingua/unpack/unpack.ttl +++ b/lingua/unpack/unpack.ttl @@ -5,35 +5,35 @@ # sample data from RubenD _:b1 :data ( - (_:b2 :package ( - (_:b3 :content ( - (:a :b _:c) - (_:b4 :package ( - (_:b5 :content ( - (:u :v _:w) - (_:b6 :package ( - (_:b7 :content ( - (:x :y _:z) - )) - (_:b7 :usable_until :yesterday) - )) - (_:b6 :tag :invalid) - )) - (_:b5 :usable_until :tomorrow) - (_:b5 :p :o) - )) - (_:b4 :tag :valid) - )) - (_:b3 :usable_until :next_week) - )) - (_:b2 :tag :valid) + _:b2 :package ( + _:b3 :content ( + :a :b _:c + _:b4 :package ( + _:b5 :content ( + :u :v _:w + _:b6 :package ( + _:b7 :content ( + :x :y _:z + ) + _:b7 :usable_until :yesterday + ) + _:b6 :tag :invalid + ) + _:b5 :usable_until :tomorrow + _:b5 :p :o + ) + _:b4 :tag :valid + ) + _:b3 :usable_until :next_week + ) + _:b2 :tag :valid ). # the logic for unpack using backward rules :unpack_rule1 a lingua:BackwardRule; lingua:vars (); lingua:conclusion ( - (() :unpackLott ()) + () :unpackl () ); lingua:premise (). @@ -47,13 +47,13 @@ _:b1 :data ( _:b ); lingua:conclusion ( - (_:g :unpackLott _:h) + _:g :unpackl _:h ); lingua:premise ( - (_:g list:firstRest (_:f _:r)) - (_:f :unpack _:a) - (_:r :unpackLott _:b) - ((_:a _:b) list:append _:h) + _:g list:firstRest (_:f _:r) + _:f :unpack _:a + _:r :unpackl _:b + (_:a _:b) list:append _:h ). :unpack_rule3 a lingua:BackwardRule; @@ -61,35 +61,41 @@ _:b1 :data ( _:b _:p _:f + _:l _:a _:c _:t + _:d ); lingua:conclusion ( - ((_:b :package _:p) :unpack _:f) + (_:b :package _:p) :unpack _:f ); lingua:premise ( - (_:p list:member (_:a :content _:c)) - (_:p list:member (_:a :usable_until _:t)) - ((:tomorrow :next_week) list:member _:t) - (_:c :unpackLott _:f) + _:p list:lott _:l + _:l list:member (_:a :content _:c) + _:l list:member (_:a :usable_until _:t) + (:tomorrow :next_week) list:member _:t + _:c list:lott _:d + _:d :unpackl _:f ). :unpack_rule4 a lingua:BackwardRule; lingua:vars ( _:b _:p + _:l _:a _:c _:t ); lingua:conclusion ( - ((_:b :package _:p) :unpack ()) + (_:b :package _:p) :unpack () ); lingua:premise ( - (_:p list:member (_:a :content _:c)) - (_:p list:member (_:a :usable_until _:t)) - ((:yesterday :last_week) list:member _:t) + _:p list:lott _:l + _:l list:member (_:a :content _:c) + _:l list:member (_:a :usable_until _:t) + (:yesterday :last_week) list:member _:t ). :unpack_rule5 a lingua:BackwardRule; @@ -98,7 +104,7 @@ _:b1 :data ( _:p ); lingua:conclusion ( - ((_:b :tag _:p) :unpack ()) + (_:b :tag _:p) :unpack () ); lingua:premise (). @@ -111,11 +117,11 @@ _:b1 :data ( _:q ); lingua:conclusion ( - (_:g :unpack (_:g)) + _:g :unpack (_:g) ); lingua:premise ( - ((_:g) list:notMember (_:a :package _:p)) - ((_:g) list:notMember (_:b :tag _:q)) + (_:g) list:notMember (_:a :package _:p) + (_:g) list:notMember (_:b :tag _:q) ). # unpack the triples that are usable in the future @@ -123,10 +129,14 @@ _:b1 :data ( lingua:vars ( _:b _:g + _:l _:m + _:u ); lingua:premise ( - (_:b :data _:g) - (_:g :unpackLott _:m) + _:b :data _:g + _:g list:lott _:l + _:l :unpackl _:m + _:u list:lott _:m ); - lingua:conclusion _:m. + lingua:conclusion _:u. diff --git a/lingua/witch/witch.ttl b/lingua/witch/witch.ttl index 028f8f907..c815dea1e 100644 --- a/lingua/witch/witch.ttl +++ b/lingua/witch/witch.ttl @@ -2,65 +2,65 @@ @prefix lingua: . @prefix : . -# \forall x : BURNS(x) /\ WOMAN(x) => WITCH(x) +# \forall x : BURNS(x) /\ WOMAN(x) => WITCH(x :witch_rule1 a lingua:ForwardRule; lingua:vars ( _:X ); lingua:premise ( - (_:X rdf:type :BURNS) - (_:X rdf:type :WOMAN) + _:X rdf:type :BURNS + _:X rdf:type :WOMAN ); lingua:conclusion ( - (_:X rdf:type :WITCH) + _:X rdf:type :WITCH ). -# WOMAN(GIRL) +# WOMAN(GIRL :GIRL a :WOMAN. -# \forall x : ISMADEOFWOOD(x) => BURNS(x) +# \forall x : ISMADEOFWOOD(x) => BURNS(x :witch_rule2 a lingua:ForwardRule; lingua:vars ( _:X ); lingua:premise ( - (_:X rdf:type :ISMADEOFWOOD) + _:X rdf:type :ISMADEOFWOOD ); lingua:conclusion ( - (_:X rdf:type :BURNS) + _:X rdf:type :BURNS ). -# \forall x : FLOATS(x) => ISMADEOFWOOD(x) +# \forall x : FLOATS(x) => ISMADEOFWOOD(x :witch_rule3 a lingua:ForwardRule; lingua:vars ( _:X ); lingua:premise ( - (_:X rdf:type :FLOATS) + _:X rdf:type :FLOATS ); lingua:conclusion ( - (_:X rdf:type :ISMADEOFWOOD) + _:X rdf:type :ISMADEOFWOOD ). -# FLOATS(DUCK) +# FLOATS(DUCK :DUCK a :FLOATS. -# \forall x,y : FLOATS(x) /\ SAMEWEIGHT(x,y) => FLOATS(y) +# \forall x,y : FLOATS(x) /\ SAMEWEIGHT(x,y) => FLOATS(y :witch_rule4 a lingua:ForwardRule; lingua:vars ( _:X _:Y ); lingua:premise ( - (_:X rdf:type :FLOATS) - (_:X :SAMEWEIGHT _:Y) + _:X rdf:type :FLOATS + _:X :SAMEWEIGHT _:Y ); lingua:conclusion ( - (_:Y rdf:type :FLOATS) + _:Y rdf:type :FLOATS ). # and, by experiment -# SAMEWEIGHT(DUCK,GIRL) +# SAMEWEIGHT(DUCK,GIRL :DUCK :SAMEWEIGHT :GIRL. # who's a witch? @@ -69,8 +69,8 @@ _:S ); lingua:premise ( - (_:S rdf:type :WITCH) + _:S rdf:type :WITCH ); lingua:conclusion ( - (_:S rdf:type :WITCH) + _:S rdf:type :WITCH ).