Yes, that was a silly idea of mine; not sure why I went down that rabbit-hole. So just need to define watt
as the symbol rather than 'W'
.
@ridgeworks I have published a new version v0.21 which implements your idea of not loading any unit data by default while exporting symbols for imported systems by default.
If you have some time to test and report some feedback I would be grateful
I think I have now done most of the features I wanted to add to this library.
The next step would be to wait for Jan to publish v10 of swi-prolog so that this library can be tested more easily by more people.
âŚ
Although, there is a minor features that the original library has, which I have not implemented which is the quantity character thing.
Basically, some quantities can only be scalars and some quantities can only be vectors (like acceleration).
However, supporting this would mean being able to do array computation which is not provided by swi-prolog.
But I know that the package type_ndarray
from the library arithmetic_function
could work for thisâŚ
I donât really know how hard it would be to integrate type_ndarray
into this library.
Maybe, itâs just about supporting the different operators .+
, .*
etc and use eval/1
to evaluate the expression ?
Iâve done a minimal amount of obvious testing, but I think this does exactly what I was advocating and is a simple model that a naive user like me can understand:
- Load
library(units)
. - Load one or more systems from
library(units/systems)
. The order of loading systems is important because the first instance of a symbol definition is the one that is used. Subsequent definitions generate an ERROR message and are ignored.
For example:
?- [library(units), library(units/systems/si), library(units/systems/cgs)].
% *** clpBNR v0.12.2 ***.
% Arithmetic global flags will be set to prefer rationals and IEEE continuation values.
ERROR: import/1: No permission to import cgs_symbol:(gram/1) into user (already imported from si_symbol)
ERROR: import/1: No permission to import cgs_symbol:(g/1) into user (already imported from si_symbol)
ERROR: import/1: No permission to import cgs_symbol:(s/1) into user (already imported from si_symbol)
ERROR: import/1: No permission to import cgs_symbol:(second/1) into user (already imported from si_symbol)
ERROR: import/1: No permission to import cgs_symbol:('K'/1) into user (already imported from si_symbol)
true.
If thatâs what the user wants, fine, but if they want to use a later definition, they have to âexceptâ earlier ones. IMO thatâs simple and easily explainable.
Itâs interesting that if you load all the systems (with symbols), there are almost 100 clashes. I think a worthwhile objective is to get that number much smaller. Taking the example above, it appears that 4 (out of 5) clashes are because cgs:second
is declared an alias of si:second
and cgs:gram
of si:gram
. Is there a reason for this?
Can you clarify? The pack says version of SWIP must be >= 9.3.23. Whatâs the reason for that dependancy? Why is something greater better? Donât forget that the more versions it runs on (including back versions), the larger the pool of test subjects. Of course you also have to find those who have a need for this kind of thing.
Donât quite understand this statement; I always thought acceleration is a scalar, as in acceleration due to gravity = 9.8*m/s**2
. In any case, I think adding vector support would be lower on my priority list than finding some âmeatyâ applications that demonstrate the value of quantities. Maybe there are some ideas for that from the mp-units
community.
I also think laundering the existing systems along the lines discussed in a previous post (minimize quotes and special characters, âŚ) deserves some effort.
I just wanted to say that before asking for more people to test this library, I need to wait for a release that will be picked up more widely by distributions.
Basically, I canât ask people to compile swi-prolog from source just to test my library.
Thatâs how the unit system was formulated by mp-units.
I did a semi-automatic translation of their code to prolog through a hacky prolog script.
But the idea is that if you want to use the cgs system, you want to use cgs:gram
and not si:gram
although they are the same thing.
I believe that in this case (or in the angular case), there is no good solution.
We canât just decide that one system should have symbols and not the other.
Yes, I am currently going through all the conflicts and try to resolve the most egregious ones.
I will also try to replace special utf-8 character where it makes sense.
Basically, it is like the difference between speed and velocity, where speed is the magnitude of velocity vector. Acceleration is just the derivative of the velocity (and not of the speed).
Here is a better explanation than mine: Speed versus Velocity
I have already done a few examples. Let me know if you think about other examples demonstrating cool things.
Iâm actually thinking of implementing kalman filters with units.
This would be a slightly larger example and an interesting application (in my opinion).
Since I am not an expert, if anyone is interested to help, please contact me !
I also want to update my RPN calculator to use units
Iâm not really aware of the current state. Which version is (at least) required? Development versions are released frequently. Notably some Linux distros are far behind, so there is snap, flatpack or source. There is little alternative
As said by @ridgeworks, this units package requires 9.3.23 because it uses ssu for dcgs ==>
and tabled constraints.
Personally, I would be interested in an update in fedora linux, which the latest version is still 9.2.9.
By the way, Iâm not asking for anything as this is a hobby project, I have no constraints and having only one user (thank you @ridgeworks ) for now is very useful for having meaningful discussion without too much noise.
But if you werenât dependent on features that only existed on the most recent release(s), that situation would already exist, i.e., your library would run on many more existing installations. And unless youâre really on the bleeding edge, or youâre using a distro thatâs way behind (which isnât under SWIPâs control anyway) , Iâm not sure when a source build is actually required.
Have you thought about the impact if these two features werenât used. After all a lot of very useful SWI-Prolog code has been written without them. And if you have any interest in portability, many Prologâs donât even have them.
FWIW, Iâve been through many similar design decisions with clpBNR - generally I wait until a given feature is in a stable release of SWIP before I release a version of clpBNR that depends on it.
Think I understand. If so, this sounds like a benign situation; both systems are exporting what is effectively the same definition. The user can use either; if both systems are loaded both are available.
But the main problem is that the user is faced with these error messages for benign cases and that really isnât very user friendly. A conscientious user might go to a lot of unnecessary work to eliminate the message thinking that it really isnât a benign situation.
So one thought I had was to filter out error messages for benign situations. A code fragment for that, that defines benign in terms of a defined alias situation as above:
:- multifile message_hook/3.
:- dynamic message_hook/3.
:- use_module(library(units),[alias/2,unit_symbol/2]).
user:message_hook(error(permission_error(import_into(_),procedure,M1:(P/1)),Context),error,_) :-
Context = context(import/1,already_from(M2)),
% Assume module S_symbol implies system S
atom_concat(S1,'_symbol',M1),
atom_concat(S2,'_symbol',M2),
(unit_symbol(_:UnitName,P)
-> alias(S1:UnitName,S2:UnitName)
; alias(S1:P,S2:P)
).
This nicely catches this particular use case , but it turns out thatâs a small percentage of the total - in most cases the conflicts are legit and require resolution by the user. A couple of examples:
units:unit_symbol_formula(si:steradian,sr,(si:metre)**2/(si:metre)**2).
units:unit_symbol_formula(angular:steradian,sr,(angular:radian)**2).
units:unit_symbol_formula(usc:gallon,gal,231*(usc:inch)**3).
units:unit_symbol_formula(cgs:gal,'Gal',(cgs:centimetre)/(cgs:second)**2).
Aside:The cgs:gal
doesnât make much sense to me casts some doubt on the validity of the input data, but thatâs a different issue.
So what is the derivative of speed with respect to time called? And whatâs the connection with arrays?
It appears youâre trying to combine some sort of spatial position information with quantities; is that really a job that library(units)
needs to address? Put another way, are velocity and acceleration pure quantities or a combination of a quantity and something else?
Quickly, yes.
I wanted to test these new features because I wanted to use them for a really long time.
I also thought that by using them, I could report some feedback and help @jan with their development (although, for now, they work perfectly for my use case, so nothing to report ).
And because I am still at a very early stage of development, I want to have some freedom to make big change to the library, without disturbing a lot of users.
I totally understand your position on clpBNR since it is a library in a totally different league.
It is used so widely that you need that kind of stability.
Thank you very much for that code fragment.
Iâll test it and try to integrate it if I can.
Itâs actually correct, see the wikipedia page: Gal (unit) - Wikipedia
The angular system is quite bad. I need to investigate a bit further.
I donât know, I donât think it exists.
quantities like position vectors, velocity, acceleration can be N dimensional (well 1D, 2D or 3D).
So the value of such quantities should be arrays.
Yes ! Because this is not just a unit library, but a unit and quantity library
For example, it doesnât make sense to compare a speed and a velocity, because their âcharacterâ (scalar and vector) doesnât match.
See the documentation of mp-units on this: Character of a Quantity - mp-units
The first thing it says is âNot to be confused with gallon.â which is exactly what I did, because the unit is cgs:gal
. Itâs almost as if every unit, or perhaps every system, requires a Wikipedia link to explain what it all means.
Maybe one issue is that the cgs
unit name gal
conflicts with the symbol name for the usc
symbol name. What would happen if the unqualified unit name, in this case gal
in system cgs
, was not considered a symbol (as in the predicate gal(:(cgs,gal))
)? After all, thereâs no conflict between the cgs
symbol Gal
and the usc
symbol gal
.
Further distinguishing symbols and unit names, is the how they are used with prefixes, as discussed in an earlier post.
An improved version since alias/2
is uni-directional.
:- multifile message_hook/3.
:- dynamic message_hook/3.
:- use_module(library(units),[alias/2,unit_symbol/2]).
user:message_hook(error(permission_error(import_into(_),procedure,M1:(P/1)),Context),error,_) :-
Context = context(import/1,already_from(M2)),
% Assume module S_symbol implies system S
atom_concat(S1,'_symbol',M1),
atom_concat(S2,'_symbol',M2),
(unit_symbol(_:UnitName,P)
-> alias_(S1:UnitName,S2:UnitName)
; alias_(S1:P,S2:P)
).
alias_(X,Y) :- alias(X,Y), !.
alias_(X,Y) :- alias(Y,X), !.
This now catches a significant percentage (~25%) of the error messages based on the the load order of my test case.
The âcapacitor_time_curveâ example caught my eye becasue it took a quantity expression as the argument to an arithmetic function (namely exp
) and I hadnât seen that before in the doc. A couple of questions:
?- qeval((CC is 0.47*si:micro(si:farad), V0 is 5.0*'V', RR is 4.7*si:kilo(si:ohm),TT is 10*ms)),qeval((TC is (-TT / (RR * CC)))).
CC = 0.47*kind_of(isq:electric_current**2*isq:time**4/(isq:length**2*isq:mass))[si:micro(si:farad)],
V0 = 5.0*kind_of(isq:length**2*isq:mass/(isq:electric_current*isq:time**3))[si:volt],
RR = 4.7*kind_of(isq:length**2*isq:mass/(isq:electric_current**2*isq:time**3))[si:kilo(si:ohm)],
TT = 10*kind_of(isq:time)[si:milli(si:second)],
TC = -4.526935264825712*kind_of(1)[si:milli(si:second)/(si:kilo(si:ohm)*si:micro(si:farad))].
Note the value of quantity TC
; it has a kind_of(1)
which (I think) means a dimensionless quantity, but a units value which is anything but. Any rationale?
Using exp
:
qeval((CC is 0.47*si:micro(si:farad), V0 is 5.0*'V', RR is 4.7*si:kilo(si:ohm),TT is 10*ms)),qeval((TC is exp(-TT / (RR * CC)))).
CC = 0.47*kind_of(isq:electric_current**2*isq:time**4/(isq:length**2*isq:mass))[si:micro(si:farad)],
V0 = 5.0*kind_of(isq:length**2*isq:mass/(isq:electric_current*isq:time**3))[si:volt],
RR = 4.7*kind_of(isq:length**2*isq:mass/(isq:electric_current**2*isq:time**3))[si:kilo(si:ohm)],
TT = 10*kind_of(isq:time)[si:milli(si:second)],
TC = 0.010813766670965414*kind_of(1)[1].
By taking the exp
of the quantity expression, TC
now becomes a âtrueâ dimensionless quantity with a unit value of 1
.
If I now try to use TC
in a quantity expression:
?- qeval((CC is 0.47*si:micro(si:farad), V0 is 5.0*'V', RR is 4.7*si:kilo(si:ohm),TT is 10*ms)),qeval((TC is exp(-TT / (RR * CC)), Vt is V0*TC)).
ERROR: No rule matches units:eval_(user,unit 1,_77276)
ERROR: In:
ERROR: [20] units:eval_(user,unit 1,_77334)
ERROR: [19] units:eval_(user,kind_of(1)[1],_77372) at swi-prolog/pack/units/prolog/units.pl:771
ERROR: [18] units:eval_(user,0.010813766670965414*[](...,...),_77422) at swi-prolog/pack/units/prolog/units.pl:695
I assume this is a bug since I should always be able to multiply a quantity by a dimensionless quantity.
The bigger questions. I would assume that most unary arithmetic functions should only work on dimensionless quantities. But are there some that might not have that restriction, e.g.,
?- qeval(Rt =:= sqrt(4*m**2)). % Rt = 2*kind_of(isq:length)[si:metre].
?- qeval(T is tan(1*rad). % T = 1.557407724654902*kind_of(1)[1]
This sort of works:
?- qeval(S is sin(1*rad)).
S = 0.8414709848078965*1[1].
but the kind_of
is missing in the result quantity.
The fact that none of this (unary arithmetic functions on quantities) is documented suggests that it may be a work-in-progress, or just an experiment, but wondered if there were any plans for taking this further.
Well, it is actually a dimensionless quantity ^^:
si:milli(si:second)/(si:kilo(si:ohm)*si:micro(si:farad))
si:second
:time
si:ohm
:length**2 * mass / (electric_current**2 * time**3
si:farad
:electric_current**2 * isq:time**4 / (length**2*mass)
unit | Length | Mass | Time | Electric Intensity |
---|---|---|---|---|
1/ohm | -2 | -1 | 3 | 2 |
1/farad | 2 | 1 | -4 | -2 |
second | 0 | 0 | 1 | 0 |
0 | 0 | 0 | 0 |
Yes, it is a bug, Iâll try to make a fix soon.
Note that sqrt is just a power of 1/2, so that blends very naturally in how units are defined.
I think that apart from power function like sqrt, all unary functions should take dimensionless quantities.
Trigonometric function takes in radian or degree which are dimensionless quantities: si:radian
is defined with si:metre/si:metre
.
Logarithmic quantities like decibel are ratio of powers, meaning the ratio in itself is a dimensionless quantity. Note that there is no support for logarithmic quantities in this library (or in the original mp-units library).
Yes, this is all work-in-progress.
I would like to add more trigonometric function, document and test more this aspect of the library.
I guess my point is that there appears to be an infinite number of syntactic ways of expressing the single semantic concept of a dimensionless quantity. This also means that two dimensionless quantities with the same value donât unify. Thatâs a recipe for confusion IMO.
Further the actual units value of a dimensionless quantity seems to be purely an artifact of how that quantity was calculated. When is that ever useful? What is lost by always representing a dimensionless quantity by
Value*kind_of(1)[1]
So while you can calculate quantity units and kind using fractional powers, what is the physical interpretation of, e.g.,
?- qeval((X is 4*m**2,Y is X**1r3)).
X = 4*kind_of(isq:length**2)[si:metre**2],
Y = 1.5874010519681994*kind_of(isq:length**2r3)[si:metre**2r3].
When would a unit/kind to a fractional power not be an error in a real world application?
See the documentation of mp-units which explains this very well for quantities: Dimensionless Quantities - mp-units
But basically, keeping this information is useful for special quantity formula.
You can always simplify things by doing unit conversions with is
or quantity conversion with as
.
Hm, you are right. I suppose we should restrict the possible values for powers.
Basically, they should be integer or 1/integer
?
So prolog code for that would be something like:
( integer(P)
; rational(P, 1, _)
; rational(P, -1, _)
)
I didnât find the mp-units description very helpful. And what does âspecial quantity formulaâ mean to the user?
I really donât care much what happens internally, but why shouldnât a dimensionless quantity always be presented to the user as kind_of(1)[1]
? What is anything else going to mean to them?
I assume weâre talking about a quantity term, i.e., Value*kind_of(Kind)[Unit]
. If so, I donât see why any fractional power including â1/integer
â should be permitted in either Kind
or Unit
? Do you have an example of of where that would useful? Note that this is different than evaluating a quantity to a fractional power which should be allowed even if it eventually results in an error due the above restriction.
For example, the iso says this:
- Some quantities of dimension one are defined as the ratios of two quantities of the same kind.
I suppose users would also want to know these type of information.
Sorry, my math just failed me ^^
I should only allow integer powers (positive and negative) and thatâs all.
I canât imagine why. What use can they make from this information? Theyâre more likely to be perplexed why this dimensionless quantity has a unit other than 1. They may even think itâs a bug, particularly if it isnât obvious the units expression is in fact dimensionless, like the previous example:
si:milli(si:second)/(si:kilo(si:ohm)*si:micro(si:farad))
Keep it simple would be my advice.
Alan Kay (Smalltalk,OOD) once said âSimple things should be simple, complex things should be possibleâ. Over the course of recent discussions, I kept wondering whether there was a simpler quantities âlanguageâ just for doing simple things.
So I built a small prototype which wraps the units
pack and essentially provides qty/1
as an alternative to qeval/1
. qty/1
supports the simplest, minimalist quantities language I could think of that still did useful things. Corollary: for "complex things, use the units
pack.
As stated in Quantities and units library :
[ISO/IEC 80000] defines a quantity as:
âproperty of a phenomenon, body, or substance, where the property has a magnitude that can be expressed as a number and a reference.â
In the qty
minimalist language, a quantity is a term of the form Value[Units]
, where Value
is the magnitude property of the quantity and Units
the reference property. The semantics of Value
and Units
is pretty much that same as in pack units
but the set of literals in a units expression is limited to symbols as defined by that pack and exported by âsystemsâ. The net effect is there is no quantity type (kind) or system information explicitly contained in the quantity term - if necessary, the assumption is that info can be derived from Units
.
One benefit of this simple language is that the âtypeâ of any logic variable can be unambiguously determined: all variables are quantities unless it is contained in a quantityâs Value
(in which case they currently must be numeric) or contained in a quantityâs Units
, in which case they must be a symbol (or part of a symbol expression). Dimensionless quantities have Units
=1. With this change in semantics is
and =:=
are equivalent (as in constrained arithmetic).
A simple example from unit
README:
?- qeval(Q is 3 * si:metre / si:second).
Q = 3*kind_of(isq:length/isq:time)[si:metre/si:second].
% a simpler version using symbols
?- qeval(Q is 3 * m/s).
Q = 3*kind_of(isq:length/isq:time)[si:metre/si:second].
% with `qty/1`
?- qty(Q is 3[m/s]).
Q = 3[m/s].
The second example shows qeval/1
supports a shortened form using symbols rather than qualified units, so the input queries can be almost equivalent. The more significant difference is on the output where the quantity term is not only simpler but reflects the actual input; âSimple things should be simple.â Other examples:
?- qeval(X*Q[U] is 3*m/s).
X = 3,
Q = kind_of(isq:length/isq:time),
U = si:metre/si:second.
?- qty(X[U] is 3[m/s]).
X = 3,
U = m/s.
?- qeval(X is 1*metre/second + 1*inch/hour).
X = 1.0000070555555556*kind_of(isq:length/isq:time)[si:metre/si:second].
?- qty(X is 1[m/s] + 1[in/h]).
X = 1.0000070555555556[m/s]. % qty converts rational to floats for readability
?- qty(X[fur/d] is 1[m/s] + 1[in/h]).
X = 429.49479837747555.
% dimensionless result
?- Width = 1*metre, Height = 2*metre, qeval(Ratio is Width / Height).
Width = 1*metre,
Height = 2*metre,
Ratio = 0.5*kind_of(1)[1].
?- Width = 1[m], Height = 2[m], qty(Ratio is Width / Height).
Width = 1[m],
Height = 2[m],
Ratio = 0.5[1].
I was impressed at how much this simple qty
language can do. But what canât it do?
Quantity types (kinds) arenât supported so neither is the as
operator. But I was never quite sure what it actually did. If Units is defined, as
appears to ensure that it is consistent with the quantity type is as specified. If Units isnât completely defined it appears to constrain the possible values that Units can take to ensure consistency. Is that right? To be honest, Iâm not sure how useful that is compared to just checking the Unitsâ kind (using all_unit_kind/2
or equivavlent) at a suitable point in the computation. In any case, if thatâs really an application requirement, use pack units
instead of pack quantities
.
I donât think I need the in
operation, qformat/1
, or disambiguation (see above). I think I could build quantity points (as pairs of quantities?) as a separate data structure and library if need be, but my knowledge of the subject is a bit lacking.
I do think this minimalist qty
language provides the user with a simple language for doing more than just simple things. Am I missing something?
Bug report:
?- qeval(N*yd =:= m).
N = 1250r1143. % OK
?- ?- qeval(N is m/yd).
N = 1*kind_of(1)[si:metre/imperial:yard]. % Incorrect magnitude
I think that your qty/1
DSL would be very convenient for small one off calculation and conversions with units.
The mp-units and therefore qeval/1
focuses more on safety and expressivity.
I think the simplest example is the speed example:
avg_speed(D, T, S) :-
qeval(S is D / T as isq:speed).
Quantity types allow manipulating quantities like distance, time and speed without having to specify a concrete unit.
But if qty/1
works for you, I would be happy to add it as an additional optional module that people can load instead of the original library.
Actually, this works as intended.
This units does not do any automatic conversion if it is not needed.
the quantity 1*kind_of(1)[si:metre/imperial:yard]
is absolutely correct, in the same way that m/yd
is correct.
If you want to have the unitless ratio, you need to explicitly request the conversion:
?- qeval(N is m/yd in 1).
N = 1.0936132983377078*kind_of(1)[1].
This laziness is very useful to avoid doing useless conversions, which introduces floating point arithmetic errors.