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