34
35:- module(near_utils,
36 [fact_near/1,
37 fact_near/2,
38 retract_near/1,
39 retractall_near/1,
40 real_near/2,
41 real_compare/3,
42 near_compare/3,
43 unify_near/2,
44 repsilon/1,
45 repsilon/2]). 46
47:- use_module(library(mapargs)). 48:- use_module(library(compare_eq)). 49
50:- meta_predicate
51 fact_near(0 ),
52 fact_near(0, -),
53 retract_near(0 ),
54 retractall_near(0 ). 55
56fact_near(M:Call) :-
57 freeze_near(Call, Mask),
58 M:Mask,
59 frozen_near(Mask).
60
61fact_near(M:Call, Ref) :-
62 freeze_near(Call, Mask),
63 clause(M:Mask, _, Ref),
64 frozen_near(Mask).
65
66retract_near(M:Call) :-
67 fact_near(M:Call, Ref),
68 erase(Ref).
69
70retractall_near(M:Call) :-
71 forall(( freeze_near(Call, Mask),
72 clause(M:Mask, _, Ref)
73 ),
74 erase(Ref)).
75
76real(R) :-
77 ( R == 1.5NaN
78 ->fail
79 ; float(R)
80 ->true
81 ; rational(R),
82 \+ integer(R)
83 ).
84
85rnum(R) :-
86 ( R == 1.5NaN
87 ->fail
88 ; float(R)
89 ->true
90 ; rational(R)
91 ).
92
93attr_unify_hook(near(Arg1), Arg) :-
94 rnum(Arg),
95 real_near(Arg1, Arg).
96
97put_near(Arg1, Arg) :-
98 ( nonvar(Arg1)
99 ->put_attr(Arg, near_utils, near(Arg1))
100 ; Arg = Arg1
101 ).
102
103freeze_near(Arg1, Arg) :-
104 ( real(Arg1)
105 ->put_near(Arg1, Arg)
106 107 108 109 110 111 112 113 114 115 116 ; var(Arg1)
117 ->Arg = Arg1
118 ; mapargs(freeze_near, Arg1, Arg)
119 ).
120
121frozen_near(Mask) :-
122 term_attvars(Mask, Vars),
123 maplist(frozen_near_1, Vars).
124
125frozen_near_1(Var) :-
126 ( get_attr(Var, near_utils, near(Val))
127 ->del_attr(Var, near_utils),
128 Var = Val
129 ; true
130 ).
131
132real_near(A, B) :- near_compare(=, A, B).
133
134real_compare(A, C, B) :- near_compare(C, A, B).
135
136repsilon(E) :- E is 1024*epsilon.
137
138repsilon(N, E) :-
139 repsilon(R),
140 E is R*N.
141
142near_compare(Comparator, A, B) :-
143 ( A =:= B
144 ->compare_eq(Comparator)
145 ; repsilon(max(abs(A), abs(B)), E),
146 compare(Comparator, A, B, E)
147 ).
148
149compare(=, A, B, E) :- abs(A - B) =< E.
150compare(=<, A, B, E) :- A - B =< E.
151compare(>=, A, B, E) :- B - A =< E.
152compare(<, A, B, E) :- B - A > E.
153compare(>, A, B, E) :- A - B > E.
154compare(\=, A, B, E) :- abs(A - B) > E.
155
156unify_near(Arg1, Arg2) :-
157 ( real(Arg1),
158 real(Arg2)
159 ->real_near(Arg1, Arg2)
160 ; ( var(Arg1)
161 ; var(Arg2)
162 )
163 ->Arg1 = Arg2
164 ; mapargs(unify_near, Arg1, Arg2)
165 )