src/HOL/Quotient_Examples/Quotient_Rat.thy
author huffman
Sun Mar 25 20:15:39 2012 +0200 (2012-03-25)
changeset 47108 2a1953f0d20d
parent 47092 fa3538d6004b
child 48047 2efdcc7d0775
permissions -rw-r--r--
merged fork with new numeral representation (see NEWS)
     1 (*  Title:      HOL/Quotient_Examples/Quotient_Rat.thy
     2     Author:     Cezary Kaliszyk
     3 
     4 Rational numbers defined with the quotient package, based on 'HOL/Rat.thy' by Makarius.
     5 *)
     6 
     7 theory Quotient_Rat imports Archimedean_Field
     8   "~~/src/HOL/Library/Quotient_Product"
     9 begin
    10 
    11 definition
    12   ratrel :: "(int \<times> int) \<Rightarrow> (int \<times> int) \<Rightarrow> bool" (infix "\<approx>" 50)
    13 where
    14   [simp]: "x \<approx> y \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
    15 
    16 lemma ratrel_equivp:
    17   "part_equivp ratrel"
    18 proof (auto intro!: part_equivpI reflpI sympI transpI exI[of _ "1 :: int"])
    19   fix a b c d e f :: int
    20   assume nz: "d \<noteq> 0" "b \<noteq> 0"
    21   assume y: "a * d = c * b"
    22   assume x: "c * f = e * d"
    23   then have "c * b * f = e * d * b" using nz by simp
    24   then have "a * d * f = e * d * b" using y by simp
    25   then show "a * f = e * b" using nz by simp
    26 qed
    27 
    28 quotient_type rat = "int \<times> int" / partial: ratrel
    29  using ratrel_equivp .
    30 
    31 instantiation rat :: "{zero, one, plus, uminus, minus, times, ord, abs_if, sgn_if}"
    32 begin
    33 
    34 quotient_definition
    35   "0 \<Colon> rat" is "(0\<Colon>int, 1\<Colon>int)" by simp
    36 
    37 quotient_definition
    38   "1 \<Colon> rat" is "(1\<Colon>int, 1\<Colon>int)" by simp
    39 
    40 fun times_rat_raw where
    41   "times_rat_raw (a :: int, b :: int) (c, d) = (a * c, b * d)"
    42 
    43 quotient_definition
    44   "(op *) :: (rat \<Rightarrow> rat \<Rightarrow> rat)" is times_rat_raw by (auto simp add: mult_assoc mult_left_commute)
    45 
    46 fun plus_rat_raw where
    47   "plus_rat_raw (a :: int, b :: int) (c, d) = (a * d + c * b, b * d)"
    48 
    49 quotient_definition
    50   "(op +) :: (rat \<Rightarrow> rat \<Rightarrow> rat)" is plus_rat_raw 
    51   by (auto simp add: mult_commute mult_left_commute int_distrib(2))
    52 
    53 fun uminus_rat_raw where
    54   "uminus_rat_raw (a :: int, b :: int) = (-a, b)"
    55 
    56 quotient_definition
    57   "(uminus \<Colon> (rat \<Rightarrow> rat))" is "uminus_rat_raw" by fastforce
    58 
    59 definition
    60   minus_rat_def: "a - b = a + (-b\<Colon>rat)"
    61 
    62 fun le_rat_raw where
    63   "le_rat_raw (a :: int, b) (c, d) \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)"
    64 
    65 quotient_definition
    66   "(op \<le>) :: rat \<Rightarrow> rat \<Rightarrow> bool" is "le_rat_raw"
    67 proof -
    68   {
    69     fix a b c d e f g h :: int
    70     assume "a * f * (b * f) \<le> e * b * (b * f)"
    71     then have le: "a * f * b * f \<le> e * b * b * f" by simp
    72     assume nz: "b \<noteq> 0" "d \<noteq> 0" "f \<noteq> 0" "h \<noteq> 0"
    73     then have b2: "b * b > 0"
    74       by (metis linorder_neqE_linordered_idom mult_eq_0_iff not_square_less_zero)
    75     have f2: "f * f > 0" using nz(3)
    76       by (metis linorder_neqE_linordered_idom mult_eq_0_iff not_square_less_zero)
    77     assume eq: "a * d = c * b" "e * h = g * f"
    78     have "a * f * b * f * d * d \<le> e * b * b * f * d * d" using le nz(2)
    79       by (metis linorder_le_cases mult_right_mono mult_right_mono_neg)
    80     then have "c * f * f * d * (b * b) \<le> e * f * d * d * (b * b)" using eq
    81       by (metis (no_types) mult_assoc mult_commute)
    82     then have "c * f * f * d \<le> e * f * d * d" using b2
    83       by (metis leD linorder_le_less_linear mult_strict_right_mono)
    84     then have "c * f * f * d * h * h \<le> e * f * d * d * h * h" using nz(4)
    85       by (metis linorder_le_cases mult_right_mono mult_right_mono_neg)
    86     then have "c * h * (d * h) * (f * f) \<le> g * d * (d * h) * (f * f)" using eq
    87       by (metis (no_types) mult_assoc mult_commute)
    88     then have "c * h * (d * h) \<le> g * d * (d * h)" using f2
    89       by (metis leD linorder_le_less_linear mult_strict_right_mono)
    90   }
    91   then show "\<And>x y xa ya. x \<approx> y \<Longrightarrow> xa \<approx> ya \<Longrightarrow> le_rat_raw x xa = le_rat_raw y ya" by auto
    92 qed
    93 
    94 definition
    95   less_rat_def: "(z\<Colon>rat) < w = (z \<le> w \<and> z \<noteq> w)"
    96 
    97 definition
    98   rabs_rat_def: "\<bar>i\<Colon>rat\<bar> = (if i < 0 then - i else i)"
    99 
   100 definition
   101   sgn_rat_def: "sgn (i\<Colon>rat) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
   102 
   103 instance by intro_classes
   104   (auto simp add: rabs_rat_def sgn_rat_def)
   105 
   106 end
   107 
   108 definition
   109   Fract_raw :: "int \<Rightarrow> int \<Rightarrow> (int \<times> int)"
   110 where [simp]: "Fract_raw a b = (if b = 0 then (0, 1) else (a, b))"
   111 
   112 quotient_definition "Fract :: int \<Rightarrow> int \<Rightarrow> rat" is
   113   Fract_raw by simp
   114 
   115 lemmas [simp] = Respects_def
   116 
   117 instantiation rat :: comm_ring_1
   118 begin
   119 
   120 instance proof
   121   fix a b c :: rat
   122   show "a * b * c = a * (b * c)"
   123     by partiality_descending auto
   124   show "a * b = b * a"
   125     by partiality_descending auto
   126   show "1 * a = a"
   127     by partiality_descending auto
   128   show "a + b + c = a + (b + c)"
   129     by partiality_descending (auto simp add: mult_commute right_distrib)
   130   show "a + b = b + a"
   131     by partiality_descending auto
   132   show "0 + a = a"
   133     by partiality_descending auto
   134   show "- a + a = 0"
   135     by partiality_descending auto
   136   show "a - b = a + - b"
   137     by (simp add: minus_rat_def)
   138   show "(a + b) * c = a * c + b * c"
   139     by partiality_descending (auto simp add: mult_commute right_distrib)
   140   show "(0 :: rat) \<noteq> (1 :: rat)"
   141     by partiality_descending auto
   142 qed
   143 
   144 end
   145 
   146 lemma add_one_Fract: "1 + Fract (int k) 1 = Fract (1 + int k) 1"
   147   by descending auto
   148 
   149 lemma of_nat_rat: "of_nat k = Fract (of_nat k) 1"
   150   apply (induct k)
   151   apply (simp add: zero_rat_def Fract_def)
   152   apply (simp add: add_one_Fract)
   153   done
   154 
   155 lemma of_int_rat: "of_int k = Fract k 1"
   156   apply (cases k rule: int_diff_cases)
   157   apply (auto simp add: of_nat_rat minus_rat_def)
   158   apply descending
   159   apply auto
   160   done
   161 
   162 instantiation rat :: field_inverse_zero begin
   163 
   164 fun rat_inverse_raw where
   165   "rat_inverse_raw (a :: int, b :: int) = (if a = 0 then (0, 1) else (b, a))"
   166 
   167 quotient_definition
   168   "inverse :: rat \<Rightarrow> rat" is rat_inverse_raw by (force simp add: mult_commute)
   169 
   170 definition
   171   divide_rat_def: "q / r = q * inverse (r::rat)"
   172 
   173 instance proof
   174   fix q :: rat
   175   assume "q \<noteq> 0"
   176   then show "inverse q * q = 1"
   177     by partiality_descending auto
   178 next
   179   fix q r :: rat
   180   show "q / r = q * inverse r" by (simp add: divide_rat_def)
   181 next
   182   show "inverse 0 = (0::rat)" by partiality_descending auto
   183 qed
   184 
   185 end
   186 
   187 instantiation rat :: linorder
   188 begin
   189 
   190 instance proof
   191   fix q r s :: rat
   192   {
   193     assume "q \<le> r" and "r \<le> s"
   194     then show "q \<le> s"
   195     proof (partiality_descending, auto simp add: mult_assoc[symmetric])
   196       fix a b c d e f :: int
   197       assume nz: "b \<noteq> 0" "d \<noteq> 0" "f \<noteq> 0"
   198       then have d2: "d * d > 0"
   199         by (metis linorder_neqE_linordered_idom mult_eq_0_iff not_square_less_zero)
   200       assume le: "a * d * b * d \<le> c * b * b * d" "c * f * d * f \<le> e * d * d * f"
   201       then have a: "a * d * b * d * f * f \<le> c * b * b * d * f * f" using nz(3)
   202         by (metis linorder_le_cases mult_right_mono mult_right_mono_neg)
   203       have "c * f * d * f * b * b \<le> e * d * d * f * b * b" using nz(1) le
   204         by (metis linorder_le_cases mult_right_mono mult_right_mono_neg)
   205       then have "a * f * b * f * (d * d) \<le> e * b * b * f * (d * d)" using a
   206         by (simp add: algebra_simps)
   207       then show "a * f * b * f \<le> e * b * b * f" using d2
   208         by (metis leD linorder_le_less_linear mult_strict_right_mono)
   209     qed
   210   next
   211     assume "q \<le> r" and "r \<le> q"
   212     then show "q = r"
   213       apply (partiality_descending, auto)
   214       apply (case_tac "b > 0", case_tac [!] "ba > 0")
   215       apply simp_all
   216       done
   217   next
   218     show "q \<le> q" by partiality_descending auto
   219     show "(q < r) = (q \<le> r \<and> \<not> r \<le> q)"
   220       unfolding less_rat_def
   221       by partiality_descending (auto simp add: le_less mult_commute)
   222     show "q \<le> r \<or> r \<le> q"
   223       by partiality_descending (auto simp add: mult_commute linorder_linear)
   224   }
   225 qed
   226 
   227 end
   228 
   229 instance rat :: archimedean_field
   230 proof
   231   fix q r s :: rat
   232   show "q \<le> r ==> s + q \<le> s + r"
   233   proof (partiality_descending, auto simp add: algebra_simps, simp add: mult_assoc[symmetric])
   234     fix a b c d e :: int
   235     assume "e \<noteq> 0"
   236     then have e2: "e * e > 0"
   237       by (metis linorder_neqE_linordered_idom mult_eq_0_iff not_square_less_zero)
   238       assume "a * b * d * d \<le> b * b * c * d"
   239       then show "a * b * d * d * e * e * e * e \<le> b * b * c * d * e * e * e * e"
   240         using e2 by (metis comm_mult_left_mono mult_commute linorder_le_cases
   241           mult_left_mono_neg)
   242     qed
   243   show "q < r ==> 0 < s ==> s * q < s * r" unfolding less_rat_def
   244     proof (partiality_descending, auto simp add: algebra_simps, simp add: mult_assoc[symmetric])
   245     fix a b c d e f :: int
   246     assume a: "e \<noteq> 0" "f \<noteq> 0" "0 \<le> e * f" "a * b * d * d \<le> b * b * c * d"
   247     have "a * b * d * d * (e * f) \<le> b * b * c * d * (e * f)" using a
   248       by (simp add: mult_right_mono)
   249     then show "a * b * d * d * e * f * f * f \<le> b * b * c * d * e * f * f * f"
   250       by (simp add: mult_assoc[symmetric]) (metis a(3) comm_mult_left_mono
   251         mult_commute mult_left_mono_neg zero_le_mult_iff)
   252   qed
   253   show "\<exists>z. r \<le> of_int z"
   254     unfolding of_int_rat
   255   proof (partiality_descending, auto)
   256     fix a b :: int
   257     assume "b \<noteq> 0"
   258     then have "a * b \<le> (a div b + 1) * b * b"
   259       by (metis mult_commute div_mult_self1_is_id less_int_def linorder_le_cases zdiv_mono1 zdiv_mono1_neg zle_add1_eq_le)
   260     then show "\<exists>z\<Colon>int. a * b \<le> z * b * b" by auto
   261   qed
   262 qed
   263 
   264 end