1 % (c) 2020-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(external_functions_reals,['STRING_TO_REAL'/3,
6 'RADD'/4,'RSUB'/4,'RMUL'/4,'RDIV'/5, 'RINV'/4,
7 'RPI'/1, 'RZERO'/1, 'RONE'/1, 'REULER'/1,
8 'REPSILON'/1, 'RMAXFLOAT'/1,
9 'RSIN'/3, 'RCOS'/3, 'RTAN'/3, 'RCOT'/3,
10 'RSINH'/3, 'RCOSH'/3, 'RTANH'/3, 'RCOTH'/3,
11 'RASIN'/3, 'RACOS'/3, 'RATAN'/3, 'RACOT'/3,
12 'RASINH'/3, 'RACOSH'/3, 'RATANH'/3, 'RACOTH'/3,
13 'RATAN2'/5, 'RHYPOT'/5,
14 'RADIANS'/4, 'DEGREE'/4,
15 'RUMINUS'/3,
16 'REXP'/3, 'RLOGe'/4, 'RSQRT'/4,
17 'RABS'/3, 'ROUND'/3, 'RSIGN'/3,
18 'RINTEGER'/3, 'RFRACTION'/3,
19 'RMAX'/5, 'RMIN'/5,
20 'RPOW'/5, 'RLOG'/5,
21 'RDECIMAL'/5, % scientific notation using integers
22 'RLT'/4, 'REQ'/4, 'RNEQ'/4, 'RLEQ'/4, 'RGT'/4, 'RGEQ'/4,
23 'RMAXIMUM'/4, 'RMINIMUM'/4,
24
25 'RNEXT'/2, 'RPREV'/2
26 ]).
27
28
29 % -------------------------------
30 :- use_module(probsrc(kernel_reals),[construct_real/2,
31 is_largest_positive_float/1, is_smallest_positive_float/1,
32 is_next_larger_float/2, is_next_smaller_float/2]).
33
34 %external_fun_type('STRING_TO_REAL',[],[string,real]).
35 % allows to call construct_real/2; also works for numbers without decimal point
36
37 :- block 'STRING_TO_REAL'(-,?,?).
38 'STRING_TO_REAL'(string(A),Result,_) :-
39 block_construct_real(A,Result).
40
41 :- block 'block_construct_real'(-,?).
42 block_construct_real(A,Result) :-
43 construct_real(A,Result).
44
45 % -------------------------------
46
47 :- use_module(probsrc(kernel_reals),[real_addition_wf/4, real_subtraction_wf/4,
48 real_multiplication_wf/4, real_division_wf/5, real_power_of_wf/5,
49 real_unary_minus_wf/3, real_absolute_value_wf/3, real_square_root_wf/4,
50 convert_int_to_real/2,
51 real_round_wf/3, real_truncate/2, real_sign_wf/3,
52 real_unop_wf/4, real_unop_wf/5, real_binop_wf/6,
53 real_comp_wf/5,
54 real_maximum_of_set/4, real_minimum_of_set/4]).
55
56 'RADD'(RX,RY,RR,WF) :-
57 real_addition_wf(RX,RY,RR,WF).
58
59 'RSUB'(RX,RY,RR,WF) :-
60 real_subtraction_wf(RX,RY,RR,WF).
61
62 'RMUL'(RX,RY,RR,WF) :-
63 real_multiplication_wf(RX,RY,RR,WF).
64
65 'RDIV'(RX,RY,RR,Span,WF) :-
66 real_division_wf(RX,RY,RR,Span,WF).
67
68 'RINV'(RY,RR,Span,WF) :-
69 'RONE'(RX),
70 real_division_wf(RX,RY,RR,Span,WF).
71
72 % ---- constants
73
74 'RPI'(term(floating(R))) :- R is pi.
75
76 'RZERO'(term(floating(R))) :- R = 0.0.
77
78 'RONE'(term(floating(R))) :- R = 1.0.
79
80 'REULER'(term(floating(R))) :- R is exp(1.0).
81
82 'REPSILON'(R) :- is_smallest_positive_float(R). % 5.0E-324
83
84 'RMAXFLOAT'(R) :- is_largest_positive_float(R). % 1.7976931348623157E+308
85
86 % ---- unary operators
87
88 % --- Trigonometric
89
90 :- block 'RSIN'(-,?,?).
91 'RSIN'(X,R,WF) :-
92 real_unop_wf('sin',X,R,WF).
93
94 :- block 'RCOS'(-,?,?).
95 'RCOS'(X,R,WF) :-
96 real_unop_wf('cos',X,R,WF).
97
98 :- block 'RTAN'(-,?,?).
99 'RTAN'(X,R,WF) :-
100 real_unop_wf('tan',X,R,WF).
101
102 :- block 'RCOT'(-,?,?).
103 'RCOT'(X,R,WF) :-
104 real_unop_wf('cot',X,R,WF).
105
106 :- block 'RSINH'(-,?,?).
107 'RSINH'(X,R,WF) :-
108 real_unop_wf('sinh',X,R,WF).
109
110 :- block 'RCOSH'(-,?,?).
111 'RCOSH'(X,R,WF) :-
112 real_unop_wf('cosh',X,R,WF).
113
114 :- block 'RTANH'(-,?,?).
115 'RTANH'(X,R,WF) :-
116 real_unop_wf('tanh',X,R,WF).
117
118 :- block 'RCOTH'(-,?,?).
119 'RCOTH'(X,R,WF) :-
120 real_unop_wf('coth',X,R,WF).
121
122 :- block 'RASIN'(-,?,?).
123 'RASIN'(X,R,WF) :-
124 real_unop_wf('asin',X,R,WF).
125
126 :- block 'RACOS'(-,?,?).
127 'RACOS'(X,R,WF) :-
128 real_unop_wf('acos',X,R,WF).
129
130 :- block 'RATAN'(-,?,?).
131 'RATAN'(X,R,WF) :-
132 real_unop_wf('atan',X,R,WF).
133
134 :- block 'RACOT'(-,?,?).
135 'RACOT'(X,R,WF) :-
136 real_unop_wf('acot',X,R,WF).
137
138 :- block 'RASINH'(-,?,?).
139 'RASINH'(X,R,WF) :-
140 real_unop_wf('asinh',X,R,WF).
141
142 :- block 'RACOSH'(-,?,?).
143 'RACOSH'(X,R,WF) :-
144 real_unop_wf('acosh',X,R,WF).
145
146 :- block 'RATANH'(-,?,?).
147 'RATANH'(X,R,WF) :-
148 real_unop_wf('atanh',X,R,WF).
149
150 :- block 'RACOTH'(-,?,?).
151 'RACOTH'(X,R,WF) :-
152 real_unop_wf('acoth',X,R,WF).
153
154 :- block 'RATAN2'(-,?,?,?,?), 'RATAN2'(?,-,?,?,?).
155 'RATAN2'(RX,RY,RR,Span,WF) :-
156 real_binop_wf(atan2,RX,RY,RR,Span,WF).
157 % is useful for computing angle in radians from deltax, deltay, avoiding division by 0
158 % e.g. converting Cartesian coordinates x,y to Polar can be done with:
159 % angle phi = RATAN2(y,x)
160 % r = RHYPOT(x,y)
161 % Note: conversion from Polar to Cartesian is x = r*RCOS(phi) and y=r*RSIN(phi)
162
163 :- block 'RHYPOT'(-,?,?,?,?), 'RHYPOT'(?,-,?,?,?).
164 'RHYPOT'(X,Y,Res,Span,WF) :-
165 'RMUL'(X,X,X2,WF),
166 'RMUL'(Y,Y,Y2,WF),
167 'RADD'(X2,Y2,X2Y2,WF),
168 'RSQRT'(X2Y2,Res,Span,WF).
169
170 :- block 'RADIANS'(-,?,?,?).
171 'RADIANS'(Degree,Res,Span,WF) :-
172 D180 = term(floating(180.0)),
173 'RDIV'(Degree,D180,Deg2,Span,WF),
174 'RPI'(PI),
175 'RMUL'(PI,Deg2,Res,WF).
176
177 :- block 'DEGREE'(-,?,?,?).
178 'DEGREE'(Radians,Res,Span,WF) :-
179 D180 = term(floating(180.0)),
180 'RPI'(PI),
181 'RDIV'(Radians,PI,Deg2,Span,WF),
182 'RMUL'(D180,Deg2,Res,WF).
183
184
185 % -----------------------
186
187
188 'RUMINUS'(RX,RR,WF) :- % unary minus
189 real_unary_minus_wf(RX,RR,WF).
190
191 :- block 'REXP'(-,?,?).
192 'REXP'(X,R,WF) :-
193 real_unop_wf('exp',X,R,WF).
194
195 :- block 'RLOGe'(-,?,?,?).
196 'RLOGe'(X,R,Span,WF) :-
197 real_unop_wf('log',X,R,Span,WF).
198
199 'RSQRT'(X,R,Span,WF) :-
200 real_square_root_wf(X,R,Span,WF).
201
202 'RABS'(X,R,WF) :-
203 real_absolute_value_wf(X,R,WF).
204
205 :- block 'ROUND'(-,?,?).
206 'ROUND'(X,R,WF) :-
207 real_round_wf(X,R,WF).
208
209 :- block 'RSIGN'(-,?,?).
210 'RSIGN'(X,R,WF) :-
211 real_sign_wf(X,R,WF).
212
213 :- block 'RINTEGER'(-,?,?).
214 'RINTEGER'(X,R,_WF) :-
215 real_truncate(X,RI), convert_int_to_real(RI,R).
216 %real_unop_wf('float_integer_part',X,R,WF).
217
218 :- block 'RFRACTION'(-,?,?).
219 'RFRACTION'(X,R,WF) :-
220 real_unop_wf('float_fractional_part',X,R,WF).
221
222 % ---- other binary operators
223 'RMAX'(RX,RY,RR,Span,WF) :-
224 real_binop_wf(max,RX,RY,RR,Span,WF).
225
226 'RMIN'(RX,RY,RR,Span,WF) :-
227 real_binop_wf(min,RX,RY,RR,Span,WF).
228
229 'RPOW'(RX,RY,RR,Span,WF) :-
230 real_power_of_wf(RX,RY,RR,Span,WF).
231
232 % convert integers x,y to reak x*10^y
233 'RDECIMAL'(IntX,IntY,RR,Span,WF) :-
234 convert_int_to_real(int(10),R10),
235 convert_int_to_real(IntY,RY),
236 real_power_of_wf(R10,RY,RR10,Span,WF),
237 convert_int_to_real(IntX,RX),
238 'RMUL'(RX,RR10,RR,WF).
239
240 :- if(current_prolog_flag(dialect, swi)).
241 % in SWI we need to do log(X) / log(Base)
242 'RLOG'(Base,X,RR,Span,WF) :-
243 real_unop_wf('log',Base,LogBase,Span,WF),
244 real_unop_wf('log',X,LogX,Span,WF),
245 real_division_wf(LogX,LogBase,RR,Span,WF).
246 :- else.
247 'RLOG'(RX,RY,RR,Span,WF) :-
248 real_binop_wf(log,RX,RY,RR,Span,WF).
249 :- endif.
250
251 % ---- other binary predicates
252
253 'RLT'(RX,RY,RR,WF) :-
254 real_comp_wf('<',RX,RY,RR,WF).
255
256 'REQ'(RX,RY,RR,WF) :-
257 real_comp_wf('=:=',RX,RY,RR,WF).
258
259 'RNEQ'(RX,RY,RR,WF) :-
260 real_comp_wf('=\\=',RX,RY,RR,WF). % =\=
261
262 'RLEQ'(RX,RY,RR,WF) :-
263 real_comp_wf('=<',RX,RY,RR,WF).
264
265 'RGT'(RY,RX,RR,WF) :-'RLT'(RX,RY,RR,WF).
266
267 'RGEQ'(RY,RX,RR,WF) :-'RLEQ'(RX,RY,RR,WF).
268
269 % set operators
270
271 'RMAXIMUM'(Set,Res,Span,WF) :-
272 real_maximum_of_set(Set,Res,Span,WF).
273 'RMINIMUM'(Set,Res,Span,WF) :-
274 real_minimum_of_set(Set,Res,Span,WF).
275
276 % ---- Float operators
277
278 'RNEXT'(Nr,NextNr) :-
279 is_next_larger_float(Nr,NextNr).
280 'RPREV'(Nr,NextNr) :-
281 is_next_smaller_float(Nr,NextNr).
282