Initial checkin.
Doug Coleman
parent
487926f779
commit
c443f5c76a
|
|
@ -0,0 +1,11 @@
|
||||||
|
USING: kernel math dimensioned si-units ;
|
||||||
|
! From: http://physics.nist.gov/constants
|
||||||
|
|
||||||
|
IN: si-units
|
||||||
|
! speed of light in vacuum
|
||||||
|
: c 299792458 m/s ;
|
||||||
|
: c0 299792458 m/s ; ! same as c
|
||||||
|
: c-vacuum 299792458 m/s ; ! same as c
|
||||||
|
|
||||||
|
! more to come
|
||||||
|
|
||||||
|
|
@ -0,0 +1,97 @@
|
||||||
|
USING: physical-constants conversions ;
|
||||||
|
USING: kernel prettyprint io sequences words lists vectors inspector math errors namespaces ;
|
||||||
|
|
||||||
|
|
||||||
|
IN: units-internal
|
||||||
|
: seq-diff ( seq1 seq2 -- seq2-seq1 )
|
||||||
|
[ swap member? not ] subset-with ; flushable
|
||||||
|
|
||||||
|
: seq-intersect ( seq1 seq2 -- seq1/\seq2 )
|
||||||
|
[ swap member? ] subset-with ; flushable
|
||||||
|
|
||||||
|
IN: units
|
||||||
|
|
||||||
|
TUPLE: dimensioned val top bot ;
|
||||||
|
C: dimensioned
|
||||||
|
[ set-dimensioned-bot ] keep
|
||||||
|
[ set-dimensioned-top ] keep
|
||||||
|
over number? [ "dimensioned must be a number" throw ] unless
|
||||||
|
[ set-dimensioned-val ] keep ;
|
||||||
|
|
||||||
|
: remove-one ( obj seq -- seq )
|
||||||
|
[ index ] keep over -1 = [
|
||||||
|
2drop
|
||||||
|
] [
|
||||||
|
[ 0 -rot <slice> ] 2keep
|
||||||
|
>r 1+ r> [ length ] keep <slice> append
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: dimensions ( dimensioned -- top bot )
|
||||||
|
dup >r dimensioned-top r> dimensioned-bot ;
|
||||||
|
|
||||||
|
: 2remove-one ( obj seq seq -- seq seq )
|
||||||
|
pick swap remove-one >r remove-one r> ;
|
||||||
|
|
||||||
|
: symbolic-reduce ( seq seq -- seq seq )
|
||||||
|
[ seq-intersect ] 2keep rot dup empty? [
|
||||||
|
drop
|
||||||
|
] [
|
||||||
|
first -rot 2remove-one symbolic-reduce
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: reduce-units ( dimensioned -- )
|
||||||
|
dup dimensions symbolic-reduce pick set-dimensioned-bot swap set-dimensioned-top ;
|
||||||
|
|
||||||
|
: 2reduce-units ( d d -- )
|
||||||
|
>r dup reduce-units r> dup reduce-units ;
|
||||||
|
|
||||||
|
: 2val ( d d -- )
|
||||||
|
[ dimensioned-val ] 2apply ;
|
||||||
|
|
||||||
|
: =units?
|
||||||
|
>r dimensions 2list r> dimensions 2list = ;
|
||||||
|
|
||||||
|
|
||||||
|
: d+ ( d d -- )
|
||||||
|
2dup =units? [
|
||||||
|
"d+: dimensions must be the same" throw
|
||||||
|
] unless
|
||||||
|
dup dimensions
|
||||||
|
>r >r 2val + r> r> <dimensioned> ;
|
||||||
|
|
||||||
|
: d- ( d d -- )
|
||||||
|
2dup =units? [
|
||||||
|
"d-: dimensions must be the same" throw
|
||||||
|
] unless
|
||||||
|
dup dimensions
|
||||||
|
>r >r 2val - r> r> <dimensioned> ;
|
||||||
|
|
||||||
|
: add-dimensions ( d d -- d )
|
||||||
|
>r dimensions r> dimensions >r swap >r append r> r> append 0 -rot <dimensioned> ;
|
||||||
|
|
||||||
|
: (d*)
|
||||||
|
>r add-dimensions r> over set-dimensioned-val dup reduce-units ;
|
||||||
|
|
||||||
|
: d* ( d d -- )
|
||||||
|
2dup 2val * (d*) ;
|
||||||
|
|
||||||
|
: swap-dimensions ( d -- d )
|
||||||
|
dup dimensions rot [ set-dimensioned-top ] keep [ set-dimensioned-bot ] keep ;
|
||||||
|
|
||||||
|
: d/ ( d d -- )
|
||||||
|
swap-dimensions 2dup 2val / (d*) ;
|
||||||
|
|
||||||
|
: d-inv ( d -- d )
|
||||||
|
swap-dimensions dup dimensioned-val 1 swap / over set-dimensioned-val ;
|
||||||
|
|
||||||
|
: d-product ( v -- d ) 1 { } { } <dimensioned> [ d* ] reduce ;
|
||||||
|
|
||||||
|
! does not compile
|
||||||
|
! Example: 4 m { km } { } convert
|
||||||
|
: convert ( d top bot -- val )
|
||||||
|
>r [ [ 1 swap execute , ] each ] { } make d-product r>
|
||||||
|
[ [ 1 swap execute d-inv , ] each ] { } make d-product
|
||||||
|
d*
|
||||||
|
2dup =units? [ "cannot make that conversion" throw ] unless
|
||||||
|
2val / ;
|
||||||
|
|
||||||
|
|
@ -0,0 +1,10 @@
|
||||||
|
USING: parser sequences words compiler ;
|
||||||
|
|
||||||
|
[
|
||||||
|
"contrib/units/dimensioned.factor"
|
||||||
|
"contrib/units/si-units.factor"
|
||||||
|
"contrib/units/constants.factor"
|
||||||
|
] [ run-file ] each
|
||||||
|
|
||||||
|
! "" words [ try-compile ] each
|
||||||
|
|
||||||
|
|
@ -0,0 +1,136 @@
|
||||||
|
USING: math units ;
|
||||||
|
IN: si-units
|
||||||
|
|
||||||
|
! SI Conversions
|
||||||
|
! http://physics.nist.gov/cuu/Units/
|
||||||
|
|
||||||
|
! Y Z E P T G M k h da 1 d c m mu n p f a z y
|
||||||
|
: yotta>1 1000000000000000000000000 * ;
|
||||||
|
: zetta>1 1000000000000000000000 * ;
|
||||||
|
: exa>1 1000000000000000000 * ;
|
||||||
|
: peta>1 1000000000000000 * ;
|
||||||
|
: tera>1 1000000000000 * ;
|
||||||
|
: giga>1 1000000000 * ;
|
||||||
|
: mega>1 1000000 * ;
|
||||||
|
: kilo>1 1000 * ;
|
||||||
|
: hecto>1 100 * ;
|
||||||
|
: deca>1 10 * ;
|
||||||
|
: deci>1 10 / ;
|
||||||
|
: centi>1 100 / ;
|
||||||
|
: milli>1 1000 / ;
|
||||||
|
: micro>1 1000000 / ;
|
||||||
|
: nano>1 1000000000 / ;
|
||||||
|
: pico>1 1000000000000 / ;
|
||||||
|
: femto>1 1000000000000000 / ;
|
||||||
|
: atto>1 1000000000000000000 / ;
|
||||||
|
: zepto>1 1000000000000000000000 / ;
|
||||||
|
: yocto>1 1000000000000000000000000 / ;
|
||||||
|
|
||||||
|
|
||||||
|
! Length
|
||||||
|
SYMBOL: m
|
||||||
|
: (m) { m } { } <dimensioned> ;
|
||||||
|
: m (m) ;
|
||||||
|
: km kilo>1 (m) ;
|
||||||
|
: cm centi>1 (m) ;
|
||||||
|
: mm milli>1 (m) ;
|
||||||
|
: nm nano>1 (m) ;
|
||||||
|
|
||||||
|
! Mass
|
||||||
|
SYMBOL: kg
|
||||||
|
: (kg) { kg } { } <dimensioned> ;
|
||||||
|
: kg (kg) ;
|
||||||
|
: g milli>1 (kg) ;
|
||||||
|
|
||||||
|
! Time
|
||||||
|
SYMBOL: s
|
||||||
|
: (s) { s } { } <dimensioned> ;
|
||||||
|
: s (s) ;
|
||||||
|
: ms milli>1 (s) ;
|
||||||
|
|
||||||
|
! Electric current
|
||||||
|
SYMBOL: A
|
||||||
|
: (A) { A } { } <dimensioned> ;
|
||||||
|
: A (A) ;
|
||||||
|
|
||||||
|
! Temperature
|
||||||
|
SYMBOL: K
|
||||||
|
: (K) { K } { } <dimensioned> ;
|
||||||
|
: K (K) ;
|
||||||
|
|
||||||
|
! Amount of substance
|
||||||
|
SYMBOL: mol
|
||||||
|
: (mol) { mol } { } <dimensioned> ;
|
||||||
|
: mol (mol) ;
|
||||||
|
|
||||||
|
! Luminous intensity
|
||||||
|
SYMBOL: cd
|
||||||
|
: (cd) { cd } { } <dimensioned> ;
|
||||||
|
: cd (cd) ;
|
||||||
|
|
||||||
|
|
||||||
|
! SI derived units
|
||||||
|
: m^2 { m m } { } <dimensioned> ;
|
||||||
|
: m^3 { m m m } { } <dimensioned> ;
|
||||||
|
: m/s { m } { s } <dimensioned> ;
|
||||||
|
: m/s^2 { m } { s s } <dimensioned> ;
|
||||||
|
: m^-1 { } { m } <dimensioned> ;
|
||||||
|
: kg/m^3 { kg } { m m m } <dimensioned> ;
|
||||||
|
: A/m^2 { A } { m m } <dimensioned> ;
|
||||||
|
: A/m { A } { m } <dimensioned> ;
|
||||||
|
: mol/m^3 { mol } { m m m } <dimensioned> ;
|
||||||
|
: cd/m^2 { cd } { m m } <dimensioned> ;
|
||||||
|
: kg/kg { kg } { kg } <dimensioned> ;
|
||||||
|
|
||||||
|
: radian ( n -- radian ) { m } { m } <dimensioned> ;
|
||||||
|
: sr ( n -- steradian ) { m m } { m m } <dimensioned> ;
|
||||||
|
: Hz ( n -- hertz ) { } { s } <dimensioned> ;
|
||||||
|
: N ( n -- newton ) { kg m } { s s } <dimensioned> ;
|
||||||
|
: Pa ( n -- pascal ) { kg } { m s s } <dimensioned> ;
|
||||||
|
: J ( n -- joule ) { m m kg } { s s } <dimensioned> ;
|
||||||
|
: W ( n -- watt ) { m m kg } { s s s } <dimensioned> ;
|
||||||
|
: C ( n -- coulomb ) { s A } { } <dimensioned> ;
|
||||||
|
: V ( n -- volt ) { m m kg } { s s s A } <dimensioned> ;
|
||||||
|
: F ( n -- farad ) { s s s s A A } { m m kg } <dimensioned> ;
|
||||||
|
: ohm ( n -- ohm ) { m m kg } { s s s A A } <dimensioned> ;
|
||||||
|
: S ( n -- siemens ) { s s s A A } { m m kg } <dimensioned> ;
|
||||||
|
: Wb ( n - weber ) { m m kg } { s s A } <dimensioned> ;
|
||||||
|
: T ( n -- tesla ) { kg } { s s A } <dimensioned> ;
|
||||||
|
: H ( n -- henry ) { m m kg } { s s A A } <dimensioned> ;
|
||||||
|
: deg-C ( n -- Celsius ) 273.15 + { K } { } <dimensioned> ;
|
||||||
|
: lm ( n -- lumen ) { m m cd } { m m } <dimensioned> ;
|
||||||
|
: lx ( n -- lux ) { m m cd } { m m m m } <dimensioned> ;
|
||||||
|
: Bq ( n -- becquerel ) { } { s } <dimensioned> ;
|
||||||
|
: Gy ( n -- gray ) { m m } { s s } <dimensioned> ;
|
||||||
|
: Sv ( n -- sievert ) { m m } { s s } <dimensioned> ;
|
||||||
|
: kat ( n -- katal ) { mol } { s } <dimensioned> ;
|
||||||
|
|
||||||
|
! Extensions to the SI
|
||||||
|
: minutes ( n -- minute ) 60 * s ;
|
||||||
|
: hours ( n -- hour ) 3600 * s ;
|
||||||
|
: month 2629743.83 * s ;
|
||||||
|
: day 86400 * s ;
|
||||||
|
: year 31556926 * s ;
|
||||||
|
: arc-deg pi 180 / * radian ;
|
||||||
|
: arc-min pi 10800 / * radian ;
|
||||||
|
: arc-sec pi 648000 / * radian ;
|
||||||
|
: L ( n -- liter ) 1/1000 * m^3 ;
|
||||||
|
: t ( n -- metric-ton ) 1000 * kg ;
|
||||||
|
: Np ( n -- neper ) { } { } <dimensioned> ;
|
||||||
|
: B ( n -- bel ) 1.151292546497023 * Np ;
|
||||||
|
: eV ( n -- electronvolt ) 1.60218e-19 * J ;
|
||||||
|
: u ( n -- unified-atomic-mass-unit ) 1.66054e-27 * kg ;
|
||||||
|
: ua ( n -- astronomical-unit ) 149598000000 * m ;
|
||||||
|
|
||||||
|
: nautical-mile 1852 * m ;
|
||||||
|
: knot 1852/3600 * m/s ;
|
||||||
|
: a ( n -- are )100 * m^2 ;
|
||||||
|
: ha ( n -- hectare ) 10000 * m^2 ;
|
||||||
|
: bar ( n -- bar ) 100000 * Pa ;
|
||||||
|
: angstrom .1 * nm ;
|
||||||
|
: b ( n -- barn ) 1/10000000000000000000000000000 * m^2 ;
|
||||||
|
: Ci ( n -- curie ) 37000000000 * Bq ;
|
||||||
|
: R 0.000258 { s A } { kg } <dimensioned> ;
|
||||||
|
: rad .01 * Gy ;
|
||||||
|
: rem .01 * Sv ;
|
||||||
|
|
||||||
Loading…
Reference in New Issue