Factored out definitions, and added several additional units
This commit is contained in:
parent
583637859a
commit
240c10eb58
|
@ -0,0 +1,29 @@
|
||||||
|
section \<open> Non-SI Units Accepted for SI use \<close>
|
||||||
|
|
||||||
|
theory SI_Accepted
|
||||||
|
imports SI_Derived
|
||||||
|
begin
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "minute = 60 \<odot> second"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "hour = 60 \<odot> minute"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "day = 24 \<odot> hour"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "astronomical_unit = 149597870700 \<odot> meter"
|
||||||
|
|
||||||
|
definition degree :: "'a::real_field[L/L]" where
|
||||||
|
[si_def, si_eq]: "degree = (2\<cdot>(of_real pi) / 180) \<odot> radian"
|
||||||
|
|
||||||
|
abbreviation degrees ("_\<degree>" [999] 999) where "n\<degree> \<equiv> n \<odot> degree"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "litre = 1/1000 \<odot> meter\<^sup>\<three>"
|
||||||
|
|
||||||
|
abbreviation "tonne \<equiv> 10^3 \<odot> kilogram"
|
||||||
|
|
||||||
|
subsection \<open> Examples \<close>
|
||||||
|
|
||||||
|
lemma "watt \<^bold>\<cdot> hour \<cong>\<^sub>Q 3600 \<odot> joule"
|
||||||
|
by (si_calc)
|
||||||
|
|
||||||
|
end
|
|
@ -4,6 +4,8 @@ theory SI_Constants
|
||||||
imports SI_Proof
|
imports SI_Proof
|
||||||
begin
|
begin
|
||||||
|
|
||||||
|
subsection \<open> Core Derived Units \<close>
|
||||||
|
|
||||||
abbreviation "hertz \<equiv> second\<^sup>-\<^sup>\<one>"
|
abbreviation "hertz \<equiv> second\<^sup>-\<^sup>\<one>"
|
||||||
|
|
||||||
abbreviation "radian \<equiv> meter \<^bold>\<cdot> meter\<^sup>-\<^sup>\<one>"
|
abbreviation "radian \<equiv> meter \<^bold>\<cdot> meter\<^sup>-\<^sup>\<one>"
|
||||||
|
@ -18,6 +20,8 @@ abbreviation "coulomb \<equiv> ampere \<^bold>\<cdot> second"
|
||||||
|
|
||||||
abbreviation "lumen \<equiv> candela \<^bold>\<cdot> steradian"
|
abbreviation "lumen \<equiv> candela \<^bold>\<cdot> steradian"
|
||||||
|
|
||||||
|
subsection \<open> Constants \<close>
|
||||||
|
|
||||||
text \<open> The most general types we support must form a field into which the natural numbers can
|
text \<open> The most general types we support must form a field into which the natural numbers can
|
||||||
be injected. \<close>
|
be injected. \<close>
|
||||||
|
|
||||||
|
|
|
@ -6,44 +6,34 @@ begin
|
||||||
|
|
||||||
subsection \<open> Definitions \<close>
|
subsection \<open> Definitions \<close>
|
||||||
|
|
||||||
definition degree :: "'a::real_field[L/L]" where
|
abbreviation "newton \<equiv> kilogram \<^bold>\<cdot> meter \<^bold>\<cdot> second\<^sup>-\<^sup>\<two>"
|
||||||
[si_def]: "degree = (2\<cdot>(of_real pi) / 180) \<odot> radian"
|
|
||||||
|
|
||||||
abbreviation degrees ("_\<degree>" [999] 999) where "n\<degree> \<equiv> n \<odot> degree"
|
abbreviation "pascal \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>-\<^sup>\<one> \<^bold>\<cdot> second\<^sup>-\<^sup>\<two>"
|
||||||
|
|
||||||
definition degrees_celcius :: "'a::field \<Rightarrow> 'a[\<Theta>]" ("_\<degree>C" [999] 999)
|
|
||||||
where [si_def]: "degrees_celcius x = x + 273.151 \<odot> kelvin"
|
|
||||||
|
|
||||||
definition degrees_farenheit :: "'a::field \<Rightarrow> 'a[\<Theta>]" ("_\<degree>F" [999] 999)
|
|
||||||
where [si_def]: "degrees_farenheit x = (x + 459.67)\<cdot>5/9 \<odot> kelvin"
|
|
||||||
|
|
||||||
definition [si_def]: "litre = 1/1000 \<odot> meter\<^sup>\<three>"
|
|
||||||
|
|
||||||
definition [si_def]: "pint = 0.56826125 \<odot> litre"
|
|
||||||
|
|
||||||
definition [si_def, si_eq]: "hour = 3600 \<odot> second"
|
|
||||||
|
|
||||||
definition [si_def]: "gram = milli \<odot> kilogram"
|
|
||||||
|
|
||||||
abbreviation "tonne \<equiv> kilo \<odot> kilogram"
|
|
||||||
|
|
||||||
abbreviation "newton \<equiv> (kilogram \<^bold>\<cdot> meter) \<^bold>/ second\<^sup>\<two>"
|
|
||||||
|
|
||||||
abbreviation "volt \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>\<two> \<^bold>\<cdot> second\<^sup>-\<^sup>\<three> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<one>"
|
abbreviation "volt \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>\<two> \<^bold>\<cdot> second\<^sup>-\<^sup>\<three> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<one>"
|
||||||
|
|
||||||
definition "inch = 25.5 \<odot> milli \<odot> meter"
|
abbreviation "farad \<equiv> kilogram\<^sup>-\<^sup>\<one> \<^bold>\<cdot> meter\<^sup>-\<^sup>\<two> \<^bold>\<cdot> second\<^sup>\<four> \<^bold>\<cdot> ampere\<^sup>\<two>"
|
||||||
|
|
||||||
definition "foot = 0.3048 \<odot> meter"
|
abbreviation "ohm \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>\<two> \<^bold>\<cdot> second\<^sup>-\<^sup>\<three> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<two>"
|
||||||
|
|
||||||
definition "yard = 0.9144 \<odot> meter"
|
abbreviation "siemens \<equiv> kilogram\<^sup>-\<^sup>\<one> \<^bold>\<cdot> meter\<^sup>-\<^sup>\<two> \<^bold>\<cdot> second\<^sup>\<three> \<^bold>\<cdot> ampere\<^sup>\<two>"
|
||||||
|
|
||||||
|
abbreviation "weber \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>\<two> \<^bold>\<cdot> second\<^sup>-\<^sup>\<two> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<one>"
|
||||||
|
|
||||||
|
abbreviation "tesla \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>-\<^sup>\<two> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<one>"
|
||||||
|
|
||||||
|
abbreviation "henry \<equiv> kilogram \<^bold>\<cdot> meter\<^sup>\<two> \<^bold>\<cdot> second\<^sup>-\<^sup>\<two> \<^bold>\<cdot> ampere\<^sup>-\<^sup>\<two>"
|
||||||
|
|
||||||
|
definition degrees_celcius :: "'a::field \<Rightarrow> 'a[\<Theta>]" ("_\<degree>C" [999] 999)
|
||||||
|
where [si_def, si_eq]: "degrees_celcius x = x + 273.151 \<odot> kelvin"
|
||||||
|
|
||||||
|
definition degrees_farenheit :: "'a::field \<Rightarrow> 'a[\<Theta>]" ("_\<degree>F" [999] 999)
|
||||||
|
where [si_def, si_eq]: "degrees_farenheit x = (x + 459.67)\<cdot>5/9 \<odot> kelvin"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "gram = milli \<odot> kilogram"
|
||||||
|
|
||||||
text\<open>The full beauty of the approach is perhaps revealed here, with the
|
text\<open>The full beauty of the approach is perhaps revealed here, with the
|
||||||
type of a classical three-dimensional gravitation field:\<close>
|
type of a classical three-dimensional gravitation field:\<close>
|
||||||
type_synonym gravitation_field = "(real\<^sup>3 \<Rightarrow> real\<^sup>3)[L \<cdot> T\<^sup>-\<^sup>2]"
|
type_synonym gravitation_field = "(real\<^sup>3 \<Rightarrow> real\<^sup>3)[L \<cdot> T\<^sup>-\<^sup>2]"
|
||||||
|
|
||||||
subsection \<open> Examples \<close>
|
|
||||||
|
|
||||||
lemma "watt \<^bold>\<cdot> hour \<cong>\<^sub>Q 3600 \<odot> joule"
|
|
||||||
by (si_calc)
|
|
||||||
|
|
||||||
end
|
end
|
|
@ -0,0 +1,15 @@
|
||||||
|
section \<open> Imperial Units via SI \<close>
|
||||||
|
|
||||||
|
theory SI_Imperial
|
||||||
|
imports SI_Accepted
|
||||||
|
begin
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "pint = 0.56826125 \<odot> litre"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "inch = 25.5 \<odot> milli \<odot> meter"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "foot = 0.3048 \<odot> meter"
|
||||||
|
|
||||||
|
definition [si_def, si_eq]: "yard = 0.9144 \<odot> meter"
|
||||||
|
|
||||||
|
end
|
|
@ -5,7 +5,7 @@ theory SI_Proof
|
||||||
begin
|
begin
|
||||||
|
|
||||||
definition magnQuant :: "'a['u::si_type] \<Rightarrow> 'a" ("\<lbrakk>_\<rbrakk>\<^sub>Q") where
|
definition magnQuant :: "'a['u::si_type] \<Rightarrow> 'a" ("\<lbrakk>_\<rbrakk>\<^sub>Q") where
|
||||||
[si_def]: "magnQuant x = magn (fromUnit x)"
|
[si_def]: "magnQuant x = magn (fromQ x)"
|
||||||
|
|
||||||
lemma unit_eq_iff_magn_eq:
|
lemma unit_eq_iff_magn_eq:
|
||||||
"x = y \<longleftrightarrow> \<lbrakk>x\<rbrakk>\<^sub>Q = \<lbrakk>y\<rbrakk>\<^sub>Q"
|
"x = y \<longleftrightarrow> \<lbrakk>x\<rbrakk>\<^sub>Q = \<lbrakk>y\<rbrakk>\<^sub>Q"
|
||||||
|
@ -15,7 +15,7 @@ lemma unit_equiv_iff:
|
||||||
fixes x :: "'a['u\<^sub>1::si_type]" and y :: "'a['u\<^sub>2::si_type]"
|
fixes x :: "'a['u\<^sub>1::si_type]" and y :: "'a['u\<^sub>2::si_type]"
|
||||||
shows "x \<cong>\<^sub>Q y \<longleftrightarrow> \<lbrakk>x\<rbrakk>\<^sub>Q = \<lbrakk>y\<rbrakk>\<^sub>Q \<and> SI('u\<^sub>1) = SI('u\<^sub>2)"
|
shows "x \<cong>\<^sub>Q y \<longleftrightarrow> \<lbrakk>x\<rbrakk>\<^sub>Q = \<lbrakk>y\<rbrakk>\<^sub>Q \<and> SI('u\<^sub>1) = SI('u\<^sub>2)"
|
||||||
proof -
|
proof -
|
||||||
have "\<forall>t ta. (ta::'a['u\<^sub>2]) = t \<or> magn (fromUnit ta) \<noteq> magn (fromUnit t)"
|
have "\<forall>t ta. (ta::'a['u\<^sub>2]) = t \<or> magn (fromQ ta) \<noteq> magn (fromQ t)"
|
||||||
by (simp add: magnQuant_def unit_eq_iff_magn_eq)
|
by (simp add: magnQuant_def unit_eq_iff_magn_eq)
|
||||||
then show ?thesis
|
then show ?thesis
|
||||||
by (metis (full_types) qequiv.rep_eq coerceQuant_eq_iff2 eq_ magnQuant_def)
|
by (metis (full_types) qequiv.rep_eq coerceQuant_eq_iff2 eq_ magnQuant_def)
|
||||||
|
|
|
@ -98,14 +98,14 @@ text\<open>We 'lift' SI type expressions to SI tagged type expressions as follow
|
||||||
|
|
||||||
typedef (overloaded) ('n, 'u::si_type) tQuant ("_[_]" [999,0] 999)
|
typedef (overloaded) ('n, 'u::si_type) tQuant ("_[_]" [999,0] 999)
|
||||||
= "{x :: 'n Quantity. unit x = SI('u)}"
|
= "{x :: 'n Quantity. unit x = SI('u)}"
|
||||||
morphisms fromUnit toUnit by (rule_tac x="\<lparr> magn = undefined, unit = SI('u) \<rparr>" in exI, simp)
|
morphisms fromQ toQ by (rule_tac x="\<lparr> magn = undefined, unit = SI('u) \<rparr>" in exI, simp)
|
||||||
|
|
||||||
setup_lifting type_definition_tQuant
|
setup_lifting type_definition_tQuant
|
||||||
|
|
||||||
text \<open> Coerce values when their units are equivalent \<close>
|
text \<open> Coerce values when their units are equivalent \<close>
|
||||||
|
|
||||||
definition coerceUnit :: "'u\<^sub>2 itself \<Rightarrow> 'a['u\<^sub>1::si_type] \<Rightarrow> 'a['u\<^sub>2::si_type]" where
|
definition coerceUnit :: "'u\<^sub>2 itself \<Rightarrow> 'a['u\<^sub>1::si_type] \<Rightarrow> 'a['u\<^sub>2::si_type]" where
|
||||||
"SI('u\<^sub>1) = SI('u\<^sub>2) \<Longrightarrow> coerceUnit t x = (toUnit (fromUnit x))"
|
"SI('u\<^sub>1) = SI('u\<^sub>2) \<Longrightarrow> coerceUnit t x = (toQ (fromQ x))"
|
||||||
|
|
||||||
section\<open>Operations SI-tagged types via their Semantic Domains\<close>
|
section\<open>Operations SI-tagged types via their Semantic Domains\<close>
|
||||||
|
|
||||||
|
@ -141,7 +141,7 @@ lemma coerceQuant_eq_iff:
|
||||||
fixes x :: "'a['u\<^sub>1::si_type]"
|
fixes x :: "'a['u\<^sub>1::si_type]"
|
||||||
assumes "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)"
|
assumes "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)"
|
||||||
shows "(coerceUnit TYPE('u\<^sub>2) x) \<cong>\<^sub>Q x"
|
shows "(coerceUnit TYPE('u\<^sub>2) x) \<cong>\<^sub>Q x"
|
||||||
by (metis qequiv.rep_eq assms coerceUnit_def toUnit_cases toUnit_inverse)
|
by (metis qequiv.rep_eq assms coerceUnit_def toQ_cases toQ_inverse)
|
||||||
|
|
||||||
(* or equivalently *)
|
(* or equivalently *)
|
||||||
|
|
||||||
|
@ -153,19 +153,19 @@ lemma coerceQuant_eq_iff2:
|
||||||
|
|
||||||
lemma updown_eq_iff:
|
lemma updown_eq_iff:
|
||||||
fixes x :: "'a['u\<^sub>1::si_type]" fixes y :: "'a['u\<^sub>2::si_type]"
|
fixes x :: "'a['u\<^sub>1::si_type]" fixes y :: "'a['u\<^sub>2::si_type]"
|
||||||
assumes "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)" and "y = (toUnit (fromUnit x))"
|
assumes "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)" and "y = (toQ (fromQ x))"
|
||||||
shows "x \<cong>\<^sub>Q y"
|
shows "x \<cong>\<^sub>Q y"
|
||||||
by (simp add: assms(1) assms(2) coerceQuant_eq_iff2 coerceUnit_def)
|
by (simp add: assms(1) assms(2) coerceQuant_eq_iff2 coerceUnit_def)
|
||||||
|
|
||||||
text\<open>This is more general that \<open>y = x \<Longrightarrow> x \<cong>\<^sub>Q y\<close>, since x and y may have different type.\<close>
|
text\<open>This is more general that \<open>y = x \<Longrightarrow> x \<cong>\<^sub>Q y\<close>, since x and y may have different type.\<close>
|
||||||
|
|
||||||
find_theorems "(toUnit (fromUnit _))"
|
find_theorems "(toQ (fromQ _))"
|
||||||
|
|
||||||
lemma eq_ :
|
lemma eq_ :
|
||||||
fixes x :: "'a['u\<^sub>1::si_type]" fixes y :: "'a['u\<^sub>2::si_type]"
|
fixes x :: "'a['u\<^sub>1::si_type]" fixes y :: "'a['u\<^sub>2::si_type]"
|
||||||
assumes "x \<cong>\<^sub>Q y"
|
assumes "x \<cong>\<^sub>Q y"
|
||||||
shows "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)"
|
shows "SI('u\<^sub>1) = SI('u\<^sub>2::si_type)"
|
||||||
by (metis (full_types) qequiv.rep_eq assms fromUnit mem_Collect_eq)
|
by (metis (full_types) qequiv.rep_eq assms fromQ mem_Collect_eq)
|
||||||
|
|
||||||
subsection\<open>Operations on SI-tagged types\<close>
|
subsection\<open>Operations on SI-tagged types\<close>
|
||||||
|
|
||||||
|
|
|
@ -312,7 +312,7 @@ type_synonym ('a, 'b) UnitDiv = "'a \<cdot> ('b\<^sup>-\<^sup>1)" (infixl "'/" 6
|
||||||
|
|
||||||
type_synonym 'a UnitSquare = "'a \<cdot> 'a" ("(_)\<^sup>2" [999] 999)
|
type_synonym 'a UnitSquare = "'a \<cdot> 'a" ("(_)\<^sup>2" [999] 999)
|
||||||
type_synonym 'a UnitCube = "'a \<cdot> 'a \<cdot> 'a" ("(_)\<^sup>3" [999] 999)
|
type_synonym 'a UnitCube = "'a \<cdot> 'a \<cdot> 'a" ("(_)\<^sup>3" [999] 999)
|
||||||
type_synonym 'a UnitQuart = "'a \<cdot> 'a \<cdot> 'a" ("(_)\<^sup>4" [999] 999)
|
type_synonym 'a UnitQuart = "'a \<cdot> 'a \<cdot> 'a \<cdot> 'a" ("(_)\<^sup>4" [999] 999)
|
||||||
type_synonym 'a UnitInvSquare = "('a\<^sup>2)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>2" [999] 999)
|
type_synonym 'a UnitInvSquare = "('a\<^sup>2)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>2" [999] 999)
|
||||||
type_synonym 'a UnitInvCube = "('a\<^sup>3)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>3" [999] 999)
|
type_synonym 'a UnitInvCube = "('a\<^sup>3)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>3" [999] 999)
|
||||||
type_synonym 'a UnitInvQuart = "('a\<^sup>4)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>4" [999] 999)
|
type_synonym 'a UnitInvQuart = "('a\<^sup>4)\<^sup>-\<^sup>1" ("(_)\<^sup>-\<^sup>4" [999] 999)
|
||||||
|
@ -321,6 +321,8 @@ translations (type) "'a\<^sup>-\<^sup>2" <= (type) "('a\<^sup>2)\<^sup>-\<^sup>1
|
||||||
translations (type) "'a\<^sup>-\<^sup>3" <= (type) "('a\<^sup>3)\<^sup>-\<^sup>1"
|
translations (type) "'a\<^sup>-\<^sup>3" <= (type) "('a\<^sup>3)\<^sup>-\<^sup>1"
|
||||||
translations (type) "'a\<^sup>-\<^sup>4" <= (type) "('a\<^sup>4)\<^sup>-\<^sup>1"
|
translations (type) "'a\<^sup>-\<^sup>4" <= (type) "('a\<^sup>4)\<^sup>-\<^sup>1"
|
||||||
|
|
||||||
|
(* Need to add UnitQuart to the print translation *)
|
||||||
|
|
||||||
print_translation \<open>
|
print_translation \<open>
|
||||||
[(@{type_syntax UnitTimes},
|
[(@{type_syntax UnitTimes},
|
||||||
fn ctx => fn [a, b] =>
|
fn ctx => fn [a, b] =>
|
||||||
|
@ -330,11 +332,11 @@ print_translation \<open>
|
||||||
Const (@{type_syntax UnitTimes}, _) $ a1 $ a2 =>
|
Const (@{type_syntax UnitTimes}, _) $ a1 $ a2 =>
|
||||||
if (a1 = a2 andalso a2 = b)
|
if (a1 = a2 andalso a2 = b)
|
||||||
then Const (@{type_syntax UnitCube}, dummyT) $ a1
|
then Const (@{type_syntax UnitCube}, dummyT) $ a1
|
||||||
else raise Match |
|
else case a1 of
|
||||||
Const (@{type_syntax UnitSquare}, _) $ a' =>
|
Const (@{type_syntax UnitTimes}, _) $ a11 $ a12 =>
|
||||||
if (@{print} a' = b)
|
if (a11 = a12 andalso a12 = a2 andalso a2 = b)
|
||||||
then Const (@{type_syntax UnitCube}, dummyT) $ a'
|
then Const (@{type_syntax UnitQuart}, dummyT) $ a11
|
||||||
else raise Match |
|
else raise Match |
|
||||||
_ => raise Match)]
|
_ => raise Match)]
|
||||||
\<close>
|
\<close>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue