# HG changeset patch # User haftmann # Date 1186667569 -7200 # Node ID c9e3cb5e568147186139bdfc1b79ff1d15492e54 # Parent f1dbfd7e32231d699f4222b647f78727a8f2d924 proper implementation of rational numbers diff -r f1dbfd7e3223 -r c9e3cb5e5681 src/HOL/Library/Abstract_Rat.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Abstract_Rat.thy Thu Aug 09 15:52:49 2007 +0200 @@ -0,0 +1,502 @@ +(* Title: HOL/Library/Abstract_Rat.thy + ID: $Id$ + Author: Amine Chaieb +*) + +header {* Abstract rational numbers *} + +theory Abstract_Rat +imports GCD +begin + +types Num = "int \ int" +syntax "_Num0" :: "Num" ("0\<^sub>N") +translations "0\<^sub>N" \ "(0, 0)" +syntax "_Numi" :: "int \ Num" ("_\<^sub>N") +translations "i\<^sub>N" \ "(i, 1) \ Num" + +definition + isnormNum :: "Num \ bool" +where + "isnormNum = (\(a,b). (if a = 0 then b = 0 else b > 0 \ igcd a b = 1))" + +definition + normNum :: "Num \ Num" +where + "normNum = (\(a,b). (if a=0 \ b = 0 then (0,0) else + (let g = igcd a b + in if b > 0 then (a div g, b div g) else (- (a div g), - (b div g)))))" + +lemma normNum_isnormNum [simp]: "isnormNum (normNum x)" +proof - + have " \ a b. x = (a,b)" by auto + then obtain a b where x[simp]: "x = (a,b)" by blast + {assume "a=0 \ b = 0" hence ?thesis by (simp add: normNum_def isnormNum_def)} + moreover + {assume anz: "a \ 0" and bnz: "b \ 0" + let ?g = "igcd a b" + let ?a' = "a div ?g" + let ?b' = "b div ?g" + let ?g' = "igcd ?a' ?b'" + from anz bnz have "?g \ 0" by simp with igcd_pos[of a b] + have gpos: "?g > 0" by arith + have gdvd: "?g dvd a" "?g dvd b" by (simp_all add: igcd_dvd1 igcd_dvd2) + from zdvd_mult_div_cancel[OF gdvd(1)] zdvd_mult_div_cancel[OF gdvd(2)] + anz bnz + have nz':"?a' \ 0" "?b' \ 0" + by - (rule notI,simp add:igcd_def)+ + from anz bnz have stupid: "a \ 0 \ b \ 0" by blast + from div_igcd_relprime[OF stupid] have gp1: "?g' = 1" . + from bnz have "b < 0 \ b > 0" by arith + moreover + {assume b: "b > 0" + from pos_imp_zdiv_nonneg_iff[OF gpos] b + have "?b' \ 0" by simp + with nz' have b': "?b' > 0" by simp + from b b' anz bnz nz' gp1 have ?thesis + by (simp add: isnormNum_def normNum_def Let_def split_def fst_conv snd_conv)} + moreover {assume b: "b < 0" + {assume b': "?b' \ 0" + from gpos have th: "?g \ 0" by arith + from mult_nonneg_nonneg[OF th b'] zdvd_mult_div_cancel[OF gdvd(2)] + have False using b by simp } + hence b': "?b' < 0" by (presburger add: linorder_not_le[symmetric]) + from anz bnz nz' b b' gp1 have ?thesis + by (simp add: isnormNum_def normNum_def Let_def split_def fst_conv snd_conv)} + ultimately have ?thesis by blast + } + ultimately show ?thesis by blast +qed + +text {* Arithmetic over Num *} + +definition + Nadd :: "Num \ Num \ Num" (infixl "+\<^sub>N" 60) +where + "Nadd = (\(a,b) (a',b'). if a = 0 \ b = 0 then normNum(a',b') + else if a'=0 \ b' = 0 then normNum(a,b) + else normNum(a*b' + b*a', b*b'))" + +definition + Nmul :: "Num \ Num \ Num" (infixl "*\<^sub>N" 60) +where + "Nmul = (\(a,b) (a',b'). let g = igcd (a*a') (b*b') + in (a*a' div g, b*b' div g))" + +definition + Nneg :: "Num \ Num" ("~\<^sub>N") +where + "Nneg \ (\(a,b). (-a,b))" + +definition + Nsub :: "Num \ Num \ Num" (infixl "-\<^sub>N" 60) +where + "Nsub = (\a b. a +\<^sub>N ~\<^sub>N b)" + +definition + Ninv :: "Num \ Num" +where + "Ninv \ \(a,b). if a < 0 then (-b, \a\) else (b,a)" + +definition + Ndiv :: "Num \ Num \ Num" (infixl "\
\<^sub>N" 60) +where + "Ndiv \ \a b. a *\<^sub>N Ninv b" + +lemma Nneg_normN[simp]: "isnormNum x \ isnormNum (~\<^sub>N x)" + by(simp add: isnormNum_def Nneg_def split_def) +lemma Nadd_normN[simp]: "isnormNum (x +\<^sub>N y)" + by (simp add: Nadd_def split_def) +lemma Nsub_normN[simp]: "\ isnormNum y\ \ isnormNum (x -\<^sub>N y)" + by (simp add: Nsub_def split_def) +lemma Nmul_normN[simp]: assumes xn:"isnormNum x" and yn: "isnormNum y" + shows "isnormNum (x *\<^sub>N y)" +proof- + have "\a b. x = (a,b)" and "\ a' b'. y = (a',b')" by auto + then obtain a b a' b' where ab: "x = (a,b)" and ab': "y = (a',b')" by blast + {assume "a = 0" + hence ?thesis using xn ab ab' + by (simp add: igcd_def isnormNum_def Let_def Nmul_def split_def)} + moreover + {assume "a' = 0" + hence ?thesis using yn ab ab' + by (simp add: igcd_def isnormNum_def Let_def Nmul_def split_def)} + moreover + {assume a: "a \0" and a': "a'\0" + hence bp: "b > 0" "b' > 0" using xn yn ab ab' by (simp_all add: isnormNum_def) + from mult_pos_pos[OF bp] have "x *\<^sub>N y = normNum (a*a', b*b')" + using ab ab' a a' bp by (simp add: Nmul_def Let_def split_def normNum_def) + hence ?thesis by simp} + ultimately show ?thesis by blast +qed + +lemma Ninv_normN[simp]: "isnormNum x \ isnormNum (Ninv x)" +by (simp add: Ninv_def isnormNum_def split_def) +(cases "fst x = 0",auto simp add: igcd_commute) + +lemma isnormNum_int[simp]: + "isnormNum 0\<^sub>N" "isnormNum (1::int)\<^sub>N" "i \ 0 \ isnormNum i\<^sub>N" + by (simp_all add: isnormNum_def igcd_def) + + +text {* Relations over Num *} + +definition + Nlt0:: "Num \ bool" ("0>\<^sub>N") +where + "Nlt0 = (\(a,b). a < 0)" + +definition + Nle0:: "Num \ bool" ("0\\<^sub>N") +where + "Nle0 = (\(a,b). a \ 0)" + +definition + Ngt0:: "Num \ bool" ("0<\<^sub>N") +where + "Ngt0 = (\(a,b). a > 0)" + +definition + Nge0:: "Num \ bool" ("0\\<^sub>N") +where + "Nge0 = (\(a,b). a \ 0)" + +definition + Nlt :: "Num \ Num \ bool" (infix "<\<^sub>N" 55) +where + "Nlt = (\a b. 0>\<^sub>N (a -\<^sub>N b))" + +definition + Nle :: "Num \ Num \ bool" (infix "\\<^sub>N" 55) +where + "Nle = (\a b. 0\\<^sub>N (a -\<^sub>N b))" + +definition + "INum = (\(a,b). of_int a / of_int b)" + +lemma INum_int [simp]: "INum i\<^sub>N = ((of_int i) ::'a::field)" "INum 0\<^sub>N = (0::'a::field)" + by (simp_all add: INum_def) + +lemma isnormNum_unique[simp]: + assumes na: "isnormNum x" and nb: "isnormNum y" + shows "((INum x ::'a::{ring_char_0,field, division_by_zero}) = INum y) = (x = y)" (is "?lhs = ?rhs") +proof + have "\ a b a' b'. x = (a,b) \ y = (a',b')" by auto + then obtain a b a' b' where xy[simp]: "x = (a,b)" "y=(a',b')" by blast + assume H: ?lhs + {assume "a = 0 \ b = 0 \ a' = 0 \ b' = 0" hence ?rhs + using na nb H + apply (simp add: INum_def split_def isnormNum_def) + apply (cases "a = 0", simp_all) + apply (cases "b = 0", simp_all) + apply (cases "a' = 0", simp_all) + apply (cases "a' = 0", simp_all add: of_int_eq_0_iff) + done} + moreover + { assume az: "a \ 0" and bz: "b \ 0" and a'z: "a'\0" and b'z: "b'\0" + from az bz a'z b'z na nb have pos: "b > 0" "b' > 0" by (simp_all add: isnormNum_def) + from prems have eq:"a * b' = a'*b" + by (simp add: INum_def eq_divide_eq divide_eq_eq of_int_mult[symmetric] del: of_int_mult) + from prems have gcd1: "igcd a b = 1" "igcd b a = 1" "igcd a' b' = 1" "igcd b' a' = 1" + by (simp_all add: isnormNum_def add: igcd_commute) + from eq have raw_dvd: "a dvd a'*b" "b dvd b'*a" "a' dvd a*b'" "b' dvd b*a'" + apply(unfold dvd_def) + apply (rule_tac x="b'" in exI, simp add: mult_ac) + apply (rule_tac x="a'" in exI, simp add: mult_ac) + apply (rule_tac x="b" in exI, simp add: mult_ac) + apply (rule_tac x="a" in exI, simp add: mult_ac) + done + from zdvd_dvd_eq[OF bz zrelprime_dvd_mult[OF gcd1(2) raw_dvd(2)] + zrelprime_dvd_mult[OF gcd1(4) raw_dvd(4)]] + have eq1: "b = b'" using pos by simp_all + with eq have "a = a'" using pos by simp + with eq1 have ?rhs by simp} + ultimately show ?rhs by blast +next + assume ?rhs thus ?lhs by simp +qed + + +lemma isnormNum0[simp]: "isnormNum x \ (INum x = (0::'a::{ring_char_0, field,division_by_zero})) = (x = 0\<^sub>N)" + unfolding INum_int(2)[symmetric] + by (rule isnormNum_unique, simp_all) + +lemma of_int_div_aux: "d ~= 0 ==> ((of_int x)::'a::{field, ring_char_0}) / (of_int d) = + of_int (x div d) + (of_int (x mod d)) / ((of_int d)::'a)" +proof - + assume "d ~= 0" + hence dz: "of_int d \ (0::'a)" by (simp add: of_int_eq_0_iff) + let ?t = "of_int (x div d) * ((of_int d)::'a) + of_int(x mod d)" + let ?f = "\x. x / of_int d" + have "x = (x div d) * d + x mod d" + by auto + then have eq: "of_int x = ?t" + by (simp only: of_int_mult[symmetric] of_int_add [symmetric]) + then have "of_int x / of_int d = ?t / of_int d" + using cong[OF refl[of ?f] eq] by simp + then show ?thesis by (simp add: add_divide_distrib ring_simps prems) +qed + +lemma of_int_div: "(d::int) ~= 0 ==> d dvd n ==> + (of_int(n div d)::'a::{field, ring_char_0}) = of_int n / of_int d" + apply (frule of_int_div_aux [of d n, where ?'a = 'a]) + apply simp + apply (simp add: zdvd_iff_zmod_eq_0) +done + + +lemma normNum[simp]: "INum (normNum x) = (INum x :: 'a::{ring_char_0,field, division_by_zero})" +proof- + have "\ a b. x = (a,b)" by auto + then obtain a b where x[simp]: "x = (a,b)" by blast + {assume "a=0 \ b = 0" hence ?thesis + by (simp add: INum_def normNum_def split_def Let_def)} + moreover + {assume a: "a\0" and b: "b\0" + let ?g = "igcd a b" + from a b have g: "?g \ 0"by simp + from of_int_div[OF g, where ?'a = 'a] + have ?thesis by (auto simp add: INum_def normNum_def split_def Let_def)} + ultimately show ?thesis by blast +qed + +lemma INum_normNum_iff [code]: "(INum x ::'a::{field, division_by_zero, ring_char_0}) = INum y \ normNum x = normNum y" (is "?lhs = ?rhs") +proof - + have "normNum x = normNum y \ (INum (normNum x) :: 'a) = INum (normNum y)" + by (simp del: normNum) + also have "\ = ?lhs" by simp + finally show ?thesis by simp +qed + +lemma Nadd[simp]: "INum (x +\<^sub>N y) = INum x + (INum y :: 'a :: {ring_char_0,division_by_zero,field})" +proof- +let ?z = "0:: 'a" + have " \ a b. x = (a,b)" " \ a' b'. y = (a',b')" by auto + then obtain a b a' b' where x[simp]: "x = (a,b)" + and y[simp]: "y = (a',b')" by blast + {assume "a=0 \ a'= 0 \ b =0 \ b' = 0" hence ?thesis + apply (cases "a=0",simp_all add: Nadd_def) + apply (cases "b= 0",simp_all add: INum_def) + apply (cases "a'= 0",simp_all) + apply (cases "b'= 0",simp_all) + done } + moreover + {assume aa':"a \ 0" "a'\ 0" and bb': "b \ 0" "b' \ 0" + {assume z: "a * b' + b * a' = 0" + hence "of_int (a*b' + b*a') / (of_int b* of_int b') = ?z" by simp + hence "of_int b' * of_int a / (of_int b * of_int b') + of_int b * of_int a' / (of_int b * of_int b') = ?z" by (simp add:add_divide_distrib) + hence th: "of_int a / of_int b + of_int a' / of_int b' = ?z" using bb' aa' by simp + from z aa' bb' have ?thesis + by (simp add: th Nadd_def normNum_def INum_def split_def)} + moreover {assume z: "a * b' + b * a' \ 0" + let ?g = "igcd (a * b' + b * a') (b*b')" + have gz: "?g \ 0" using z by simp + have ?thesis using aa' bb' z gz + of_int_div[where ?'a = 'a, + OF gz igcd_dvd1[where i="a * b' + b * a'" and j="b*b'"]] + of_int_div[where ?'a = 'a, + OF gz igcd_dvd2[where i="a * b' + b * a'" and j="b*b'"]] + by (simp add: x y Nadd_def INum_def normNum_def Let_def add_divide_distrib)} + ultimately have ?thesis using aa' bb' + by (simp add: Nadd_def INum_def normNum_def x y Let_def) } + ultimately show ?thesis by blast +qed + +lemma Nmul[simp]: "INum (x *\<^sub>N y) = INum x * (INum y:: 'a :: {ring_char_0,division_by_zero,field}) " +proof- + let ?z = "0::'a" + have " \ a b. x = (a,b)" " \ a' b'. y = (a',b')" by auto + then obtain a b a' b' where x: "x = (a,b)" and y: "y = (a',b')" by blast + {assume "a=0 \ a'= 0 \ b = 0 \ b' = 0" hence ?thesis + apply (cases "a=0",simp_all add: x y Nmul_def INum_def Let_def) + apply (cases "b=0",simp_all) + apply (cases "a'=0",simp_all) + done } + moreover + {assume z: "a \ 0" "a' \ 0" "b \ 0" "b' \ 0" + let ?g="igcd (a*a') (b*b')" + have gz: "?g \ 0" using z by simp + from z of_int_div[where ?'a = 'a, OF gz igcd_dvd1[where i="a*a'" and j="b*b'"]] + of_int_div[where ?'a = 'a , OF gz igcd_dvd2[where i="a*a'" and j="b*b'"]] + have ?thesis by (simp add: Nmul_def x y Let_def INum_def)} + ultimately show ?thesis by blast +qed + +lemma Nneg[simp]: "INum (~\<^sub>N x) = - (INum x ::'a:: field)" + by (simp add: Nneg_def split_def INum_def) + +lemma Nsub[simp]: shows "INum (x -\<^sub>N y) = INum x - (INum y:: 'a :: {ring_char_0,division_by_zero,field})" +by (simp add: Nsub_def split_def) + +lemma Ninv[simp]: "INum (Ninv x) = (1::'a :: {division_by_zero,field}) / (INum x)" + by (simp add: Ninv_def INum_def split_def) + +lemma Ndiv[simp]: "INum (x \
\<^sub>N y) = INum x / (INum y ::'a :: {ring_char_0, division_by_zero,field})" by (simp add: Ndiv_def) + +lemma Nlt0_iff[simp]: assumes nx: "isnormNum x" + shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field})< 0) = 0>\<^sub>N x " +proof- + have " \ a b. x = (a,b)" by simp + then obtain a b where x[simp]:"x = (a,b)" by blast + {assume "a = 0" hence ?thesis by (simp add: Nlt0_def INum_def) } + moreover + {assume a: "a\0" hence b: "(of_int b::'a) > 0" using nx by (simp add: isnormNum_def) + from pos_divide_less_eq[OF b, where b="of_int a" and a="0::'a"] + have ?thesis by (simp add: Nlt0_def INum_def)} + ultimately show ?thesis by blast +qed + +lemma Nle0_iff[simp]:assumes nx: "isnormNum x" + shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field}) \ 0) = 0\\<^sub>N x" +proof- + have " \ a b. x = (a,b)" by simp + then obtain a b where x[simp]:"x = (a,b)" by blast + {assume "a = 0" hence ?thesis by (simp add: Nle0_def INum_def) } + moreover + {assume a: "a\0" hence b: "(of_int b :: 'a) > 0" using nx by (simp add: isnormNum_def) + from pos_divide_le_eq[OF b, where b="of_int a" and a="0::'a"] + have ?thesis by (simp add: Nle0_def INum_def)} + ultimately show ?thesis by blast +qed + +lemma Ngt0_iff[simp]:assumes nx: "isnormNum x" shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field})> 0) = 0<\<^sub>N x" +proof- + have " \ a b. x = (a,b)" by simp + then obtain a b where x[simp]:"x = (a,b)" by blast + {assume "a = 0" hence ?thesis by (simp add: Ngt0_def INum_def) } + moreover + {assume a: "a\0" hence b: "(of_int b::'a) > 0" using nx by (simp add: isnormNum_def) + from pos_less_divide_eq[OF b, where b="of_int a" and a="0::'a"] + have ?thesis by (simp add: Ngt0_def INum_def)} + ultimately show ?thesis by blast +qed +lemma Nge0_iff[simp]:assumes nx: "isnormNum x" + shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field}) \ 0) = 0\\<^sub>N x" +proof- + have " \ a b. x = (a,b)" by simp + then obtain a b where x[simp]:"x = (a,b)" by blast + {assume "a = 0" hence ?thesis by (simp add: Nge0_def INum_def) } + moreover + {assume a: "a\0" hence b: "(of_int b::'a) > 0" using nx by (simp add: isnormNum_def) + from pos_le_divide_eq[OF b, where b="of_int a" and a="0::'a"] + have ?thesis by (simp add: Nge0_def INum_def)} + ultimately show ?thesis by blast +qed + +lemma Nlt_iff[simp]: assumes nx: "isnormNum x" and ny: "isnormNum y" + shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field}) < INum y) = (x <\<^sub>N y)" +proof- + let ?z = "0::'a" + have "((INum x ::'a) < INum y) = (INum (x -\<^sub>N y) < ?z)" using nx ny by simp + also have "\ = (0>\<^sub>N (x -\<^sub>N y))" using Nlt0_iff[OF Nsub_normN[OF ny]] by simp + finally show ?thesis by (simp add: Nlt_def) +qed + +lemma Nle_iff[simp]: assumes nx: "isnormNum x" and ny: "isnormNum y" + shows "((INum x :: 'a :: {ring_char_0,division_by_zero,ordered_field})\ INum y) = (x \\<^sub>N y)" +proof- + have "((INum x ::'a) \ INum y) = (INum (x -\<^sub>N y) \ (0::'a))" using nx ny by simp + also have "\ = (0\\<^sub>N (x -\<^sub>N y))" using Nle0_iff[OF Nsub_normN[OF ny]] by simp + finally show ?thesis by (simp add: Nle_def) +qed + +lemma Nadd_commute: "x +\<^sub>N y = y +\<^sub>N x" +proof- + have n: "isnormNum (x +\<^sub>N y)" "isnormNum (y +\<^sub>N x)" by simp_all + have "(INum (x +\<^sub>N y)::'a :: {ring_char_0,division_by_zero,field}) = INum (y +\<^sub>N x)" by simp + with isnormNum_unique[OF n] show ?thesis by simp +qed + +lemma[simp]: "(0, b) +\<^sub>N y = normNum y" "(a, 0) +\<^sub>N y = normNum y" + "x +\<^sub>N (0, b) = normNum x" "x +\<^sub>N (a, 0) = normNum x" + apply (simp add: Nadd_def split_def, simp add: Nadd_def split_def) + apply (subst Nadd_commute,simp add: Nadd_def split_def) + apply (subst Nadd_commute,simp add: Nadd_def split_def) + done + +lemma normNum_nilpotent_aux[simp]: assumes nx: "isnormNum x" + shows "normNum x = x" +proof- + let ?a = "normNum x" + have n: "isnormNum ?a" by simp + have th:"INum ?a = (INum x ::'a :: {ring_char_0, division_by_zero,field})" by simp + with isnormNum_unique[OF n nx] + show ?thesis by simp +qed + +lemma normNum_nilpotent[simp]: "normNum (normNum x) = normNum x" + by simp +lemma normNum0[simp]: "normNum (0,b) = 0\<^sub>N" "normNum (a,0) = 0\<^sub>N" + by (simp_all add: normNum_def) +lemma normNum_Nadd: "normNum (x +\<^sub>N y) = x +\<^sub>N y" by simp +lemma Nadd_normNum1[simp]: "normNum x +\<^sub>N y = x +\<^sub>N y" +proof- + have n: "isnormNum (normNum x +\<^sub>N y)" "isnormNum (x +\<^sub>N y)" by simp_all + have "INum (normNum x +\<^sub>N y) = INum x + (INum y :: 'a :: {ring_char_0, division_by_zero,field})" by simp + also have "\ = INum (x +\<^sub>N y)" by simp + finally show ?thesis using isnormNum_unique[OF n] by simp +qed +lemma Nadd_normNum2[simp]: "x +\<^sub>N normNum y = x +\<^sub>N y" +proof- + have n: "isnormNum (x +\<^sub>N normNum y)" "isnormNum (x +\<^sub>N y)" by simp_all + have "INum (x +\<^sub>N normNum y) = INum x + (INum y :: 'a :: {ring_char_0, division_by_zero,field})" by simp + also have "\ = INum (x +\<^sub>N y)" by simp + finally show ?thesis using isnormNum_unique[OF n] by simp +qed + +lemma Nadd_assoc: "x +\<^sub>N y +\<^sub>N z = x +\<^sub>N (y +\<^sub>N z)" +proof- + have n: "isnormNum (x +\<^sub>N y +\<^sub>N z)" "isnormNum (x +\<^sub>N (y +\<^sub>N z))" by simp_all + have "INum (x +\<^sub>N y +\<^sub>N z) = (INum (x +\<^sub>N (y +\<^sub>N z)) :: 'a :: {ring_char_0, division_by_zero,field})" by simp + with isnormNum_unique[OF n] show ?thesis by simp +qed + +lemma Nmul_commute: "isnormNum x \ isnormNum y \ x *\<^sub>N y = y *\<^sub>N x" + by (simp add: Nmul_def split_def Let_def igcd_commute mult_commute) + +lemma Nmul_assoc: assumes nx: "isnormNum x" and ny:"isnormNum y" and nz:"isnormNum z" + shows "x *\<^sub>N y *\<^sub>N z = x *\<^sub>N (y *\<^sub>N z)" +proof- + from nx ny nz have n: "isnormNum (x *\<^sub>N y *\<^sub>N z)" "isnormNum (x *\<^sub>N (y *\<^sub>N z))" + by simp_all + have "INum (x +\<^sub>N y +\<^sub>N z) = (INum (x +\<^sub>N (y +\<^sub>N z)) :: 'a :: {ring_char_0, division_by_zero,field})" by simp + with isnormNum_unique[OF n] show ?thesis by simp +qed + +lemma Nsub0: assumes x: "isnormNum x" and y:"isnormNum y" shows "(x -\<^sub>N y = 0\<^sub>N) = (x = y)" +proof- + {fix h :: "'a :: {ring_char_0,division_by_zero,ordered_field}" + from isnormNum_unique[where ?'a = 'a, OF Nsub_normN[OF y], where y="0\<^sub>N"] + have "(x -\<^sub>N y = 0\<^sub>N) = (INum (x -\<^sub>N y) = (INum 0\<^sub>N :: 'a)) " by simp + also have "\ = (INum x = (INum y:: 'a))" by simp + also have "\ = (x = y)" using x y by simp + finally show ?thesis .} +qed + +lemma Nmul0[simp]: "c *\<^sub>N 0\<^sub>N = 0\<^sub>N" " 0\<^sub>N *\<^sub>N c = 0\<^sub>N" + by (simp_all add: Nmul_def Let_def split_def) + +lemma Nmul_eq0[simp]: assumes nx:"isnormNum x" and ny: "isnormNum y" + shows "(x*\<^sub>N y = 0\<^sub>N) = (x = 0\<^sub>N \ y = 0\<^sub>N)" +proof- + {fix h :: "'a :: {ring_char_0,division_by_zero,ordered_field}" + have " \ a b a' b'. x = (a,b) \ y= (a',b')" by auto + then obtain a b a' b' where xy[simp]: "x = (a,b)" "y = (a',b')" by blast + have n0: "isnormNum 0\<^sub>N" by simp + show ?thesis using nx ny + apply (simp only: isnormNum_unique[where ?'a = 'a, OF Nmul_normN[OF nx ny] n0, symmetric] Nmul[where ?'a = 'a]) + apply (simp add: INum_def split_def isnormNum_def fst_conv snd_conv) + apply (cases "a=0",simp_all) + apply (cases "a'=0",simp_all) + done } +qed +lemma Nneg_Nneg[simp]: "~\<^sub>N (~\<^sub>N c) = c" + by (simp add: Nneg_def split_def) + +lemma Nmul1[simp]: + "isnormNum c \ 1\<^sub>N *\<^sub>N c = c" + "isnormNum c \ c *\<^sub>N 1\<^sub>N = c" + apply (simp_all add: Nmul_def Let_def split_def isnormNum_def) + by (cases "fst c = 0", simp_all,cases c, simp_all)+ + +end \ No newline at end of file diff -r f1dbfd7e3223 -r c9e3cb5e5681 src/HOL/Library/Executable_Rat.thy --- a/src/HOL/Library/Executable_Rat.thy Thu Aug 09 15:52:47 2007 +0200 +++ b/src/HOL/Library/Executable_Rat.thy Thu Aug 09 15:52:49 2007 +0200 @@ -3,107 +3,95 @@ Author: Florian Haftmann, TU Muenchen *) -header {* Executable implementation of rational numbers in HOL *} +header {* Implementation of rational numbers as pairs of integers *} theory Executable_Rat -imports "~~/src/HOL/Real/Rational" "~~/src/HOL/NumberTheory/IntPrimes" +imports Abstract_Rat "~~/src/HOL/Real/Rational" begin -text {* - Actually \emph{nothing} is proved about this implementation. -*} - -subsection {* Representation and operations of executable rationals *} - -datatype erat = Rat bool nat nat - -axiomatization - div_zero :: erat - -fun - common :: "(nat * nat) \ (nat * nat) \ (nat * nat) * nat" where - "common (p1, q1) (p2, q2) = ( - let - q' = q1 * q2 div gcd (q1, q2) - in ((p1 * (q' div q1), p2 * (q' div q2)), q'))" - -definition - minus_sign :: "nat \ nat \ bool * nat" where - "minus_sign n m = (if n < m then (False, m - n) else (True, n - m))" - -fun - add_sign :: "bool * nat \ bool * nat \ bool * nat" where - "add_sign (True, n) (True, m) = (True, n + m)" -| "add_sign (False, n) (False, m) = (False, n + m)" -| "add_sign (True, n) (False, m) = minus_sign n m" -| "add_sign (False, n) (True, m) = minus_sign m n" +hide (open) const Rat definition - erat_of_quotient :: "int \ int \ erat" where - "erat_of_quotient k1 k2 = ( - let - l1 = nat (abs k1); - l2 = nat (abs k2); - m = gcd (l1, l2) - in Rat (k1 \ 0 \ k2 \ 0) (l1 div m) (l2 div m))" + Rat :: "int \ int \ rat" +where + "Rat = INum" + +code_datatype Rat -instance erat :: zero - zero_rat_def: "0 \ Rat True 0 1" .. - -instance erat :: one - one_rat_def: "1 \ Rat True 1 1" .. +lemma Rat_simp: + "Rat (k, l) = rat_of_int k / rat_of_int l" + unfolding Rat_def INum_def by simp -instance erat :: plus - add_rat_def: "r + s \ case r of Rat a1 p1 q1 \ case s of Rat a2 p2 q2 \ - let - ((r1, r2), den) = common (p1, q1) (p2, q2); - (sign, num) = add_sign (a1, r1) (a2, r2) - in Rat sign num den" .. +lemma Rat_zero [simp]: "Rat 0\<^sub>N = 0" + by (simp add: Rat_simp) + +lemma Rat_lit [simp]: "Rat i\<^sub>N = rat_of_int i" + by (simp add: Rat_simp) + +lemma zero_rat_code [code]: + "0 = Rat 0\<^sub>N" by simp -instance erat :: minus - uminus_rat_def: "- r \ case r of Rat a p q \ - if p = 0 then Rat True 0 1 - else Rat (\ a) p q" .. - -instance erat :: times - times_rat_def: "r * s \ case r of Rat a1 p1 q1 \ case s of Rat a2 p2 q2 \ - let - p = p1 * p2; - q = q1 * q2; - m = gcd (p, q) - in Rat (a1 = a2) (p div m) (q div m)" .. +lemma zero_rat_code [code]: + "1 = Rat 1\<^sub>N" by simp -instance erat :: inverse - inverse_rat_def: "inverse r \ case r of Rat a p q \ - if p = 0 then div_zero - else Rat a q p" .. +lemma [code, code unfold]: + "number_of k = rat_of_int (number_of k)" + by (simp add: number_of_is_id rat_number_of_def) + +definition + [code func del]: "Fract' (b\bool) k l = Fract k l" -instance erat :: ord - le_rat_def: "r1 \ r2 \ case r1 of Rat a1 p1 q1 \ case r2 of Rat a2 p2 q2 \ - (\ a1 \ a2) \ - (\ (a1 \ \ a2) \ - (let - ((r1, r2), dummy) = common (p1, q1) (p2, q2) - in if a1 then r1 \ r2 else r2 \ r1))" .. - - -subsection {* Code generator setup *} +lemma [code]: + "Fract k l = Fract' (l \ 0) k l" + unfolding Fract'_def .. -subsubsection {* code lemmas *} - -lemma number_of_rat [code unfold]: - "(number_of k \ rat) = Fract k 1" - unfolding Fract_of_int_eq rat_number_of_def by simp +lemma [code]: + "Fract' True k l = (if l \ 0 then Rat (k, l) else Fract 1 0)" + by (simp add: Fract'_def Rat_simp Fract_of_int_quotient [of k l]) -lemma rat_minus [code func]: - "(a\rat) - b = a + (- b)" unfolding diff_minus .. - -lemma rat_divide [code func]: - "(a\rat) / b = a * inverse b" unfolding divide_inverse .. +lemma [code]: + "of_rat (Rat (k, l)) = (if l \ 0 then of_int k / of_int l else 0)" + by (cases "l = 0") + (auto simp add: Rat_simp of_rat_rat [simplified Fract_of_int_quotient [of k l], symmetric]) instance rat :: eq .. -subsubsection {* names *} +lemma rat_eq_code [code]: "Rat x = Rat y \ normNum x = normNum y" + unfolding Rat_def INum_normNum_iff .. + +lemma rat_less_eq_code [code]: "Rat x \ Rat y \ normNum x \\<^sub>N normNum y" +proof - + have "normNum x \\<^sub>N normNum y \ Rat (normNum x) \ Rat (normNum y)" + by (simp add: Rat_def del: normNum) + also have "\ = (Rat x \ Rat y)" by (simp add: Rat_def) + finally show ?thesis by simp +qed + +lemma rat_less_code [code]: "Rat x < Rat y \ normNum x <\<^sub>N normNum y" +proof - + have "normNum x <\<^sub>N normNum y \ Rat (normNum x) < Rat (normNum y)" + by (simp add: Rat_def del: normNum) + also have "\ = (Rat x < Rat y)" by (simp add: Rat_def) + finally show ?thesis by simp +qed + +lemma rat_add_code [code]: "Rat x + Rat y = Rat (x +\<^sub>N y)" + unfolding Rat_def by simp + +lemma rat_mul_code [code]: "Rat x * Rat y = Rat (x *\<^sub>N y)" + unfolding Rat_def by simp + +lemma rat_neg_code [code]: "- Rat x = Rat (~\<^sub>N x)" + unfolding Rat_def by simp + +lemma rat_sub_code [code]: "Rat x - Rat y = Rat (x -\<^sub>N y)" + unfolding Rat_def by simp + +lemma rat_inv_code [code]: "inverse (Rat x) = Rat (Ninv x)" + unfolding Rat_def Ninv divide_rat_def by simp + +lemma rat_div_code [code]: "Rat x / Rat y = Rat (x \
\<^sub>N y)" + unfolding Rat_def by simp code_modulename SML Executable_Rat Rational @@ -114,37 +102,4 @@ code_modulename Haskell Executable_Rat Rational -subsubsection {* rat as abstype *} - -code_const div_zero - (SML "raise/ Fail/ \"Division by zero\"") - (OCaml "failwith \"Division by zero\"") - (Haskell "error/ \"Division by zero\"") - -code_abstype rat erat where - Fract \ erat_of_quotient - "0 \ rat" \ "0 \ erat" - "1 \ rat" \ "1 \ erat" - "op + \ rat \ rat \ rat" \ "op + \ erat \ erat \ erat" - "uminus \ rat \ rat" \ "uminus \ erat \ erat" - "op * \ rat \ rat \ rat" \ "op * \ erat \ erat \ erat" - "inverse \ rat \ rat" \ "inverse \ erat \ erat" - "op \ \ rat \ rat \ bool" \ "op \ \ erat \ erat \ bool" - "op = \ rat \ rat \ bool" \ "op = \ erat \ erat \ bool" - -types_code - rat ("{*erat*}") - -consts_code - div_zero ("(raise/ (Fail/ \"Division by zero\"))") - Fract ("({*erat_of_quotient*} (_) (_))") - "0 \ rat" ("({*Rat True 0 1*})") - "1 \ rat" ("({*Rat True 1 1*})") - "plus \ rat \ rat \ rat" ("({*op + \ erat \ erat \ erat*} (_) (_))") - "uminus \ rat \ rat" ("({*uminus \ erat \ erat*} (_))") - "op * \ rat \ rat \ rat" ("({*op * \ erat \ erat \ erat*} (_) (_))") - "inverse \ rat \ rat" ("({*inverse \ erat \ erat*} (_))") - "op \ \ rat \ rat \ bool" ("({*op \ \ erat \ erat \ bool*} (_) (_))") - "op = \ rat \ rat \ bool" ("({*op = \ erat \ erat \ bool*} (_) (_))") - end diff -r f1dbfd7e3223 -r c9e3cb5e5681 src/HOL/Library/Executable_Real.thy --- a/src/HOL/Library/Executable_Real.thy Thu Aug 09 15:52:47 2007 +0200 +++ b/src/HOL/Library/Executable_Real.thy Thu Aug 09 15:52:49 2007 +0200 @@ -1,472 +1,81 @@ (* Title: HOL/Library/Executable_Real.thy ID: $Id$ - Author: Amine Chaieb, TU Muenchen + Author: Florian Haftmann, TU Muenchen *) header {* Implementation of rational real numbers as pairs of integers *} theory Executable_Real -imports GCD "~~/src/HOL/Real/Real" +imports Abstract_Rat "~~/src/HOL/Real/Real" begin -subsection {* Implementation of operations on pair of integers *} - -types Num = "int * int" -syntax "_Num0" :: "Num" ("0\<^sub>N") -translations "0\<^sub>N" \ "(0,0)" -syntax "_Numi" :: "int \ Num" ("_\<^sub>N") -translations "i\<^sub>N" \ "(i,1)::Num" - -constdefs isnormNum :: "Num \ bool" - "isnormNum \ \(a,b). (if a = 0 then b = 0 else b > 0 \ igcd a b = 1)" - -constdefs normNum :: "Num \ Num" - "normNum \ \(a,b). (if a=0 \ b = 0 then (0,0) else - (let g = igcd a b - in if b > 0 then (a div g, b div g) else (- (a div g), - (b div g))))" - -lemma normNum_isnormNum[simp]: "isnormNum (normNum x)" -proof- - have " \ a b. x = (a,b)" by auto - then obtain a b where x[simp]: "x = (a,b)" by blast - {assume "a=0 \ b = 0" hence ?thesis by (simp add: normNum_def isnormNum_def)} - moreover - {assume anz: "a \ 0" and bnz: "b \ 0" - let ?g = "igcd a b" - let ?a' = "a div ?g" - let ?b' = "b div ?g" - let ?g' = "igcd ?a' ?b'" - from anz bnz have "?g \ 0" by simp with igcd_pos[of a b] - have gpos: "?g > 0" by arith - have gdvd: "?g dvd a" "?g dvd b" by (simp_all add: igcd_dvd1 igcd_dvd2) - from zdvd_mult_div_cancel[OF gdvd(1)] zdvd_mult_div_cancel[OF gdvd(2)] - anz bnz - have nz':"?a' \ 0" "?b' \ 0" - by - (rule notI,simp add:igcd_def)+ - from anz bnz have stupid: "a \ 0 \ b \ 0" by blast - from div_igcd_relprime[OF stupid] have gp1: "?g' = 1" . - from bnz have "b < 0 \ b > 0" by arith - moreover - {assume b: "b > 0" - from pos_imp_zdiv_nonneg_iff[OF gpos] b - have "?b' \ 0" by simp - with nz' have b': "?b' > 0" by simp - from b b' anz bnz nz' gp1 have ?thesis - by (simp add: isnormNum_def normNum_def Let_def split_def fst_conv snd_conv)} - moreover {assume b: "b < 0" - {assume b': "?b' \ 0" - from gpos have th: "?g \ 0" by arith - from mult_nonneg_nonneg[OF th b'] zdvd_mult_div_cancel[OF gdvd(2)] - have False using b by simp } - hence b': "?b' < 0" by (auto simp add: linorder_not_le[symmetric]) - from anz bnz nz' b b' gp1 have ?thesis - by (simp add: isnormNum_def normNum_def Let_def split_def fst_conv snd_conv)} - ultimately have ?thesis by blast - } - ultimately show ?thesis by blast -qed - (* Arithmetic over Num *) -constdefs Nadd :: "Num \ Num \ Num" (infixl "+\<^sub>N" 60) - "Nadd \ \(a,b) (a',b'). if a = 0 \ b = 0 then normNum(a',b') - else if a'=0 \ b' = 0 then normNum(a,b) - else normNum(a*b' + b*a', b*b')" -constdefs Nmul :: "Num \ Num \ Num" (infixl "*\<^sub>N" 60) - "Nmul \ \(a,b) (a',b'). let g = igcd (a*a') (b*b') - in (a*a' div g, b*b' div g)" -constdefs Nneg :: "Num \ Num" ("~\<^sub>N") - "Nneg \ \(a,b). (-a,b)" -constdefs Nsub :: "Num \ Num \ Num" (infixl "-\<^sub>N" 60) - "Nsub \ \a b. a +\<^sub>N ~\<^sub>N b" -constdefs Ninv :: "Num \ Num" -"Ninv \ \(a,b). if a < 0 then (-b, \a\) else (b,a)" -constdefs Ndiv :: "Num \ Num \ Num" (infixl "\
\<^sub>N" 60) - "Ndiv \ \a b. a *\<^sub>N Ninv b" - -lemma Nneg_normN[simp]: "isnormNum x \ isnormNum (~\<^sub>N x)" - by(simp add: isnormNum_def Nneg_def split_def) -lemma Nadd_normN[simp]: "isnormNum (x +\<^sub>N y)" - by (simp add: Nadd_def split_def) -lemma Nsub_normN[simp]: "\ isnormNum y\ \ isnormNum (x -\<^sub>N y)" - by (simp add: Nsub_def split_def) -lemma Nmul_normN[simp]: assumes xn:"isnormNum x" and yn: "isnormNum y" - shows "isnormNum (x *\<^sub>N y)" -proof- - have "\a b. x = (a,b)" and "\ a' b'. y = (a',b')" by auto - then obtain a b a' b' where ab: "x = (a,b)" and ab': "y = (a',b')" by blast - {assume "a = 0" - hence ?thesis using xn ab ab' - by (simp add: igcd_def isnormNum_def Let_def Nmul_def split_def)} - moreover - {assume "a' = 0" - hence ?thesis using yn ab ab' - by (simp add: igcd_def isnormNum_def Let_def Nmul_def split_def)} - moreover - {assume a: "a \0" and a': "a'\0" - hence bp: "b > 0" "b' > 0" using xn yn ab ab' by (simp_all add: isnormNum_def) - from mult_pos_pos[OF bp] have "x *\<^sub>N y = normNum (a*a', b*b')" - using ab ab' a a' bp by (simp add: Nmul_def Let_def split_def normNum_def) - hence ?thesis by simp} - ultimately show ?thesis by blast -qed - -lemma Ninv_normN[simp]: "isnormNum x \ isnormNum (Ninv x)" -by (simp add: Ninv_def isnormNum_def split_def) -(cases "fst x = 0",auto simp add: igcd_commute) - -lemma isnormNum_int[simp]: - "isnormNum 0\<^sub>N" "isnormNum (1::int)\<^sub>N" "i \ 0 \ isnormNum i\<^sub>N" - by (simp_all add: isnormNum_def igcd_def) - - (* Relations over Num *) -constdefs Nlt0:: "Num \ bool" ("0>\<^sub>N") - "Nlt0 \ \(a,b). a < 0" -constdefs Nle0:: "Num \ bool" ("0\\<^sub>N") - "Nle0 \ \(a,b). a \ 0" -constdefs Ngt0:: "Num \ bool" ("0<\<^sub>N") - "Ngt0 \ \(a,b). a > 0" -constdefs Nge0:: "Num \ bool" ("0\\<^sub>N") - "Nge0 \ \(a,b). a \ 0" -constdefs Nlt :: "Num \ Num \ bool" (infix "<\<^sub>N" 55) - "Nlt \ \a b. 0>\<^sub>N (a -\<^sub>N b)" -constdefs Nle :: "Num \ Num \ bool" (infix "\\<^sub>N" 55) - "Nle \ \a b. 0\\<^sub>N (a -\<^sub>N b)" - - -subsection {* Interpretation of the normalized rats in reals *} +hide (open) const Real definition - INum:: "Num \ real" + Real :: "int \ int \ real" where - INum_def: "INum \ \(a,b). real a / real b" + "Real = INum" + +code_datatype Real + +lemma Real_simp: + "Real (k, l) = real_of_int k / real_of_int l" + unfolding Real_def INum_def by simp + +lemma Real_zero [simp]: "Real 0\<^sub>N = 0" + by (simp add: Real_simp) -code_datatype INum +lemma Real_lit [simp]: "Real i\<^sub>N = real_of_int i" + by (simp add: Real_simp) + +lemma zero_real_code [code]: + "0 = Real 0\<^sub>N" by simp + +lemma zero_real_code [code]: + "1 = Real 1\<^sub>N" by simp + +lemma [code, code unfold]: + "number_of k = real_of_int (number_of k)" + by (simp add: number_of_is_id real_number_of_def) + instance real :: eq .. -definition - real_int :: "int \ real" -where - "real_int = real" -lemmas [code unfold] = real_int_def [symmetric] - -lemma [code unfold]: - "real = real_int o int" - by (auto simp add: real_int_def expand_fun_eq) - -lemma INum_int [simp]: "INum i\<^sub>N = real i" "INum 0\<^sub>N = 0" - by (simp_all add: INum_def) -lemmas [code, code unfold] = INum_int [unfolded real_int_def [symmetric], symmetric] - -lemma [code, code unfold]: "1 = INum 1\<^sub>N" by simp +lemma real_eq_code [code]: "Real x = Real y \ normNum x = normNum y" + unfolding Real_def INum_normNum_iff .. -lemma isnormNum_unique[simp]: - assumes na: "isnormNum x" and nb: "isnormNum y" - shows "(INum x = INum y) = (x = y)" (is "?lhs = ?rhs") -proof - have "\ a b a' b'. x = (a,b) \ y = (a',b')" by auto - then obtain a b a' b' where xy[simp]: "x = (a,b)" "y=(a',b')" by blast - assume H: ?lhs - {assume "a = 0 \ b = 0 \ a' = 0 \ b' = 0" hence ?rhs - using na nb H - by (simp add: INum_def split_def isnormNum_def) - (cases "a = 0", simp_all,cases "b = 0", simp_all, - cases "a' = 0", simp_all,cases "a' = 0", simp_all)} - moreover - { assume az: "a \ 0" and bz: "b \ 0" and a'z: "a'\0" and b'z: "b'\0" - from az bz a'z b'z na nb have pos: "b > 0" "b' > 0" by (simp_all add: isnormNum_def) - from prems have eq:"a * b' = a'*b" - by (simp add: INum_def eq_divide_eq divide_eq_eq real_of_int_mult[symmetric] del: real_of_int_mult) - from prems have gcd1: "igcd a b = 1" "igcd b a = 1" "igcd a' b' = 1" "igcd b' a' = 1" - by (simp_all add: isnormNum_def add: igcd_commute) - from eq have raw_dvd: "a dvd a'*b" "b dvd b'*a" "a' dvd a*b'" "b' dvd b*a'" - apply(unfold dvd_def) - apply (rule_tac x="b'" in exI, simp add: mult_ac) - apply (rule_tac x="a'" in exI, simp add: mult_ac) - apply (rule_tac x="b" in exI, simp add: mult_ac) - apply (rule_tac x="a" in exI, simp add: mult_ac) - done - from zdvd_dvd_eq[OF bz zrelprime_dvd_mult[OF gcd1(2) raw_dvd(2)] - zrelprime_dvd_mult[OF gcd1(4) raw_dvd(4)]] - have eq1: "b = b'" using pos by simp_all - with eq have "a = a'" using pos by simp - with eq1 have ?rhs by simp} - ultimately show ?rhs by blast -next - assume ?rhs thus ?lhs by simp -qed - - -lemma isnormNum0[simp]: "isnormNum x \ (INum x = 0) = (x = 0\<^sub>N)" - unfolding INum_int(2)[symmetric] - by (rule isnormNum_unique, simp_all) - -lemma normNum[simp]: "INum (normNum x) = INum x" -proof- - have "\ a b. x = (a,b)" by auto - then obtain a b where x[simp]: "x = (a,b)" by blast - {assume "a=0 \ b = 0" hence ?thesis - by (simp add: INum_def normNum_def split_def Let_def)} - moreover - {assume a: "a\0" and b: "b\0" - let ?g = "igcd a b" - from a b have g: "?g \ 0"by simp - from real_of_int_div[OF g] - have ?thesis by (simp add: INum_def normNum_def split_def Let_def)} - ultimately show ?thesis by blast -qed - -lemma INum_normNum_iff [code]: "INum x = INum y \ normNum x = normNum y" (is "?lhs = ?rhs") +lemma real_less_eq_code [code]: "Real x \ Real y \ normNum x \\<^sub>N normNum y" proof - - have "normNum x = normNum y \ INum (normNum x) = INum (normNum y)" - by (simp del: normNum) - also have "\ = ?lhs" by simp + have "normNum x \\<^sub>N normNum y \ Real (normNum x) \ Real (normNum y)" + by (simp add: Real_def del: normNum) + also have "\ = (Real x \ Real y)" by (simp add: Real_def) finally show ?thesis by simp qed -lemma Nadd[simp]: "INum (x +\<^sub>N y) = INum x + INum y" -proof- - have " \ a b. x = (a,b)" " \ a' b'. y = (a',b')" by auto - then obtain a b a' b' where x[simp]: "x = (a,b)" - and y[simp]: "y = (a',b')" by blast - {assume "a=0 \ a'= 0 \ b =0 \ b' = 0" hence ?thesis - apply (cases "a=0",simp_all add: Nadd_def) - apply (cases "b= 0",simp_all add: INum_def) - apply (cases "a'= 0",simp_all) - apply (cases "b'= 0",simp_all) - done } - moreover - {assume aa':"a \ 0" "a'\ 0" and bb': "b \ 0" "b' \ 0" - {assume z: "a * b' + b * a' = 0" - hence "real (a*b' + b*a') / (real b* real b') = 0" by simp - hence "real b' * real a / (real b * real b') + real b * real a' / (real b * real b') = 0" by (simp add:add_divide_distrib) - hence th: "real a / real b + real a' / real b' = 0" using bb' aa' by simp - from z aa' bb' have ?thesis - by (simp add: th Nadd_def normNum_def INum_def split_def)} - moreover {assume z: "a * b' + b * a' \ 0" - let ?g = "igcd (a * b' + b * a') (b*b')" - have gz: "?g \ 0" using z by simp - have ?thesis using aa' bb' z gz - real_of_int_div[OF gz igcd_dvd1[where i="a * b' + b * a'" and j="b*b'"]] - real_of_int_div[OF gz igcd_dvd2[where i="a * b' + b * a'" and j="b*b'"]] - by (simp add: x y Nadd_def INum_def normNum_def Let_def add_divide_distrib)} - ultimately have ?thesis using aa' bb' - by (simp add: Nadd_def INum_def normNum_def x y Let_def) } - ultimately show ?thesis by blast -qed -lemmas [code] = Nadd [symmetric] - -lemma Nmul[simp]: "INum (x *\<^sub>N y) = INum x * INum y" -proof- - have " \ a b. x = (a,b)" " \ a' b'. y = (a',b')" by auto - then obtain a b a' b' where x: "x = (a,b)" and y: "y = (a',b')" by blast - {assume "a=0 \ a'= 0 \ b = 0 \ b' = 0" hence ?thesis - apply (cases "a=0",simp_all add: x y Nmul_def INum_def Let_def) - apply (cases "b=0",simp_all) - apply (cases "a'=0",simp_all) - done } - moreover - {assume z: "a \ 0" "a' \ 0" "b \ 0" "b' \ 0" - let ?g="igcd (a*a') (b*b')" - have gz: "?g \ 0" using z by simp - from z real_of_int_div[OF gz igcd_dvd1[where i="a*a'" and j="b*b'"]] - real_of_int_div[OF gz igcd_dvd2[where i="a*a'" and j="b*b'"]] - have ?thesis by (simp add: Nmul_def x y Let_def INum_def)} - ultimately show ?thesis by blast -qed -lemmas [code] = Nmul [symmetric] - -lemma Nneg[simp]: "INum (~\<^sub>N x) = - INum x" - by (simp add: Nneg_def split_def INum_def) -lemmas [code] = Nneg [symmetric] - -lemma Nsub[simp]: shows "INum (x -\<^sub>N y) = INum x - INum y" - by (simp add: Nsub_def split_def) -lemmas [code] = Nsub [symmetric] - -lemma Ninv[simp]: "INum (Ninv x) = 1 / (INum x)" - by (simp add: Ninv_def INum_def split_def) -lemmas [code] = Ninv [symmetric] - -lemma Ndiv[simp]: "INum (x \
\<^sub>N y) = INum x / INum y" by (simp add: Ndiv_def) -lemmas [code] = Ndiv [symmetric] - -lemma Nlt0_iff[simp]: assumes nx: "isnormNum x" shows "(INum x < 0) = 0>\<^sub>N x " -proof- - have " \ a b. x = (a,b)" by simp - then obtain a b where x[simp]:"x = (a,b)" by blast - {assume "a = 0" hence ?thesis by (simp add: Nlt0_def INum_def) } - moreover - {assume a: "a\0" hence b: "real b > 0" using nx by (simp add: isnormNum_def) - from pos_divide_less_eq[OF b, where b="real a" and a="0"] - have ?thesis by (simp add: Nlt0_def INum_def)} - ultimately show ?thesis by blast -qed - -lemma Nle0_iff[simp]:assumes nx: "isnormNum x" shows "(INum x \ 0) = 0\\<^sub>N x" -proof- - have " \ a b. x = (a,b)" by simp - then obtain a b where x[simp]:"x = (a,b)" by blast - {assume "a = 0" hence ?thesis by (simp add: Nle0_def INum_def) } - moreover - {assume a: "a\0" hence b: "real b > 0" using nx by (simp add: isnormNum_def) - from pos_divide_le_eq[OF b, where b="real a" and a="0"] - have ?thesis by (simp add: Nle0_def INum_def)} - ultimately show ?thesis by blast -qed - -lemma Ngt0_iff[simp]:assumes nx: "isnormNum x" shows "(INum x > 0) = 0<\<^sub>N x" -proof- - have " \ a b. x = (a,b)" by simp - then obtain a b where x[simp]:"x = (a,b)" by blast - {assume "a = 0" hence ?thesis by (simp add: Ngt0_def INum_def) } - moreover - {assume a: "a\0" hence b: "real b > 0" using nx by (simp add: isnormNum_def) - from pos_less_divide_eq[OF b, where b="real a" and a="0"] - have ?thesis by (simp add: Ngt0_def INum_def)} - ultimately show ?thesis by blast -qed -lemma Nge0_iff[simp]:assumes nx: "isnormNum x" shows "(INum x \ 0) = 0\\<^sub>N x" -proof- - have " \ a b. x = (a,b)" by simp - then obtain a b where x[simp]:"x = (a,b)" by blast - {assume "a = 0" hence ?thesis by (simp add: Nge0_def INum_def) } - moreover - {assume a: "a\0" hence b: "real b > 0" using nx by (simp add: isnormNum_def) - from pos_le_divide_eq[OF b, where b="real a" and a="0"] - have ?thesis by (simp add: Nge0_def INum_def)} - ultimately show ?thesis by blast -qed - -lemma Nlt_iff[simp]: assumes nx: "isnormNum x" and ny: "isnormNum y" - shows "(INum x < INum y) = (x <\<^sub>N y)" -proof- - have "(INum x < INum y) = (INum (x -\<^sub>N y) < 0)" using nx ny by simp - also have "\ = (0>\<^sub>N (x -\<^sub>N y))" using Nlt0_iff[OF Nsub_normN[OF ny]] by simp - finally show ?thesis by (simp add: Nlt_def) -qed - -lemma [code]: "INum x < INum y \ normNum x <\<^sub>N normNum y" +lemma real_less_code [code]: "Real x < Real y \ normNum x <\<^sub>N normNum y" proof - - have "normNum x <\<^sub>N normNum y \ INum (normNum x) < INum (normNum y)" - by (simp del: normNum) - also have "\ = (INum x < INum y)" by simp + have "normNum x <\<^sub>N normNum y \ Real (normNum x) < Real (normNum y)" + by (simp add: Real_def del: normNum) + also have "\ = (Real x < Real y)" by (simp add: Real_def) finally show ?thesis by simp qed -lemma Nle_iff[simp]: assumes nx: "isnormNum x" and ny: "isnormNum y" - shows "(INum x \ INum y) = (x \\<^sub>N y)" -proof- - have "(INum x \ INum y) = (INum (x -\<^sub>N y) \ 0)" using nx ny by simp - also have "\ = (0\\<^sub>N (x -\<^sub>N y))" using Nle0_iff[OF Nsub_normN[OF ny]] by simp - finally show ?thesis by (simp add: Nle_def) -qed - -lemma [code]: "INum x \ INum y \ normNum x \\<^sub>N normNum y" -proof - - have "normNum x \\<^sub>N normNum y \ INum (normNum x) \ INum (normNum y)" - by (simp del: normNum) - also have "\ = (INum x \ INum y)" by simp - finally show ?thesis by simp -qed +lemma real_add_code [code]: "Real x + Real y = Real (x +\<^sub>N y)" + unfolding Real_def by simp -lemma Nadd_commute: "x +\<^sub>N y = y +\<^sub>N x" -proof- - have n: "isnormNum (x +\<^sub>N y)" "isnormNum (y +\<^sub>N x)" by simp_all - have "INum (x +\<^sub>N y) = INum (y +\<^sub>N x)" by simp - with isnormNum_unique[OF n] show ?thesis by simp -qed +lemma real_mul_code [code]: "Real x * Real y = Real (x *\<^sub>N y)" + unfolding Real_def by simp -lemma[simp]: "(0, b) +\<^sub>N y = normNum y" "(a, 0) +\<^sub>N y = normNum y" - "x +\<^sub>N (0, b) = normNum x" "x +\<^sub>N (a, 0) = normNum x" - apply (simp add: Nadd_def split_def, simp add: Nadd_def split_def) - apply (subst Nadd_commute,simp add: Nadd_def split_def) - apply (subst Nadd_commute,simp add: Nadd_def split_def) - done - -lemma normNum_nilpotent_aux[simp]: assumes nx: "isnormNum x" - shows "normNum x = x" -proof- - let ?a = "normNum x" - have n: "isnormNum ?a" by simp - have th:"INum ?a = INum x" by simp - with isnormNum_unique[OF n nx] - show ?thesis by simp -qed +lemma real_neg_code [code]: "- Real x = Real (~\<^sub>N x)" + unfolding Real_def by simp -lemma normNum_nilpotent[simp]: "normNum (normNum x) = normNum x" - by simp -lemma normNum0[simp]: "normNum (0,b) = 0\<^sub>N" "normNum (a,0) = 0\<^sub>N" - by (simp_all add: normNum_def) -lemma normNum_Nadd: "normNum (x +\<^sub>N y) = x +\<^sub>N y" by simp -lemma Nadd_normNum1[simp]: "normNum x +\<^sub>N y = x +\<^sub>N y" -proof- - have n: "isnormNum (normNum x +\<^sub>N y)" "isnormNum (x +\<^sub>N y)" by simp_all - have "INum (normNum x +\<^sub>N y) = INum x + INum y" by simp - also have "\ = INum (x +\<^sub>N y)" by simp - finally show ?thesis using isnormNum_unique[OF n] by simp -qed -lemma Nadd_normNum2[simp]: "x +\<^sub>N normNum y = x +\<^sub>N y" -proof- - have n: "isnormNum (x +\<^sub>N normNum y)" "isnormNum (x +\<^sub>N y)" by simp_all - have "INum (x +\<^sub>N normNum y) = INum x + INum y" by simp - also have "\ = INum (x +\<^sub>N y)" by simp - finally show ?thesis using isnormNum_unique[OF n] by simp -qed - -lemma Nadd_assoc: "x +\<^sub>N y +\<^sub>N z = x +\<^sub>N (y +\<^sub>N z)" -proof- - have n: "isnormNum (x +\<^sub>N y +\<^sub>N z)" "isnormNum (x +\<^sub>N (y +\<^sub>N z))" by simp_all - have "INum (x +\<^sub>N y +\<^sub>N z) = INum (x +\<^sub>N (y +\<^sub>N z))" by simp - with isnormNum_unique[OF n] show ?thesis by simp -qed - -lemma Nmul_commute: "isnormNum x \ isnormNum y \ x *\<^sub>N y = y *\<^sub>N x" - by (simp add: Nmul_def split_def Let_def igcd_commute mult_commute) +lemma real_sub_code [code]: "Real x - Real y = Real (x -\<^sub>N y)" + unfolding Real_def by simp -lemma Nmul_assoc: assumes nx: "isnormNum x" and ny:"isnormNum y" and nz:"isnormNum z" - shows "x *\<^sub>N y *\<^sub>N z = x *\<^sub>N (y *\<^sub>N z)" -proof- - from nx ny nz have n: "isnormNum (x *\<^sub>N y *\<^sub>N z)" "isnormNum (x *\<^sub>N (y *\<^sub>N z))" - by simp_all - have "INum (x +\<^sub>N y +\<^sub>N z) = INum (x +\<^sub>N (y +\<^sub>N z))" by simp - with isnormNum_unique[OF n] show ?thesis by simp -qed - -lemma Nsub0: assumes x: "isnormNum x" and y:"isnormNum y" shows "(x -\<^sub>N y = 0\<^sub>N) = (x = y)" -proof- - from isnormNum_unique[OF Nsub_normN[OF y], where y="0\<^sub>N"] - have "(x -\<^sub>N y = 0\<^sub>N) = (INum (x -\<^sub>N y) = INum 0\<^sub>N)" by simp - also have "\ = (INum x = INum y)" by simp - also have "\ = (x = y)" using x y by simp - finally show ?thesis . -qed -lemma Nmul0[simp]: "c *\<^sub>N 0\<^sub>N = 0\<^sub>N" " 0\<^sub>N *\<^sub>N c = 0\<^sub>N" - by (simp_all add: Nmul_def Let_def split_def) +lemma real_inv_code [code]: "inverse (Real x) = Real (Ninv x)" + unfolding Real_def Ninv real_divide_def by simp -lemma Nmul_eq0[simp]: assumes nx:"isnormNum x" and ny: "isnormNum y" - shows "(x*\<^sub>N y = 0\<^sub>N) = (x = 0\<^sub>N \ y = 0\<^sub>N)" -proof- - have " \ a b a' b'. x = (a,b) \ y= (a',b')" by auto - then obtain a b a' b' where xy[simp]: "x = (a,b)" "y = (a',b')" by blast - have n0: "isnormNum 0\<^sub>N" by simp - show ?thesis using nx ny - apply (simp only: isnormNum_unique[OF Nmul_normN[OF nx ny] n0, symmetric] Nmul) - apply (simp add: INum_def split_def isnormNum_def fst_conv snd_conv) - apply (cases "a=0",simp_all) - apply (cases "a'=0",simp_all) - done -qed -lemma Nneg_Nneg[simp]: "~\<^sub>N (~\<^sub>N c) = c" - by (simp add: Nneg_def split_def) - -lemma Nmul1[simp]: - "isnormNum c \ 1\<^sub>N *\<^sub>N c = c" - "isnormNum c \ c *\<^sub>N 1\<^sub>N = c" - apply (simp_all add: Nmul_def Let_def split_def isnormNum_def) - by (cases "fst c = 0", simp_all,cases c, simp_all)+ - -lemma [code, code unfold]: - "number_of k = real_int (number_of k)" - by (simp add: real_int_def) +lemma real_div_code [code]: "Real x / Real y = Real (x \
\<^sub>N y)" + unfolding Real_def by simp code_modulename SML RealDef Real @@ -480,19 +89,4 @@ RealDef Real Executable_Real Real -(* There is already an implementation in RealDef -types_code real ("{* int * int *}") -attach (term_of) {* -fun term_of_real (p, q) = - let - val rT = HOLogic.realT; -in if q = 1 - then HOLogic.mk_number rT p - else @{term "op / \ real \ real \ real"} $ - HOLogic.mk_number rT p $ HOLogic.mk_number rT q -end; -*} - -consts_code INum ("") -*) end diff -r f1dbfd7e3223 -r c9e3cb5e5681 src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Thu Aug 09 15:52:47 2007 +0200 +++ b/src/HOL/Library/Library.thy Thu Aug 09 15:52:49 2007 +0200 @@ -2,6 +2,7 @@ (*<*) theory Library imports + Abstract_Rat AssocList BigO Binomial diff -r f1dbfd7e3223 -r c9e3cb5e5681 src/HOL/ex/ExecutableContent.thy --- a/src/HOL/ex/ExecutableContent.thy Thu Aug 09 15:52:47 2007 +0200 +++ b/src/HOL/ex/ExecutableContent.thy Thu Aug 09 15:52:49 2007 +0200 @@ -1,4 +1,3 @@ - (* ID: $Id$ Author: Florian Haftmann, TU Muenchen *) @@ -14,6 +13,7 @@ Binomial Commutative_Ring "~~/src/HOL/ex/Commutative_Ring_Complete" + Executable_Rat Executable_Real GCD List_Prefix @@ -79,4 +79,44 @@ definition "shadow keywords = keywords @ [ExecutableContent.keywords 0 0 0 0 0 0]" +definition + foo :: "rat \ rat \ rat \ rat" where + "foo r s t = (t + s) / t" + +definition + bar :: "rat \ rat \ rat \ bool" where + "bar r s t \ (r - s) \ t \ (s - t) \ r" + +definition + "R1 = Fract 3 7" + +definition + "R2 = Fract (-7) 5" + +definition + "R3 = Fract 11 (-9)" + +definition + "foobar = (foo R1 1 R3, bar R2 0 R3, foo R1 R3 R2)" + +definition + foo' :: "real \ real \ real \ real" where + "foo' r s t = (t + s) / t" + +definition + bar' :: "real \ real \ real \ bool" where + "bar' r s t \ (r - s) \ t \ (s - t) \ r" + +definition + "R1' = real_of_rat (Fract 3 7)" + +definition + "R2' = real_of_rat (Fract (-7) 5)" + +definition + "R3' = real_of_rat (Fract 11 (-9))" + +definition + "foobar' = (foo' R1' 1 R3', bar' R2' 0 R3', foo' R1' R3' R2')" + end