1:- module(units, [
2 op(600, xfx, as),
3 op(600, xfx, in),
4 op(500, fy, quantity),
5 op(100, yf, []),
6 op(99, xfy, :),
7 alias/2,
8 dimension_symbol/2,
9 kind/1,
10 quantity_character/2,
11 quantity_formula/2,
12 quantity_parent/2,
13
14 prefix/3,
15 absolute_point_origin/2,
16 no_space_before_unit_symbol/1,
17 prefix/3,
18 relative_point_origin/2,
19 unit_kind/2,
20 unit_symbol/2,
21 unit_symbol_formula/3,
22
23 qeval/1
24]). 25:- reexport([units/q]). 26
27:- use_module(library(dcg/high_order)). 28:- use_module(library(clpBNR)). 29:- use_module(library(error)). 30
31:- multifile alias/2. 32:- multifile dimension_symbol/2. 33:- multifile kind/1. 34:- multifile quantity_character/2. 35:- multifile quantity_formula/2. 36:- multifile quantity_parent/2. 37
38:- multifile absolute_point_origin/2. 39:- multifile no_space_before_unit_symbol/1. 40:- multifile prefix/3. 41:- multifile relative_point_origin/2. 42:- multifile unit_kind/2. 43:- multifile unit_symbol/2. 44:- multifile unit_symbol_formula/3. 45
46units:dimension_symbol(dim_1, '').
47units:quantity_parent(1, dim_1).
48units:unit_kind(1, 1).
49
50:- use_module(units/q). 51:- use_module(units/systems/isq). 52:- use_module(units/systems/si). 53:- use_module(units/systems/angular). 54:- use_module(units/systems/cgs). 55:- use_module(units/systems/hep). 56:- use_module(units/systems/iau). 57:- use_module(units/systems/iec). 58:- use_module(units/systems/imperial). 59:- use_module(units/systems/international). 60:- use_module(units/systems/usc). 61
62user:portray(Q) :-
63 is_dict(Q, q),
64 get_dict(v, Q, V),
65 get_dict(q, Q, Quantity),
66 get_dict(u, Q, U),
67 !,
68 format("~p * ~p[~p]", [V, Quantity, U]).
69
70is_quantity(Term) :-
71 is_dict(Term, q),
72 get_dict(q, Term, Q),
73 ( var(Q)
74 -> true
75 ; Q = kind_of(K)
76 -> derived_root_kind(K)
77 ; alias_derived_quantity(Q)
78 ),
79 get_dict(u, Term, U),
80 ( var(U)
81 -> true
82 ; normalize_unit(U, _)
83 ),
84 get_dict(v, Term, _).
85error:has_type(q:Quantity, Term) :-
86 ( alias_derived_quantity(Quantity)
87 -> true
88 ; domain_error(quantity, Quantity)
89 ),
90 is_quantity(Term),
91 implicitly_convertible(Term.q, Quantity).
92
93parse(A*B) ==>
94 parse(A), parse(B).
95parse(A/B) ==>
96 parse(A),
97 { phrase(parse(B), L) },
98 sequence(inverse, L).
99parse((A*B)**N) ==>
100 parse(A**N*B**N).
101parse((A/B)**N) ==>
102 parse(A**N/B**N).
103parse((A**N1)**N2) ==>
104 { N is N1 * N2 },
105 parse(A**N).
106parse(dim_1) ==>
107 [].
108parse(dim_1**_) ==>
109 [].
110parse(A**N) ==>
111 [A-N].
112parse(A) ==>
113 [A-1].
114
115inverse(A-N) -->
116 { N1 is -N },
117 [A-N1].
118
119aggregate(L, L2) :-
120 group_pairs_by_key(L, Groups),
121 maplist([A-Ns, A-N]>>sum_list(Ns, N), Groups, L1),
122 simplify(L1, L2).
123
124identity(_-0, _) => fail.
125identity(1-_, _) => fail.
126identity(A, R) => R = A.
127simplify(L, L1) :-
128 convlist(identity, L, L1).
129
130num_denom([], Denom, Expr) :-
131 denom(Denom, 1, Expr).
132num_denom([H | T], Denom, Expr) :-
133 multiply([H | T], Num),
134 denom(Denom, Num, Expr).
135
136denom([], Num, Num).
137denom([H | T], Num, Num/Expr) :-
138 multiply([H | T], Expr).
139
140multiply([H | T], Expr) :-
141 foldl([B, A, A*B]>>true, T, H, Expr).
142
143normalize(In, Out) :-
144 phrase(parse(In), L),
145 normalize_factors(L, L1),
146 generate_expression(L1, Out).
147
148is_num(_-N) => N > 0.
149
150power(A-1, Res) => Res = A.
151power(A-N, Res) => Res = A**N.
152
153generate_expression(In, Out) :-
154 partition(is_num, In, Num, Denom),
155 maplist(power, Num, Num1),
156 phrase(sequence(inverse, Denom), Denom1),
157 maplist(power, Denom1, Denom2),
158 num_denom(Num1, Denom2, Out).
159
160parse_normalize_factors(In, L3) :-
161 phrase(parse(In), L),
162 normalize_factors(L, L3).
163normalize_factors(L, L2) :-
164 msort(L, L1),
165 aggregate(L1, L2).
166
167:- meta_predicate mapexpr(1, ?). 168
169mapexpr(Goal, A) :-
170 mapexpr1(Goal, [_]>>true, A).
171
172:- meta_predicate mapexpr1(1, 1, ?). 173
174mapexpr1(Goal, F, A*B) =>
175 mapexpr1(Goal, F, A),
176 mapexpr1(Goal, F, B).
177mapexpr1(Goal, F, A/B) =>
178 mapexpr1(Goal, F, A),
179 mapexpr1(Goal, F, B).
180mapexpr1(Goal, F, A**_) =>
181 mapexpr1(Goal, F, A).
182mapexpr1(Goal, Failure, A) =>
183 ( call(Goal, A)
184 *-> true
185 ; call(Failure, A)
186 ).
187
188:- meta_predicate mapexpr(2, ?, ?). 189
190mapexpr(Goal, A, R) :-
191 mapexpr(Goal, =, A, R).
192
193:- meta_predicate mapexpr(2, 2, ?, ?). 194
195mapexpr(Goal, F, A*B, R) =>
196 mapexpr(Goal, F, A, A1),
197 mapexpr(Goal, F, B, B1),
198 R = A1*B1.
199mapexpr(Goal, F, A/B, R) =>
200 mapexpr(Goal, F, A, A1),
201 mapexpr(Goal, F, B, B1),
202 R = A1/B1.
203mapexpr(Goal, F, A**B, R) =>
204 mapexpr(Goal, F, A, A1),
205 R = A1**B.
206mapexpr(Goal, Failure, A, A1) =>
207 ( call(Goal, A, A1)
208 *-> true
209 ; call(Failure, A, A1)
210 ).
211
212common_expr(Type, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) :-
213 parse_normalize_factors(Unit1, F1),
214 parse_normalize_factors(Unit2, F2),
215 once(iterative_deepening(1,
216 {F1, NewF1, Type, NewUnits, F2, NewF2}/[N]>>common_factors(
217 F1, NewF1, Type, NewUnits, N, F2, NewF2))),
218 msort(NewUnits, SortedNewUnits),
219 maplist(generate_expression, [NewF1, NewF2, SortedNewUnits],
220 [NewFactor1, NewFactor2, NewUnit]).
221
222iterative_deepening(Limit, Goal) :-
223 N = n(no),
224 ( call(Goal, Limit-N)
225 -> true
226 ; ( N = n(depth_limit_exceeded)
227 -> Limit1 is Limit + 1,
228 iterative_deepening(Limit1, Goal)
229 ; fail
230 )
231 ).
232
233is_of(unit, U-_) :-
234 ground(U),
235 unit(U, _).
236is_of(quantity, Q-_) :-
237 ground(Q),
238 alias_quantity(Q).
239
240common_factors(L1, R1, Type, L, N, L2, R2) :-
241 partition(is_of(Type), L1, Unit1, Factor1),
242 partition(is_of(Type), L2, Unit2, Factor2),
243 ord_intersection(Unit1, Unit2, CommonUnits, Unit2Only),
244 ord_subtract(Unit1, Unit2, Unit1Only),
245 append(CommonUnits, R, L),
246 append(Factor1, R11, R1),
247 append(Factor2, R22, R2),
248 expand_either_factors(Unit1Only, R11, Type, R, N, Unit2Only, R22).
249expand_either_factors([], [], _, [], _-N, [], []) :-
250 setarg(1, N, no).
251expand_either_factors(L1, R1, Type, L, Limit-N, L2, R2) :-
252 ( Limit > 0
253 -> Limit1 is Limit - 1
254 ; nb_setarg(1, N, depth_limit_exceeded),
255 fail
256 ),
257 ( phrase(select_factor(L1, R1, Type, L, Limit1-N), L2, R2)
258 ; phrase(select_factor(L2, R2, Type, L, Limit1-N), L1, R1)
259 ).
260select_factor(L1, R1, Type, L, N) -->
261 select(A),
262 expand_factors(Type, A),
263 normalize_factors,
264 common_factors(L1, R1, Type, L, N).
265
266expand_factors(Type, A), Factors -->
267 { expand_factor(Type, A, Factors) }.
268expand_factor(Type, Unit-N, Factors) :-
269 ( Type == unit
270 -> unit(Unit, _, Formula)
271 ; Type == quantity,
272 alias_or_quantity_parent(Unit, Formula)
273 ),
274 parse_normalize_factors(Formula**N, Factors).
275
276:- table alias_quantity_parent/2. 277
278alias_quantity_parent(Quantity, Parent) :-
279 quantity_parent(Quantity, Parent),
280 \+ dimension_symbol(Parent, _).
281alias_quantity_parent(Alias, Parent) :-
282 alias(Alias, Quantity),
283 alias_quantity_parent(Quantity, Parent).
284
285:- table alias_quantity_/1. 286
287alias_quantity_(Quantity) :-
288 alias_base_quantity(Quantity).
289alias_quantity_(Quantity) :-
290 alias_quantity_parent(Quantity, _).
291
292alias_quantity(Quantity), \+ ground(Quantity) =>
293 when(ground(Quantity), alias_quantity(Quantity)).
294alias_quantity(Quantity) =>
295 alias_quantity_(Quantity).
296
297alias_derived_quantity(Quantity), \+ ground(Quantity) =>
298 when(ground(Quantity), alias_derived_quantity(Quantity)).
299alias_derived_quantity(Quantity) =>
300 mapexpr(alias_quantity, Quantity).
301
302alias_parent(Alias, Parent) :-
303 alias(Alias, Quantity),
304 ( alias_quantity_parent(Quantity, Parent)
305 ; base_quantity(Quantity), Parent = Quantity
306 ).
307
308:- table alias_or_quantity_parent/2. 309
310alias_or_quantity_parent(Quantity, Parent) :-
311 quantity_parent(Quantity, Parent),
312 \+ dimension_symbol(Parent, _).
313alias_or_quantity_parent(Alias, Quantity) :-
314 alias(Alias, Quantity),
315 alias_quantity(Quantity).
316
317:- table alias_quantity_formula/2. 318
319alias_quantity_formula(Quantity, Formula) :-
320 quantity_formula(Quantity, Formula).
321alias_quantity_formula(Alias, Formula) :-
322 alias(Alias, Quantity),
323 alias_quantity_formula(Quantity, Formula).
324
325derived_quantity(_*_).
326derived_quantity(_/_).
327derived_quantity(_**_).
328
329base_quantity(Quantity) :-
330 quantity_parent(Quantity, Dimension),
331 dimension_symbol(Dimension, _).
332
333:- table alias_base_quantity/1. 334
335alias_base_quantity(Quantity) :-
336 base_quantity(Quantity).
337alias_base_quantity(Alias) :-
338 alias(Alias, Quantity),
339 alias_base_quantity(Quantity).
340
341:- table root/1. 342
343root(BaseQuantity) :-
344 base_quantity(BaseQuantity).
345root(Quantity) :-
346 quantity_parent(Quantity, DerivedQuantity),
347 derived_quantity(DerivedQuantity).
348
349:- table quantity_dimensions/2. 350
351quantity_dimensions(Dimension, Dimension) :-
352 dimension_symbol(Dimension, _).
353quantity_dimensions(Quantity, Dimensions) :-
354 alias(Quantity, Parent),
355 quantity_dimensions(Parent, Dimensions).
356quantity_dimensions(Quantity, Dimensions) :-
357 quantity_parent(Quantity, Parent),
358 quantity_dimensions(Parent, Dimensions).
359quantity_dimensions(Quantity, Dimensions) :-
360 derived_quantity(Quantity),
361 mapexpr(quantity_dimensions, Quantity, Dimensions).
362
363factors_dimensions(Factor, Dimensions) :-
364 generate_expression([Factor], Quantity),
365 quantity_dimensions(Quantity, Dimension),
366 parse_normalize_factors(Dimension, Dimensions).
367
368simplify_dimensions(Quantity, R) :-
369 parse_normalize_factors(Quantity, Factors),
370 maplist(factors_dimensions, Factors, Dimensions),
371 pairs_keys_values(Pairs, Factors, Dimensions),
372 phrase(simplify_dimension_pairs, Pairs, SimplifiedPairs),
373 pairs_keys(SimplifiedPairs, SimplifiedFactors),
374 generate_expression(SimplifiedFactors, R).
375simplify_dimension_pairs -->
376 select(_-A),
377 { maplist(is_inverse, A, B) },
378 select(_-B),
379 !,
380 simplify_dimension_pairs.
381simplify_dimension_pairs -->
382 [].
383
384is_inverse(Q-N1, Q-N2) :-
385 N2 is -N1.
386
387:- table root_kind/1. 388
389root_kind(Kind) :-
390 kind(Kind).
391root_kind(Root) :-
392 root(Root).
393
394:- table derived_root_kind_/1. 395
396derived_root_kind_(Kind) :-
397 mapexpr([X, X]>>root_kind(X), [X, _]>>domain_error(root_kind, X), Kind, Kind).
398
399derived_root_kind(Kind), \+ ground(Kind) =>
400 when(ground(Kind), derived_root_kind(Kind)).
401derived_root_kind(Kind) =>
402 derived_root_kind_(Kind).
403
404:- table quantity_kind/2. 405
406quantity_kind(kind_of(Kind), Kind).
407quantity_kind(Kind, Kind) :-
408 root_kind(Kind).
409quantity_kind(Quantity, Kind) :-
410 alias_or_quantity_parent(Quantity, Parent),
411 quantity_kind(Parent, Kind).
412
413derived_quantity_kind(Quantity, Kind) :-
414 mapexpr(quantity_kind, [_, 1]>>true, Quantity, Kind).
415
416common_quantity(Q1, Q2, Q), Q1=Q2 =>
417 Q2 = Q.
418common_quantity(kind_of(Q1), kind_of(Q2), Q) =>
419 simplify_dimensions(Q1, K1),
420 simplify_dimensions(Q2, K2),
421 common_quantity(K1, K2, Q3),
422 ( K1 == Q3
423 -> Q = kind_of(Q2)
424 ; K2 == Q3
425 -> Q = kind_of(Q1)
426 ; Q = Q3
427 ).
428common_quantity(kind_of(Q1), Q2, Q) =>
429 simplify_dimensions(Q1, K1),
430 common_quantity(K1, Q2, Q3),
431 ( K1 == Q3
432 -> Q = Q2
433 ; Q = Q3
434 ).
435common_quantity(Q1, kind_of(Q2), Q) =>
436 common_quantity(kind_of(Q2), Q1, Q).
437common_quantity(Q1, Q2, Q) =>
438 common_expr(quantity, Q1, 1, Q2, 1, Q).
439
440same_kind(Q1, Q2), Q1 = Q2 => true.
441same_kind(Q1, Q2) =>
442 derived_quantity_kind(Q1, K1),
443 derived_quantity_kind(Q2, K2),
444 common_quantity(K1, K2, K),
445 ( (K1 == K ; K2 == K)
446 -> true
447 ).
448
459implicitly_convertible(From, To, Explicit) :-
460 normalize(To, NormalizedTo),
461 mapexpr(alias_parent, NormalizedTo, AliasNormalizedTo),
462 common_quantity(From, AliasNormalizedTo, CommonQuantity),
463 ( AliasNormalizedTo = kind_of(_), CommonQuantity = From
464 ; CommonQuantity = AliasNormalizedTo
465 ),
466 ( Explicit == false, quantity_kind(From, FromKind), kind(FromKind)
467 -> common_quantity(FromKind, AliasNormalizedTo, FromKind)
468 ; true
469 ),
470 !.
471implicitly_convertible(From, ToKind, Explicit) :-
472 root_kind(ToKind),
473 alias_quantity_parent(ToKind, Formula),
474 implicitly_convertible(From, Formula, Explicit),
475 derived_quantity_kind(From, FromKind),
476 normalize(FromKind, NormalizedFromKind),
477 common_quantity(NormalizedFromKind, ToKind, CommonKind),
478 ( (CommonKind == NormalizedFromKind ; CommonKind == ToKind)
479 -> true
480 ),
481 !.
482implicitly_convertible(From, To, _) :-
483 alias_quantity_formula(To, Formula),
484 implicitly_convertible(From, Formula).
485
486implicitly_convertible(From, To), unifiable(From, To, _) =>
487 From = To.
488implicitly_convertible(From, To) =>
489 implicitly_convertible(From, To, false).
490
491explicitly_convertible(From, To), unifiable(From, To, _) =>
492 From = To.
493explicitly_convertible(From, To) =>
494 explicitly_convertible_(From, To).
495
496:- table explicitly_convertible_/2. 497
498explicitly_convertible_(From, To) :-
499 implicitly_convertible(From, To, true).
500explicitly_convertible_(From, To) :-
501 implicitly_convertible(To, From, true).
502
503:- table alias_or_unit_symbol/2. 504
505alias_or_unit_symbol(Unit, Symbol) :-
506 ( unit_symbol(Unit, Symbol)
507 ; unit_symbol_formula(Unit, Symbol, _)
508 ).
509alias_or_unit_symbol(Alias, Symbol) :-
510 alias(Alias, Unit),
511 alias_or_unit_symbol(Unit, Symbol).
512
513:- table alias_unit_symbol_formula/3. 514
515alias_unit_symbol_formula(Unit, Symbol, Formula) :-
516 unit_symbol_formula(Unit, Symbol, Formula).
517alias_unit_symbol_formula(Alias, Symbol, Unit) :-
518 alias(Alias, Unit),
519 alias_or_unit_symbol(Unit, Symbol).
520
521:- table has_prefix/2. 522
523has_prefix(Module:PrefixUnit, Symbol) :-
524 prefix(Module:Prefix, PrefixSymbol, _),
525 PrefixUnit =.. [Prefix, Unit],
526 ( alias_or_unit_symbol(Unit, UnitSymbol),
527 atom_concat(PrefixSymbol, UnitSymbol, Symbol)
528 -> true
529 ; domain_error("has_prefix", Module:PrefixUnit-Symbol)
530 ).
531has_prefix(Alias, Symbol) :-
532 alias(Alias, Unit),
533 has_prefix(Unit, Symbol).
534
535:- table prefix_unit_symbol_formula/3. 536
537prefix_unit_symbol_formula(Module:PrefixUnit, Symbol, PrefixFormula*Unit) :-
538 \+ compound(Symbol),
539 prefix(Module:Prefix, PrefixSymbol, PrefixFormula),
540 PrefixUnit =.. [Prefix, Unit],
541 alias_or_unit_symbol(Unit, UnitSymbol),
542 \+ has_prefix(Unit, UnitSymbol),
543 atom_concat(PrefixSymbol, UnitSymbol, Symbol).
544
545:- table alias_prefix_unit_symbol_formula/3. 546
547alias_prefix_unit_symbol_formula(PrefixUnit, Symbol, Formula) :-
548 prefix_unit_symbol_formula(PrefixUnit, Symbol, Formula).
549alias_prefix_unit_symbol_formula(Alias, Symbol, Formula) :-
550 alias(Alias, Unit),
551 alias_prefix_unit_symbol_formula(Unit, Symbol, Formula).
552
553:- table unit/3. 554
555unit(U, S, F) :-
556 ( alias_unit_symbol_formula(U, S, F)
557 ; alias_prefix_unit_symbol_formula(U, S, F)
558 ).
559
560:- table unit/2. 561
562unit(U, S) :-
563 ( unit_symbol(U, S)
564 ; unit(U, S, _)
565 ).
566
567all_unit_kind(Unit, R), unit_kind(Unit, Kind) =>
568 R = kind_of(Kind).
569all_unit_kind(Unit, R), unit(Unit, _, Formula) =>
570 all_unit_kind(Formula, R).
571all_unit_kind(Unit, R), derived_quantity(Unit) =>
572 mapexpr(all_unit_kind, [_, 1]>>true, Unit, Kind),
573 normalize(Kind, NKind),
574 normalize_kind(NKind, R).
575all_unit_kind(_, _) => fail.
576
577common_unit(Unit1, NewFactor1, Unit2, NewFactor2, NewUnit), unifiable(Unit1, Unit2, _) =>
578 Unit1 = Unit2,
579 NewFactor1 = 1,
580 NewFactor2 = 1,
581 NewUnit = Unit2.
582common_unit(Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) =>
583 common_expr(unit, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit).
584
585comparable(AB, R) :-
586 AB =.. [Op, A, B],
587 eval_(A, A1),
588 eval_(B, B1),
589 ( same_kind(A1.q, B1.q), common_quantity(A1.q, B1.q, Q)
590 -> ( common_unit(A1.u, AV, B1.u, BV, U)
591 -> ( Op == is
592 -> A1.v = A2,
593 normalize(B1.v*BV/AV, B2)
594 ; normalize(A1.v*AV, A2),
595 normalize(B1.v*BV, B2)
596 ),
597 V =.. [Op, A2, B2],
598 R = q{v: V, u: U, q: Q}
599 ; domain_error(A1.u, B1.u)
600 )
601 ; domain_error(A1.q, B1.q)
602 ).
603
604normalize_unit(Unit, R), var(Unit), ground(R) =>
605 Unit = R.
606normalize_unit(Unit, R), var(Unit), var(R) =>
607 when((ground(Unit) ; ground(R)), normalize_unit(Unit, R)).
608normalize_unit(Unit, R), unit(Unit, _) =>
609 R = Unit.
610normalize_unit(Symbol, R), unit(Unit, Symbol) =>
611 R = Unit.
612normalize_unit(Unit, R), unit(Module:Unit, _) =>
613 R = Module:Unit.
614normalize_unit(Module:Symbol, R), unit(Module:Unit, Symbol) =>
615 R = Module:Unit.
616normalize_unit(Module:PrefixUnit, R),
617 PrefixUnit =.. [Prefix, Unit],
618 prefix(Module:Prefix, _, _) =>
619 normalize_unit(Unit, R1),
620 R2 =.. [Prefix, R1],
621 R = Module:R2.
622normalize_unit(PrefixUnit, R),
623 PrefixUnit =.. [Prefix, Unit],
624 prefix(Module:Prefix, _, _) =>
625 normalize_unit(Unit, R1),
626 R2 =.. [Prefix, R1],
627 R = Module:R2.
628normalize_unit(U, R), derived_quantity(U) =>
629 mapexpr(normalize_unit, U, R).
630normalize_unit(_, _) => fail.
631
632normalize_kind(kind_of(A)**N1/kind_of(B)**N2, R) =>
633 normalize(A**N1/B**N2, AB),
634 R = kind_of(AB).
635normalize_kind(kind_of(A)/kind_of(B)**N, R) =>
636 normalize(A/B**N, AB),
637 R = kind_of(AB).
638normalize_kind(kind_of(A)**N/kind_of(B), R) =>
639 normalize(A**N/B, AB),
640 R = kind_of(AB).
641normalize_kind(kind_of(A)/kind_of(B), R) =>
642 normalize(A/B, AB),
643 R = kind_of(AB).
644normalize_kind(kind_of(A)*kind_of(B), R) =>
645 normalize(A*B, AB),
646 R = kind_of(AB).
647normalize_kind(kind_of(A)**N, R) =>
648 normalize(A**N, AN),
649 R = kind_of(AN).
650normalize_kind(kind_of(A)/1, R) =>
651 R = kind_of(A).
652normalize_kind(1/kind_of(A), R) =>
653 normalize(1/A, AN),
654 R = kind_of(AN).
655normalize_kind(kind_of(A)*1, R) =>
656 R = kind_of(A).
657normalize_kind(1*kind_of(A), R) =>
658 R = kind_of(A).
659normalize_kind(kind_of(A)/B, R) =>
660 normalize(A/B, R).
661normalize_kind(A/kind_of(B), R) =>
662 normalize(A/B, R).
663normalize_kind(kind_of(A)*B, R) =>
664 normalize(A*B, R).
665normalize_kind(A*kind_of(B), R) =>
666 normalize(A*B, R).
667normalize_kind(A, R) =>
668 normalize(A, R).
669
670qeval((A, B)) =>
671 qeval(A),
672 qeval(B).
673qeval(Expr) =>
674 eval_(Expr, Q),
675 V = Q.v,
676 ( \+ V = {_},
677 ( V = (_ is Expr), \+ ground(Expr)
678 ; \+ ground(V)
679 )
680 -> call({Q.v})
681 ; call(Q.v)
682 ).
683eval_({ExprIn}, R) =>
684 eval_(ExprIn, ExprOut),
685 R = ExprOut.put(v, {ExprOut.v}).
686eval_(Result is ExprIn, R) =>
687 comparable(quantity Result is ExprIn, R).
688eval_(+A, R) =>
689 eval_(A, A1),
690 R = A1.put(v, +A1.v).
691eval_(-A, R) =>
692 eval_(A, A1),
693 R = A1.put(v, -A1.v).
694eval_(A+B, R) =>
695 comparable(A+B, R).
696eval_(A-B, R) =>
697 comparable(A-B, R).
698eval_(A=:=B, R) =>
699 comparable(A=:=B, R).
700eval_(A=\=B, R) =>
701 comparable(A=\=B, R).
702eval_(A<B, R) =>
703 comparable(A<B, R).
704eval_(A>B, R) =>
705 comparable(A>B, R).
706eval_(A=<B, R) =>
707 comparable(A=<B, R).
708eval_(A>=B, R) =>
709 comparable(A>=B, R).
710eval_(A*B, R) =>
711 eval_(A, A1),
712 eval_(B, B1),
713 normalize_kind(A1.q*B1.q, Q),
714 normalize(A1.u*B1.u, U),
715 normalize(A1.v*B1.v, V),
716 R = q{v: V, q: Q, u: U}.
717eval_(A/B, R) =>
718 eval_(A, A1),
719 eval_(B, B1),
720 normalize_kind(A1.q/B1.q, Q),
721 normalize(A1.u/B1.u, U),
722 normalize(A1.v/B1.v, V),
723 R = q{v: V, q: Q, u: U}.
724eval_(A**N, R) =>
725 eval_(A, A1),
726 normalize_kind(A1.q**N, Q),
727 normalize(A1.u**N, U),
728 normalize(A1.v**N, V),
729 R = q{v: V, q: Q, u: U}.
730eval_(A^N, R) =>
731 eval_(A**N, R).
732eval_(in(Expr, Unit), R) =>
733 eval_(Expr, M),
734 eval_(Unit, Q),
735 ( implicitly_convertible(M.q, Q.q)
736 -> common_unit(M.u, F1, Q.u, F2, _),
737 normalize(M.v*F1/F2, V1),
738 ( ground(V1)
739 -> V is V1
740 ; {V == V1}
741 ),
742 R = q{v: V, q: M.q, u: Q.u}
743 ; domain_error(M.q, Q.q)
744 ).
745eval_(as(Expr, Quantity), R), alias_derived_quantity(Quantity) =>
746 eval_(Expr, M),
747 ( implicitly_convertible(M.q, Quantity)
748 -> R = M.put(q, Quantity)
749 ; domain_error(M.q, Quantity)
750 ).
751eval_(force_as(Expr, Quantity), R), alias_derived_quantity(Quantity) =>
752 eval_(Expr, M),
753 ( explicitly_convertible(M.q, Quantity)
754 -> R = M.put(q, Quantity)
755 ; domain_error(M.q, Quantity)
756 ).
757eval_(cast(Expr, Quantity), R), alias_derived_quantity(Quantity) =>
758 eval_(Expr, M),
759 ( common_quantity(M.q, Quantity, _)
760 -> R = M.put(q, Quantity)
761 ; domain_error(M.q, Quantity)
762 ).
763eval_(kind_of(Kind), R), derived_root_kind(Kind) =>
764 R = q{v: _, q: kind_of(Kind), u: _}.
765eval_(pi, R) =>
766 R = q{v: pi, q: 1, u: 1}.
767eval_(random_float, R) =>
768 R = q{v: random_float, q: 1, u: 1}.
769eval_(q:X, R), alias_derived_quantity(X) =>
770 R = q{v: _, q: X, u: _}.
771eval_(u:X, R) =>
772 normalize_unit(X, U),
773 when(ground(U), all_unit_kind(U, kind_of(UKind))),
774 when((ground(UKind), ground(Q)), implicitly_convertible(kind_of(UKind), Q)),
775 R = q{v: 1, q: Q, u: U}.
776eval_(quantity(Quantity), R) =>
777 eval_(_*q:_[u:_], Quantity),
778 R = Quantity.
779eval_(QuantityExpr[UnitExpr], R) =>
780 eval_(QuantityExpr, R),
781 eval_(UnitExpr, Unit),
782 ( implicitly_convertible(Unit.q, R.q)
783 -> true
784 ; domain_error(Unit.q, R.q)
785 ),
786 R.v = Unit.v,
787 R.u = Unit.u.
788eval_(X, R), var(X) =>
789 R = q{v: X, q: 1, u: 1}.
790eval_(Q, R), is_dict(Q, q) =>
791 R = Q.
792eval_(N, R), number(N) =>
793 R = q{v: N, q: 1, u: 1}.
794eval_(UnitOrSymbol, R), ground(UnitOrSymbol), normalize_unit(UnitOrSymbol, Unit) =>
795 all_unit_kind(Unit, Kind),
796 R = q{v: 1, q: Kind, u: Unit}.
797eval_(Quantity, R), ground(Quantity), alias_quantity(Quantity) =>
798 R = q{v: _, q: Quantity, u: _}.
799
800:- begin_tests(units). 801
802qeval_data(si:metre =:= si:metre).
803qeval_data(si:kilo(metre) =:= si:kilo(metre)).
804qeval_data(si:kilogram =:= si:kilo(gram)).
805qeval_data(si:kg =:= si:kilo(gram)).
806qeval_data(10*(si:kilo(metre)) =:= 5*2*(si:kilo(metre))).
807qeval_data(10*(si:kilo(metre)) / 2 =:= 5*(si:kilo(metre))).
808qeval_data(1 * (si:hour) =:= 3600 * (si:second)).
809qeval_data(1 * (si:kilo(metre)) + 1 * (si:metre) =:= 1001 * (si:metre)).
810qeval_data(1 * (si:kilo(metre)) / (1 * (si:second)) =:= 1000 * (si:metre) / (si:second)).
811qeval_data(2 * (si:kilo(metre)) / (si:hour) * (2 * (si:hour)) =:= 4 * (si:kilo(metre))).
812qeval_data(2 * (si:kilo(metre)) / (2 * (si:kilo(metre)) / (si:hour)) =:= 1 * (si:hour)).
813qeval_data(2 * (si:metre) * (3 * (si:metre)) =:= 6 * (si:metre)**2).
814qeval_data(10 * (si:kilo(metre)) / (5 * (si:kilo(metre))) =:= 2).
815qeval_data(1000 / (1 * (si:second)) =:= 1 * (si:kilo(hertz))).
816qeval_data(1001 / (1 * (si:second)) =\= 1 * (si:kilo(hertz))).
817qeval_data(si:metre < si:kilo(metre)).
818qeval_data(si:metre =< si:kilo(metre)).
819qeval_data(si:metre > si:centi(metre)).
820qeval_data(si:metre >= si:centi(metre)).
821
822test('qeval', [forall(qeval_data(Expr))]) :-
823 qeval(Expr).
824
825fail_qeval_data(1001 / (1 * (si:second)) =:= 1 * (si:kilo(hertz))).
826
827test('fail_qeval', [forall(fail_qeval_data(Expr)), fail]) :-
828 qeval(Expr).
829
830error_qeval_data(si:hertz =:= si:becquerel).
831error_qeval_data(_ is si:hertz + si:becquerel).
832
833test('error_qeval', [forall(error_qeval_data(Expr)), error(domain_error(_, _))]) :-
834 qeval(Expr).
835
836implicitly_convertible_data(isq:width, isq:length).
837implicitly_convertible_data(isq:radius, isq:width).
838implicitly_convertible_data(isq:radius, isq:length).
839implicitly_convertible_data(isq:mass*isq:length**2/isq:time**2, isq:energy).
840implicitly_convertible_data(isq:mass*isq:height**2/isq:time**2, isq:energy).
841implicitly_convertible_data(isq:height**2*isq:mass/isq:time**2, isq:energy).
842implicitly_convertible_data(isq:mass*isq:speed**2, isq:kinetic_energy).
843implicitly_convertible_data(kind_of(isq:length), isq:height).
844implicitly_convertible_data(isq:acceleration, isq:speed/isq:time).
845implicitly_convertible_data(kind_of(isq:length/isq:time**2), isq:acceleration).
846implicitly_convertible_data(kind_of(isq:length/isq:time**2), isq:velocity/isq:duration).
847implicitly_convertible_data(kind_of(isq:time*isq:frequency), isq:rotation).
848implicitly_convertible_data(kind_of(isq:time*isq:frequency), kind_of(isq:rotation)).
849implicitly_convertible_data(kind_of(isq:time*isq:frequency), kind_of(isq:angular_measure)).
850implicitly_convertible_data(kind_of(isq:rotation/isq:frequency), kind_of(isq:time)).
851
852test('implicitly_convertible', [forall(implicitly_convertible_data(Q1, Q2))]) :-
853 implicitly_convertible(Q1, Q2).
854
856explicitly_convertible_data(isq:length, isq:width).
857explicitly_convertible_data(isq:width, isq:radius).
858explicitly_convertible_data(isq:length, isq:radius).
859explicitly_convertible_data(isq:energy, isq:mechanical_energy).
860explicitly_convertible_data(isq:length, isq:height).
861explicitly_convertible_data(isq:mass*isq:length**2/isq:time**2, isq:mechanical_energy).
862explicitly_convertible_data(isq:angular_measure, 1).
863explicitly_convertible_data(isq:speed/isq:time, isq:acceleration).
864
865not_implicitly_convertible_data(isq:time*isq:frequency, isq:rotation).
866
867test('not_implicitly_convertible(explicit_data)', [forall(explicitly_convertible_data(Q1, Q2)), fail]) :-
868 implicitly_convertible(Q1, Q2).
869test('not_implicitly_convertible', [forall(not_implicitly_convertible_data(Q1, Q2)), fail]) :-
870 implicitly_convertible(Q1, Q2).
871
872common_quantity_data(isq:width, isq:height, isq:length).
873common_quantity_data(isq:thickness, isq:radius, isq:width).
874common_quantity_data(isq:distance, isq:path_length, isq:path_length).
875common_quantity_data(1, 1, 1).
876common_quantity_data(1, isq:rotation, 1).
877common_quantity_data(kind_of(isq:length), kind_of(isq:length), kind_of(isq:length)).
878common_quantity_data(isq:width, kind_of(isq:length), isq:width).
879
880test('common_quantity', [forall(common_quantity_data(Q1, Q2, Q))]) :-
881 common_quantity(Q1, Q2, Q).
882
883test('explicitly_convertible', [forall(implicitly_convertible_data(Q1, Q2))]) :-
884 explicitly_convertible(Q1, Q2).
885
886test('explicitly_convertible', [forall(explicitly_convertible_data(Q1, Q2))]) :-
887 explicitly_convertible(Q1, Q2).
888
889not_explicitly_convertible_data(isq:height, isq:width).
890not_explicitly_convertible_data(isq:time, isq:length).
891not_explicitly_convertible_data(isq:frequency, isq:activity).
892not_explicitly_convertible_data(kind_of(isq:frequency), kind_of(isq:activity)).
893not_explicitly_convertible_data(isq:mass*isq:height**2/isq:time**2, isq:mechanical_energy).
894
895test('not_explicitly_convertible', [forall(not_explicitly_convertible_data(Q1, Q2)), fail]) :-
896 explicitly_convertible(Q1, Q2).
897
898avg_speed(Distance, Time, Speed) :-
899 qeval(Speed is Distance / Time as isq:speed).
900
901test('avg_speed') :-
902 avg_speed(220 * isq:distance[si:kilo(metre)], 2 * si:hour, _Speed).
903
904test('in as') :-
905 qeval(_Speed is (m/s in inch/hour) as isq:speed).
906
907as_data(_ is isq:width[m] as isq:length).
908as_data(_ is isq:width[m] / isq:time[s] as isq:speed).
909
910test('as', [forall(as_data(Expr))]) :-
911 qeval(Expr).
912
913error_as_data(_ is isq:length[m] as isq:width).
914
915test('error_as', [forall(error_as_data(Expr)), error(domain_error(_, _))]) :-
916 qeval(Expr).
917
918test('error_in', [error(domain_error(_, _))]) :-
919 qeval(_ is si:hertz in si:becquerel).
920
921test('acceleration') :-
922 qeval(Speed is 60 * isq:velocity[km/hour]),
923 qeval(Duration is 8 * s),
924 qeval(A is (Speed / Duration) as isq:acceleration),
925 qeval(B is A in m/s**2),
926 must_be(q:isq:acceleration, B).
927
928test('clpBNR') :-
929 qeval({A * inch =:= 1 * metre}),
930 A == 5000r127,
931 qeval({B =:= 5000 * gram / (2*gram)}),
932 B == 2500,
933 qeval({C is 1^2}),
934 C == q{q:1, u:1, v:1}.
935
936test('quantity_kind') :-
937 quantity_kind(isq:duration, isq:time).
938
939:- end_tests(units).