src/HOL/Real/PReal.thy
author haftmann
Tue Jun 10 15:30:56 2008 +0200 (2008-06-10)
changeset 27106 ff27dc6e7d05
parent 26806 40b411ec05aa
child 27682 25aceefd4786
permissions -rw-r--r--
removed some dubious code lemmas
paulson@7219
     1
(*  Title       : PReal.thy
paulson@7219
     2
    ID          : $Id$
paulson@5078
     3
    Author      : Jacques D. Fleuriot
paulson@5078
     4
    Copyright   : 1998  University of Cambridge
paulson@5078
     5
    Description : The positive reals as Dedekind sections of positive
paulson@14335
     6
         rationals. Fundamentals of Abstract Analysis [Gleason- p. 121]
paulson@5078
     7
                  provides some of the definitions.
paulson@5078
     8
*)
paulson@5078
     9
huffman@17428
    10
header {* Positive real numbers *}
huffman@17428
    11
nipkow@15131
    12
theory PReal
nipkow@15140
    13
imports Rational
nipkow@15131
    14
begin
paulson@14365
    15
paulson@14365
    16
text{*Could be generalized and moved to @{text Ring_and_Field}*}
paulson@14365
    17
lemma add_eq_exists: "\<exists>x. a+x = (b::rat)"
paulson@14365
    18
by (rule_tac x="b-a" in exI, simp)
paulson@5078
    19
wenzelm@19765
    20
definition
wenzelm@21404
    21
  cut :: "rat set => bool" where
haftmann@27106
    22
  [code func del]: "cut A = ({} \<subset> A &
wenzelm@19765
    23
            A < {r. 0 < r} &
wenzelm@19765
    24
            (\<forall>y \<in> A. ((\<forall>z. 0<z & z < y --> z \<in> A) & (\<exists>u \<in> A. y < u))))"
paulson@14365
    25
paulson@14365
    26
lemma cut_of_rat: 
huffman@20495
    27
  assumes q: "0 < q" shows "cut {r::rat. 0 < r & r < q}" (is "cut ?A")
paulson@14365
    28
proof -
paulson@14365
    29
  from q have pos: "?A < {r. 0 < r}" by force
paulson@14365
    30
  have nonempty: "{} \<subset> ?A"
paulson@14365
    31
  proof
paulson@14365
    32
    show "{} \<subseteq> ?A" by simp
paulson@14365
    33
    show "{} \<noteq> ?A"
paulson@14365
    34
      by (force simp only: q eq_commute [of "{}"] interval_empty_iff)
paulson@14365
    35
  qed
paulson@14365
    36
  show ?thesis
paulson@14365
    37
    by (simp add: cut_def pos nonempty,
paulson@14365
    38
        blast dest: dense intro: order_less_trans)
paulson@14365
    39
qed
paulson@14365
    40
paulson@14365
    41
paulson@14365
    42
typedef preal = "{A. cut A}"
paulson@14365
    43
  by (blast intro: cut_of_rat [OF zero_less_one])
paulson@14365
    44
wenzelm@19765
    45
definition
wenzelm@21404
    46
  preal_of_rat :: "rat => preal" where
huffman@20495
    47
  "preal_of_rat q = Abs_preal {x::rat. 0 < x & x < q}"
paulson@5078
    48
wenzelm@21404
    49
definition
wenzelm@21404
    50
  psup :: "preal set => preal" where
huffman@20495
    51
  "psup P = Abs_preal (\<Union>X \<in> P. Rep_preal X)"
paulson@14365
    52
wenzelm@21404
    53
definition
wenzelm@21404
    54
  add_set :: "[rat set,rat set] => rat set" where
wenzelm@19765
    55
  "add_set A B = {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x + y}"
paulson@14365
    56
wenzelm@21404
    57
definition
wenzelm@21404
    58
  diff_set :: "[rat set,rat set] => rat set" where
haftmann@27106
    59
  [code func del]: "diff_set A B = {w. \<exists>x. 0 < w & 0 < x & x \<notin> B & x + w \<in> A}"
paulson@14365
    60
wenzelm@21404
    61
definition
wenzelm@21404
    62
  mult_set :: "[rat set,rat set] => rat set" where
wenzelm@19765
    63
  "mult_set A B = {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x * y}"
paulson@14365
    64
wenzelm@21404
    65
definition
wenzelm@21404
    66
  inverse_set :: "rat set => rat set" where
haftmann@27106
    67
  [code func del]: "inverse_set A = {x. \<exists>y. 0 < x & x < y & inverse y \<notin> A}"
paulson@14365
    68
haftmann@26511
    69
instantiation preal :: "{ord, plus, minus, times, inverse, one}"
haftmann@26511
    70
begin
paulson@5078
    71
haftmann@26511
    72
definition
haftmann@27106
    73
  preal_less_def [code func del]:
huffman@20495
    74
    "R < S == Rep_preal R < Rep_preal S"
paulson@14365
    75
haftmann@26511
    76
definition
haftmann@27106
    77
  preal_le_def [code func del]:
huffman@20495
    78
    "R \<le> S == Rep_preal R \<subseteq> Rep_preal S"
paulson@14365
    79
haftmann@26511
    80
definition
paulson@14335
    81
  preal_add_def:
paulson@14365
    82
    "R + S == Abs_preal (add_set (Rep_preal R) (Rep_preal S))"
paulson@14365
    83
haftmann@26511
    84
definition
paulson@14365
    85
  preal_diff_def:
paulson@14365
    86
    "R - S == Abs_preal (diff_set (Rep_preal R) (Rep_preal S))"
paulson@5078
    87
haftmann@26511
    88
definition
paulson@14335
    89
  preal_mult_def:
huffman@20495
    90
    "R * S == Abs_preal (mult_set (Rep_preal R) (Rep_preal S))"
paulson@5078
    91
haftmann@26511
    92
definition
paulson@14365
    93
  preal_inverse_def:
huffman@20495
    94
    "inverse R == Abs_preal (inverse_set (Rep_preal R))"
paulson@14335
    95
haftmann@26564
    96
definition "R / S = R * inverse (S\<Colon>preal)"
haftmann@26564
    97
haftmann@26511
    98
definition
huffman@23287
    99
  preal_one_def:
huffman@23287
   100
    "1 == preal_of_rat 1"
huffman@23287
   101
haftmann@26511
   102
instance ..
haftmann@26511
   103
haftmann@26511
   104
end
haftmann@26511
   105
paulson@14335
   106
paulson@15413
   107
text{*Reduces equality on abstractions to equality on representatives*}
paulson@15413
   108
declare Abs_preal_inject [simp]
huffman@20495
   109
declare Abs_preal_inverse [simp]
huffman@20495
   110
huffman@20495
   111
lemma rat_mem_preal: "0 < q ==> {r::rat. 0 < r & r < q} \<in> preal"
huffman@20495
   112
by (simp add: preal_def cut_of_rat)
paulson@14335
   113
paulson@14365
   114
lemma preal_nonempty: "A \<in> preal ==> \<exists>x\<in>A. 0 < x"
paulson@14365
   115
by (unfold preal_def cut_def, blast)
paulson@14335
   116
huffman@20495
   117
lemma preal_Ex_mem: "A \<in> preal \<Longrightarrow> \<exists>x. x \<in> A"
huffman@20495
   118
by (drule preal_nonempty, fast)
huffman@20495
   119
paulson@14365
   120
lemma preal_imp_psubset_positives: "A \<in> preal ==> A < {r. 0 < r}"
paulson@14365
   121
by (force simp add: preal_def cut_def)
paulson@14335
   122
paulson@14365
   123
lemma preal_exists_bound: "A \<in> preal ==> \<exists>x. 0 < x & x \<notin> A"
paulson@14365
   124
by (drule preal_imp_psubset_positives, auto)
paulson@14335
   125
paulson@14365
   126
lemma preal_exists_greater: "[| A \<in> preal; y \<in> A |] ==> \<exists>u \<in> A. y < u"
paulson@14365
   127
by (unfold preal_def cut_def, blast)
paulson@14335
   128
paulson@14365
   129
lemma preal_downwards_closed: "[| A \<in> preal; y \<in> A; 0 < z; z < y |] ==> z \<in> A"
paulson@14365
   130
by (unfold preal_def cut_def, blast)
paulson@14335
   131
paulson@14365
   132
text{*Relaxing the final premise*}
paulson@14365
   133
lemma preal_downwards_closed':
paulson@14365
   134
     "[| A \<in> preal; y \<in> A; 0 < z; z \<le> y |] ==> z \<in> A"
paulson@14365
   135
apply (simp add: order_le_less)
paulson@14365
   136
apply (blast intro: preal_downwards_closed)
paulson@14365
   137
done
paulson@14335
   138
paulson@14335
   139
text{*A positive fraction not in a positive real is an upper bound.
paulson@14335
   140
 Gleason p. 122 - Remark (1)*}
paulson@14335
   141
paulson@14365
   142
lemma not_in_preal_ub:
wenzelm@19765
   143
  assumes A: "A \<in> preal"
wenzelm@19765
   144
    and notx: "x \<notin> A"
wenzelm@19765
   145
    and y: "y \<in> A"
wenzelm@19765
   146
    and pos: "0 < x"
wenzelm@19765
   147
  shows "y < x"
paulson@14365
   148
proof (cases rule: linorder_cases)
paulson@14365
   149
  assume "x<y"
paulson@14365
   150
  with notx show ?thesis
paulson@14365
   151
    by (simp add:  preal_downwards_closed [OF A y] pos)
paulson@14365
   152
next
paulson@14365
   153
  assume "x=y"
paulson@14365
   154
  with notx and y show ?thesis by simp
paulson@14365
   155
next
paulson@14365
   156
  assume "y<x"
huffman@20495
   157
  thus ?thesis .
paulson@14365
   158
qed
paulson@14365
   159
huffman@20495
   160
text {* preal lemmas instantiated to @{term "Rep_preal X"} *}
huffman@20495
   161
huffman@20495
   162
lemma mem_Rep_preal_Ex: "\<exists>x. x \<in> Rep_preal X"
huffman@20495
   163
by (rule preal_Ex_mem [OF Rep_preal])
huffman@20495
   164
huffman@20495
   165
lemma Rep_preal_exists_bound: "\<exists>x>0. x \<notin> Rep_preal X"
huffman@20495
   166
by (rule preal_exists_bound [OF Rep_preal])
huffman@20495
   167
paulson@14365
   168
lemmas not_in_Rep_preal_ub = not_in_preal_ub [OF Rep_preal]
paulson@14335
   169
paulson@14335
   170
huffman@20495
   171
huffman@20495
   172
subsection{*@{term preal_of_prat}: the Injection from prat to preal*}
huffman@20495
   173
huffman@20495
   174
lemma rat_less_set_mem_preal: "0 < y ==> {u::rat. 0 < u & u < y} \<in> preal"
huffman@20495
   175
by (simp add: preal_def cut_of_rat)
huffman@20495
   176
huffman@20495
   177
lemma rat_subset_imp_le:
huffman@20495
   178
     "[|{u::rat. 0 < u & u < x} \<subseteq> {u. 0 < u & u < y}; 0<x|] ==> x \<le> y"
huffman@20495
   179
apply (simp add: linorder_not_less [symmetric])
huffman@20495
   180
apply (blast dest: dense intro: order_less_trans)
huffman@20495
   181
done
huffman@20495
   182
huffman@20495
   183
lemma rat_set_eq_imp_eq:
huffman@20495
   184
     "[|{u::rat. 0 < u & u < x} = {u. 0 < u & u < y};
huffman@20495
   185
        0 < x; 0 < y|] ==> x = y"
huffman@20495
   186
by (blast intro: rat_subset_imp_le order_antisym)
huffman@20495
   187
huffman@20495
   188
huffman@20495
   189
huffman@20495
   190
subsection{*Properties of Ordering*}
paulson@14365
   191
paulson@14365
   192
lemma preal_le_refl: "w \<le> (w::preal)"
paulson@14365
   193
by (simp add: preal_le_def)
paulson@14335
   194
paulson@14365
   195
lemma preal_le_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::preal)"
paulson@14365
   196
by (force simp add: preal_le_def)
paulson@14365
   197
paulson@14365
   198
lemma preal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::preal)"
paulson@14365
   199
apply (simp add: preal_le_def)
paulson@14365
   200
apply (rule Rep_preal_inject [THEN iffD1], blast)
paulson@14335
   201
done
paulson@14335
   202
paulson@14365
   203
(* Axiom 'order_less_le' of class 'order': *)
paulson@14365
   204
lemma preal_less_le: "((w::preal) < z) = (w \<le> z & w \<noteq> z)"
berghofe@26806
   205
by (simp add: preal_le_def preal_less_def Rep_preal_inject less_le)
paulson@14365
   206
paulson@14365
   207
instance preal :: order
wenzelm@14691
   208
  by intro_classes
wenzelm@14691
   209
    (assumption |
wenzelm@14691
   210
      rule preal_le_refl preal_le_trans preal_le_anti_sym preal_less_le)+
paulson@14335
   211
paulson@14365
   212
lemma preal_imp_pos: "[|A \<in> preal; r \<in> A|] ==> 0 < r"
paulson@14365
   213
by (insert preal_imp_psubset_positives, blast)
paulson@14335
   214
paulson@14365
   215
lemma preal_le_linear: "x <= y | y <= (x::preal)"
paulson@14365
   216
apply (auto simp add: preal_le_def)
paulson@14365
   217
apply (rule ccontr)
paulson@14365
   218
apply (blast dest: not_in_Rep_preal_ub intro: preal_imp_pos [OF Rep_preal]
paulson@14365
   219
             elim: order_less_asym)
paulson@14335
   220
done
paulson@14335
   221
paulson@14365
   222
instance preal :: linorder
wenzelm@14691
   223
  by intro_classes (rule preal_le_linear)
paulson@14335
   224
haftmann@25571
   225
instantiation preal :: distrib_lattice
haftmann@25571
   226
begin
haftmann@25571
   227
haftmann@25571
   228
definition
haftmann@25571
   229
  "(inf \<Colon> preal \<Rightarrow> preal \<Rightarrow> preal) = min"
haftmann@25571
   230
haftmann@25571
   231
definition
haftmann@25571
   232
  "(sup \<Colon> preal \<Rightarrow> preal \<Rightarrow> preal) = max"
haftmann@25571
   233
haftmann@25571
   234
instance
haftmann@22483
   235
  by intro_classes
haftmann@22483
   236
    (auto simp add: inf_preal_def sup_preal_def min_max.sup_inf_distrib1)
paulson@14335
   237
haftmann@25571
   238
end
paulson@14335
   239
paulson@14335
   240
subsection{*Properties of Addition*}
paulson@14335
   241
paulson@14335
   242
lemma preal_add_commute: "(x::preal) + y = y + x"
paulson@14365
   243
apply (unfold preal_add_def add_set_def)
paulson@14335
   244
apply (rule_tac f = Abs_preal in arg_cong)
paulson@14365
   245
apply (force simp add: add_commute)
paulson@14335
   246
done
paulson@14335
   247
paulson@14365
   248
text{*Lemmas for proving that addition of two positive reals gives
paulson@14365
   249
 a positive real*}
paulson@14365
   250
paulson@14365
   251
lemma empty_psubset_nonempty: "a \<in> A ==> {} \<subset> A"
paulson@14365
   252
by blast
paulson@14365
   253
paulson@14365
   254
text{*Part 1 of Dedekind sections definition*}
paulson@14365
   255
lemma add_set_not_empty:
paulson@14365
   256
     "[|A \<in> preal; B \<in> preal|] ==> {} \<subset> add_set A B"
huffman@20495
   257
apply (drule preal_nonempty)+
paulson@14365
   258
apply (auto simp add: add_set_def)
paulson@14335
   259
done
paulson@14335
   260
paulson@14365
   261
text{*Part 2 of Dedekind sections definition.  A structured version of
paulson@14365
   262
this proof is @{text preal_not_mem_mult_set_Ex} below.*}
paulson@14365
   263
lemma preal_not_mem_add_set_Ex:
huffman@20495
   264
     "[|A \<in> preal; B \<in> preal|] ==> \<exists>q>0. q \<notin> add_set A B"
paulson@14365
   265
apply (insert preal_exists_bound [of A] preal_exists_bound [of B], auto) 
paulson@14365
   266
apply (rule_tac x = "x+xa" in exI)
paulson@14365
   267
apply (simp add: add_set_def, clarify)
huffman@20495
   268
apply (drule (3) not_in_preal_ub)+
paulson@14365
   269
apply (force dest: add_strict_mono)
paulson@14335
   270
done
paulson@14335
   271
paulson@14365
   272
lemma add_set_not_rat_set:
paulson@14365
   273
   assumes A: "A \<in> preal" 
paulson@14365
   274
       and B: "B \<in> preal"
paulson@14365
   275
     shows "add_set A B < {r. 0 < r}"
paulson@14365
   276
proof
paulson@14365
   277
  from preal_imp_pos [OF A] preal_imp_pos [OF B]
paulson@14365
   278
  show "add_set A B \<subseteq> {r. 0 < r}" by (force simp add: add_set_def) 
paulson@14365
   279
next
paulson@14365
   280
  show "add_set A B \<noteq> {r. 0 < r}"
paulson@14365
   281
    by (insert preal_not_mem_add_set_Ex [OF A B], blast) 
paulson@14365
   282
qed
paulson@14365
   283
paulson@14335
   284
text{*Part 3 of Dedekind sections definition*}
paulson@14365
   285
lemma add_set_lemma3:
paulson@14365
   286
     "[|A \<in> preal; B \<in> preal; u \<in> add_set A B; 0 < z; z < u|] 
paulson@14365
   287
      ==> z \<in> add_set A B"
paulson@14365
   288
proof (unfold add_set_def, clarify)
paulson@14365
   289
  fix x::rat and y::rat
paulson@14365
   290
  assume A: "A \<in> preal" 
wenzelm@19765
   291
    and B: "B \<in> preal"
wenzelm@19765
   292
    and [simp]: "0 < z"
wenzelm@19765
   293
    and zless: "z < x + y"
wenzelm@19765
   294
    and x:  "x \<in> A"
wenzelm@19765
   295
    and y:  "y \<in> B"
paulson@14365
   296
  have xpos [simp]: "0<x" by (rule preal_imp_pos [OF A x])
paulson@14365
   297
  have ypos [simp]: "0<y" by (rule preal_imp_pos [OF B y])
paulson@14365
   298
  have xypos [simp]: "0 < x+y" by (simp add: pos_add_strict)
paulson@14365
   299
  let ?f = "z/(x+y)"
paulson@14365
   300
  have fless: "?f < 1" by (simp add: zless pos_divide_less_eq)
paulson@14365
   301
  show "\<exists>x' \<in> A. \<exists>y'\<in>B. z = x' + y'"
huffman@20495
   302
  proof (intro bexI)
huffman@20495
   303
    show "z = x*?f + y*?f"
huffman@20495
   304
      by (simp add: left_distrib [symmetric] divide_inverse mult_ac
huffman@20495
   305
          order_less_imp_not_eq2)
huffman@20495
   306
  next
huffman@20495
   307
    show "y * ?f \<in> B"
huffman@20495
   308
    proof (rule preal_downwards_closed [OF B y])
huffman@20495
   309
      show "0 < y * ?f"
huffman@20495
   310
        by (simp add: divide_inverse zero_less_mult_iff)
paulson@14365
   311
    next
huffman@20495
   312
      show "y * ?f < y"
huffman@20495
   313
        by (insert mult_strict_left_mono [OF fless ypos], simp)
paulson@14365
   314
    qed
paulson@14365
   315
  next
paulson@14365
   316
    show "x * ?f \<in> A"
paulson@14365
   317
    proof (rule preal_downwards_closed [OF A x])
paulson@14365
   318
      show "0 < x * ?f"
paulson@14430
   319
	by (simp add: divide_inverse zero_less_mult_iff)
paulson@14365
   320
    next
paulson@14365
   321
      show "x * ?f < x"
paulson@14365
   322
	by (insert mult_strict_left_mono [OF fless xpos], simp)
paulson@14365
   323
    qed
paulson@14365
   324
  qed
paulson@14365
   325
qed
paulson@14365
   326
paulson@14365
   327
text{*Part 4 of Dedekind sections definition*}
paulson@14365
   328
lemma add_set_lemma4:
paulson@14365
   329
     "[|A \<in> preal; B \<in> preal; y \<in> add_set A B|] ==> \<exists>u \<in> add_set A B. y < u"
paulson@14365
   330
apply (auto simp add: add_set_def)
paulson@14365
   331
apply (frule preal_exists_greater [of A], auto) 
paulson@14365
   332
apply (rule_tac x="u + y" in exI)
paulson@14365
   333
apply (auto intro: add_strict_left_mono)
paulson@14335
   334
done
paulson@14335
   335
paulson@14365
   336
lemma mem_add_set:
paulson@14365
   337
     "[|A \<in> preal; B \<in> preal|] ==> add_set A B \<in> preal"
paulson@14365
   338
apply (simp (no_asm_simp) add: preal_def cut_def)
paulson@14365
   339
apply (blast intro!: add_set_not_empty add_set_not_rat_set
paulson@14365
   340
                     add_set_lemma3 add_set_lemma4)
paulson@14335
   341
done
paulson@14335
   342
paulson@14335
   343
lemma preal_add_assoc: "((x::preal) + y) + z = x + (y + z)"
paulson@14365
   344
apply (simp add: preal_add_def mem_add_set Rep_preal)
paulson@14365
   345
apply (force simp add: add_set_def add_ac)
paulson@14335
   346
done
paulson@14335
   347
huffman@23287
   348
instance preal :: ab_semigroup_add
huffman@23287
   349
proof
huffman@23287
   350
  fix a b c :: preal
huffman@23287
   351
  show "(a + b) + c = a + (b + c)" by (rule preal_add_assoc)
huffman@23287
   352
  show "a + b = b + a" by (rule preal_add_commute)
huffman@23287
   353
qed
huffman@23287
   354
paulson@14335
   355
lemma preal_add_left_commute: "x + (y + z) = y + ((x + z)::preal)"
huffman@23287
   356
by (rule add_left_commute)
paulson@14335
   357
paulson@14365
   358
text{* Positive Real addition is an AC operator *}
paulson@14335
   359
lemmas preal_add_ac = preal_add_assoc preal_add_commute preal_add_left_commute
paulson@14335
   360
paulson@14335
   361
paulson@14335
   362
subsection{*Properties of Multiplication*}
paulson@14335
   363
paulson@14335
   364
text{*Proofs essentially same as for addition*}
paulson@14335
   365
paulson@14335
   366
lemma preal_mult_commute: "(x::preal) * y = y * x"
paulson@14365
   367
apply (unfold preal_mult_def mult_set_def)
paulson@14335
   368
apply (rule_tac f = Abs_preal in arg_cong)
paulson@14365
   369
apply (force simp add: mult_commute)
paulson@14335
   370
done
paulson@14335
   371
nipkow@15055
   372
text{*Multiplication of two positive reals gives a positive real.*}
paulson@14335
   373
paulson@14335
   374
text{*Lemmas for proving positive reals multiplication set in @{typ preal}*}
paulson@14335
   375
paulson@14335
   376
text{*Part 1 of Dedekind sections definition*}
paulson@14365
   377
lemma mult_set_not_empty:
paulson@14365
   378
     "[|A \<in> preal; B \<in> preal|] ==> {} \<subset> mult_set A B"
paulson@14365
   379
apply (insert preal_nonempty [of A] preal_nonempty [of B]) 
paulson@14365
   380
apply (auto simp add: mult_set_def)
paulson@14335
   381
done
paulson@14335
   382
paulson@14335
   383
text{*Part 2 of Dedekind sections definition*}
paulson@14335
   384
lemma preal_not_mem_mult_set_Ex:
paulson@14365
   385
   assumes A: "A \<in> preal" 
paulson@14365
   386
       and B: "B \<in> preal"
paulson@14365
   387
     shows "\<exists>q. 0 < q & q \<notin> mult_set A B"
paulson@14365
   388
proof -
paulson@14365
   389
  from preal_exists_bound [OF A]
paulson@14365
   390
  obtain x where [simp]: "0 < x" "x \<notin> A" by blast
paulson@14365
   391
  from preal_exists_bound [OF B]
paulson@14365
   392
  obtain y where [simp]: "0 < y" "y \<notin> B" by blast
paulson@14365
   393
  show ?thesis
paulson@14365
   394
  proof (intro exI conjI)
avigad@16775
   395
    show "0 < x*y" by (simp add: mult_pos_pos)
paulson@14365
   396
    show "x * y \<notin> mult_set A B"
paulson@14377
   397
    proof -
paulson@14377
   398
      { fix u::rat and v::rat
kleing@14550
   399
	      assume "u \<in> A" and "v \<in> B" and "x*y = u*v"
kleing@14550
   400
	      moreover
kleing@14550
   401
	      with prems have "u<x" and "v<y" by (blast dest: not_in_preal_ub)+
kleing@14550
   402
	      moreover
kleing@14550
   403
	      with prems have "0\<le>v"
kleing@14550
   404
	        by (blast intro: preal_imp_pos [OF B]  order_less_imp_le prems)
kleing@14550
   405
	      moreover
kleing@14550
   406
        from calculation
kleing@14550
   407
	      have "u*v < x*y" by (blast intro: mult_strict_mono prems)
kleing@14550
   408
	      ultimately have False by force }
paulson@14377
   409
      thus ?thesis by (auto simp add: mult_set_def)
paulson@14365
   410
    qed
paulson@14365
   411
  qed
paulson@14365
   412
qed
paulson@14335
   413
paulson@14365
   414
lemma mult_set_not_rat_set:
wenzelm@19765
   415
  assumes A: "A \<in> preal" 
wenzelm@19765
   416
    and B: "B \<in> preal"
wenzelm@19765
   417
  shows "mult_set A B < {r. 0 < r}"
paulson@14365
   418
proof
paulson@14365
   419
  show "mult_set A B \<subseteq> {r. 0 < r}"
paulson@14365
   420
    by (force simp add: mult_set_def
wenzelm@19765
   421
      intro: preal_imp_pos [OF A] preal_imp_pos [OF B] mult_pos_pos)
paulson@14365
   422
  show "mult_set A B \<noteq> {r. 0 < r}"
wenzelm@19765
   423
    using preal_not_mem_mult_set_Ex [OF A B] by blast
paulson@14365
   424
qed
paulson@14365
   425
paulson@14365
   426
paulson@14335
   427
paulson@14335
   428
text{*Part 3 of Dedekind sections definition*}
paulson@14365
   429
lemma mult_set_lemma3:
paulson@14365
   430
     "[|A \<in> preal; B \<in> preal; u \<in> mult_set A B; 0 < z; z < u|] 
paulson@14365
   431
      ==> z \<in> mult_set A B"
paulson@14365
   432
proof (unfold mult_set_def, clarify)
paulson@14365
   433
  fix x::rat and y::rat
paulson@14365
   434
  assume A: "A \<in> preal" 
wenzelm@19765
   435
    and B: "B \<in> preal"
wenzelm@19765
   436
    and [simp]: "0 < z"
wenzelm@19765
   437
    and zless: "z < x * y"
wenzelm@19765
   438
    and x:  "x \<in> A"
wenzelm@19765
   439
    and y:  "y \<in> B"
paulson@14365
   440
  have [simp]: "0<y" by (rule preal_imp_pos [OF B y])
paulson@14365
   441
  show "\<exists>x' \<in> A. \<exists>y' \<in> B. z = x' * y'"
paulson@14365
   442
  proof
paulson@14365
   443
    show "\<exists>y'\<in>B. z = (z/y) * y'"
paulson@14365
   444
    proof
paulson@14365
   445
      show "z = (z/y)*y"
paulson@14430
   446
	by (simp add: divide_inverse mult_commute [of y] mult_assoc
paulson@14365
   447
		      order_less_imp_not_eq2)
wenzelm@23389
   448
      show "y \<in> B" by fact
paulson@14365
   449
    qed
paulson@14365
   450
  next
paulson@14365
   451
    show "z/y \<in> A"
paulson@14365
   452
    proof (rule preal_downwards_closed [OF A x])
paulson@14365
   453
      show "0 < z/y"
paulson@14365
   454
	by (simp add: zero_less_divide_iff)
paulson@14365
   455
      show "z/y < x" by (simp add: pos_divide_less_eq zless)
paulson@14365
   456
    qed
paulson@14365
   457
  qed
paulson@14365
   458
qed
paulson@14365
   459
paulson@14365
   460
text{*Part 4 of Dedekind sections definition*}
paulson@14365
   461
lemma mult_set_lemma4:
paulson@14365
   462
     "[|A \<in> preal; B \<in> preal; y \<in> mult_set A B|] ==> \<exists>u \<in> mult_set A B. y < u"
paulson@14365
   463
apply (auto simp add: mult_set_def)
paulson@14365
   464
apply (frule preal_exists_greater [of A], auto) 
paulson@14365
   465
apply (rule_tac x="u * y" in exI)
paulson@14365
   466
apply (auto intro: preal_imp_pos [of A] preal_imp_pos [of B] 
paulson@14365
   467
                   mult_strict_right_mono)
paulson@14335
   468
done
paulson@14335
   469
paulson@14335
   470
paulson@14365
   471
lemma mem_mult_set:
paulson@14365
   472
     "[|A \<in> preal; B \<in> preal|] ==> mult_set A B \<in> preal"
paulson@14365
   473
apply (simp (no_asm_simp) add: preal_def cut_def)
paulson@14365
   474
apply (blast intro!: mult_set_not_empty mult_set_not_rat_set
paulson@14365
   475
                     mult_set_lemma3 mult_set_lemma4)
paulson@14335
   476
done
paulson@14335
   477
paulson@14335
   478
lemma preal_mult_assoc: "((x::preal) * y) * z = x * (y * z)"
paulson@14365
   479
apply (simp add: preal_mult_def mem_mult_set Rep_preal)
paulson@14365
   480
apply (force simp add: mult_set_def mult_ac)
paulson@14335
   481
done
paulson@14335
   482
huffman@23287
   483
instance preal :: ab_semigroup_mult
huffman@23287
   484
proof
huffman@23287
   485
  fix a b c :: preal
huffman@23287
   486
  show "(a * b) * c = a * (b * c)" by (rule preal_mult_assoc)
huffman@23287
   487
  show "a * b = b * a" by (rule preal_mult_commute)
huffman@23287
   488
qed
huffman@23287
   489
paulson@14335
   490
lemma preal_mult_left_commute: "x * (y * z) = y * ((x * z)::preal)"
huffman@23287
   491
by (rule mult_left_commute)
paulson@14335
   492
paulson@14365
   493
paulson@14365
   494
text{* Positive Real multiplication is an AC operator *}
paulson@14335
   495
lemmas preal_mult_ac =
paulson@14335
   496
       preal_mult_assoc preal_mult_commute preal_mult_left_commute
paulson@14335
   497
paulson@14365
   498
paulson@14365
   499
text{* Positive real 1 is the multiplicative identity element *}
paulson@14365
   500
huffman@23287
   501
lemma preal_mult_1: "(1::preal) * z = z"
huffman@23287
   502
unfolding preal_one_def
paulson@14365
   503
proof (induct z)
paulson@14365
   504
  fix A :: "rat set"
paulson@14365
   505
  assume A: "A \<in> preal"
paulson@14365
   506
  have "{w. \<exists>u. 0 < u \<and> u < 1 & (\<exists>v \<in> A. w = u * v)} = A" (is "?lhs = A")
paulson@14365
   507
  proof
paulson@14365
   508
    show "?lhs \<subseteq> A"
paulson@14365
   509
    proof clarify
paulson@14365
   510
      fix x::rat and u::rat and v::rat
paulson@14365
   511
      assume upos: "0<u" and "u<1" and v: "v \<in> A"
paulson@14365
   512
      have vpos: "0<v" by (rule preal_imp_pos [OF A v])
paulson@14365
   513
      hence "u*v < 1*v" by (simp only: mult_strict_right_mono prems)
paulson@14365
   514
      thus "u * v \<in> A"
avigad@16775
   515
        by (force intro: preal_downwards_closed [OF A v] mult_pos_pos 
avigad@16775
   516
          upos vpos)
paulson@14365
   517
    qed
paulson@14365
   518
  next
paulson@14365
   519
    show "A \<subseteq> ?lhs"
paulson@14365
   520
    proof clarify
paulson@14365
   521
      fix x::rat
paulson@14365
   522
      assume x: "x \<in> A"
paulson@14365
   523
      have xpos: "0<x" by (rule preal_imp_pos [OF A x])
paulson@14365
   524
      from preal_exists_greater [OF A x]
paulson@14365
   525
      obtain v where v: "v \<in> A" and xlessv: "x < v" ..
paulson@14365
   526
      have vpos: "0<v" by (rule preal_imp_pos [OF A v])
paulson@14365
   527
      show "\<exists>u. 0 < u \<and> u < 1 \<and> (\<exists>v\<in>A. x = u * v)"
paulson@14365
   528
      proof (intro exI conjI)
paulson@14365
   529
        show "0 < x/v"
paulson@14365
   530
          by (simp add: zero_less_divide_iff xpos vpos)
paulson@14365
   531
	show "x / v < 1"
paulson@14365
   532
          by (simp add: pos_divide_less_eq vpos xlessv)
paulson@14365
   533
        show "\<exists>v'\<in>A. x = (x / v) * v'"
paulson@14365
   534
        proof
paulson@14365
   535
          show "x = (x/v)*v"
paulson@14430
   536
	    by (simp add: divide_inverse mult_assoc vpos
paulson@14365
   537
                          order_less_imp_not_eq2)
wenzelm@23389
   538
          show "v \<in> A" by fact
paulson@14365
   539
        qed
paulson@14365
   540
      qed
paulson@14365
   541
    qed
paulson@14365
   542
  qed
paulson@14365
   543
  thus "preal_of_rat 1 * Abs_preal A = Abs_preal A"
paulson@14365
   544
    by (simp add: preal_of_rat_def preal_mult_def mult_set_def 
paulson@14365
   545
                  rat_mem_preal A)
paulson@14365
   546
qed
paulson@14365
   547
huffman@23287
   548
instance preal :: comm_monoid_mult
huffman@23287
   549
by intro_classes (rule preal_mult_1)
paulson@14365
   550
huffman@23287
   551
lemma preal_mult_1_right: "z * (1::preal) = z"
huffman@23287
   552
by (rule mult_1_right)
paulson@14335
   553
paulson@14335
   554
paulson@14335
   555
subsection{*Distribution of Multiplication across Addition*}
paulson@14335
   556
paulson@14335
   557
lemma mem_Rep_preal_add_iff:
paulson@14365
   558
      "(z \<in> Rep_preal(R+S)) = (\<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. z = x + y)"
paulson@14365
   559
apply (simp add: preal_add_def mem_add_set Rep_preal)
paulson@14365
   560
apply (simp add: add_set_def) 
paulson@14335
   561
done
paulson@14335
   562
paulson@14335
   563
lemma mem_Rep_preal_mult_iff:
paulson@14365
   564
      "(z \<in> Rep_preal(R*S)) = (\<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. z = x * y)"
paulson@14365
   565
apply (simp add: preal_mult_def mem_mult_set Rep_preal)
paulson@14365
   566
apply (simp add: mult_set_def) 
paulson@14365
   567
done
paulson@14335
   568
paulson@14365
   569
lemma distrib_subset1:
paulson@14365
   570
     "Rep_preal (w * (x + y)) \<subseteq> Rep_preal (w * x + w * y)"
paulson@14365
   571
apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_mult_iff)
paulson@14365
   572
apply (force simp add: right_distrib)
paulson@14335
   573
done
paulson@14335
   574
paulson@14365
   575
lemma preal_add_mult_distrib_mean:
paulson@14365
   576
  assumes a: "a \<in> Rep_preal w"
wenzelm@19765
   577
    and b: "b \<in> Rep_preal w"
wenzelm@19765
   578
    and d: "d \<in> Rep_preal x"
wenzelm@19765
   579
    and e: "e \<in> Rep_preal y"
wenzelm@19765
   580
  shows "\<exists>c \<in> Rep_preal w. a * d + b * e = c * (d + e)"
paulson@14365
   581
proof
paulson@14365
   582
  let ?c = "(a*d + b*e)/(d+e)"
paulson@14365
   583
  have [simp]: "0<a" "0<b" "0<d" "0<e" "0<d+e"
paulson@14365
   584
    by (blast intro: preal_imp_pos [OF Rep_preal] a b d e pos_add_strict)+
paulson@14365
   585
  have cpos: "0 < ?c"
paulson@14365
   586
    by (simp add: zero_less_divide_iff zero_less_mult_iff pos_add_strict)
paulson@14365
   587
  show "a * d + b * e = ?c * (d + e)"
paulson@14430
   588
    by (simp add: divide_inverse mult_assoc order_less_imp_not_eq2)
paulson@14365
   589
  show "?c \<in> Rep_preal w"
huffman@20495
   590
  proof (cases rule: linorder_le_cases)
huffman@20495
   591
    assume "a \<le> b"
huffman@20495
   592
    hence "?c \<le> b"
huffman@20495
   593
      by (simp add: pos_divide_le_eq right_distrib mult_right_mono
huffman@20495
   594
                    order_less_imp_le)
huffman@20495
   595
    thus ?thesis by (rule preal_downwards_closed' [OF Rep_preal b cpos])
huffman@20495
   596
  next
huffman@20495
   597
    assume "b \<le> a"
huffman@20495
   598
    hence "?c \<le> a"
huffman@20495
   599
      by (simp add: pos_divide_le_eq right_distrib mult_right_mono
huffman@20495
   600
                    order_less_imp_le)
huffman@20495
   601
    thus ?thesis by (rule preal_downwards_closed' [OF Rep_preal a cpos])
paulson@14365
   602
  qed
huffman@20495
   603
qed
paulson@14365
   604
paulson@14365
   605
lemma distrib_subset2:
paulson@14365
   606
     "Rep_preal (w * x + w * y) \<subseteq> Rep_preal (w * (x + y))"
paulson@14365
   607
apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_mult_iff)
paulson@14365
   608
apply (drule_tac w=w and x=x and y=y in preal_add_mult_distrib_mean, auto)
paulson@14335
   609
done
paulson@14335
   610
paulson@14365
   611
lemma preal_add_mult_distrib2: "(w * ((x::preal) + y)) = (w * x) + (w * y)"
paulson@15413
   612
apply (rule Rep_preal_inject [THEN iffD1])
paulson@14365
   613
apply (rule equalityI [OF distrib_subset1 distrib_subset2])
paulson@14335
   614
done
paulson@14335
   615
paulson@14365
   616
lemma preal_add_mult_distrib: "(((x::preal) + y) * w) = (x * w) + (y * w)"
paulson@14365
   617
by (simp add: preal_mult_commute preal_add_mult_distrib2)
paulson@14365
   618
huffman@23287
   619
instance preal :: comm_semiring
huffman@23287
   620
by intro_classes (rule preal_add_mult_distrib)
huffman@23287
   621
paulson@14335
   622
paulson@14335
   623
subsection{*Existence of Inverse, a Positive Real*}
paulson@14335
   624
paulson@14365
   625
lemma mem_inv_set_ex:
paulson@14365
   626
  assumes A: "A \<in> preal" shows "\<exists>x y. 0 < x & x < y & inverse y \<notin> A"
paulson@14365
   627
proof -
paulson@14365
   628
  from preal_exists_bound [OF A]
paulson@14365
   629
  obtain x where [simp]: "0<x" "x \<notin> A" by blast
paulson@14365
   630
  show ?thesis
paulson@14365
   631
  proof (intro exI conjI)
paulson@14365
   632
    show "0 < inverse (x+1)"
paulson@14365
   633
      by (simp add: order_less_trans [OF _ less_add_one]) 
paulson@14365
   634
    show "inverse(x+1) < inverse x"
paulson@14365
   635
      by (simp add: less_imp_inverse_less less_add_one)
paulson@14365
   636
    show "inverse (inverse x) \<notin> A"
paulson@14365
   637
      by (simp add: order_less_imp_not_eq2)
paulson@14365
   638
  qed
paulson@14365
   639
qed
paulson@14335
   640
paulson@14335
   641
text{*Part 1 of Dedekind sections definition*}
paulson@14365
   642
lemma inverse_set_not_empty:
paulson@14365
   643
     "A \<in> preal ==> {} \<subset> inverse_set A"
paulson@14365
   644
apply (insert mem_inv_set_ex [of A])
paulson@14365
   645
apply (auto simp add: inverse_set_def)
paulson@14335
   646
done
paulson@14335
   647
paulson@14335
   648
text{*Part 2 of Dedekind sections definition*}
paulson@14335
   649
paulson@14365
   650
lemma preal_not_mem_inverse_set_Ex:
paulson@14365
   651
   assumes A: "A \<in> preal"  shows "\<exists>q. 0 < q & q \<notin> inverse_set A"
paulson@14365
   652
proof -
paulson@14365
   653
  from preal_nonempty [OF A]
paulson@14365
   654
  obtain x where x: "x \<in> A" and  xpos [simp]: "0<x" ..
paulson@14365
   655
  show ?thesis
paulson@14365
   656
  proof (intro exI conjI)
paulson@14365
   657
    show "0 < inverse x" by simp
paulson@14365
   658
    show "inverse x \<notin> inverse_set A"
paulson@14377
   659
    proof -
paulson@14377
   660
      { fix y::rat 
paulson@14377
   661
	assume ygt: "inverse x < y"
paulson@14377
   662
	have [simp]: "0 < y" by (simp add: order_less_trans [OF _ ygt])
paulson@14377
   663
	have iyless: "inverse y < x" 
paulson@14377
   664
	  by (simp add: inverse_less_imp_less [of x] ygt)
paulson@14377
   665
	have "inverse y \<in> A"
paulson@14377
   666
	  by (simp add: preal_downwards_closed [OF A x] iyless)}
paulson@14377
   667
     thus ?thesis by (auto simp add: inverse_set_def)
paulson@14365
   668
    qed
paulson@14365
   669
  qed
paulson@14365
   670
qed
paulson@14335
   671
paulson@14365
   672
lemma inverse_set_not_rat_set:
paulson@14365
   673
   assumes A: "A \<in> preal"  shows "inverse_set A < {r. 0 < r}"
paulson@14365
   674
proof
paulson@14365
   675
  show "inverse_set A \<subseteq> {r. 0 < r}"  by (force simp add: inverse_set_def)
paulson@14365
   676
next
paulson@14365
   677
  show "inverse_set A \<noteq> {r. 0 < r}"
paulson@14365
   678
    by (insert preal_not_mem_inverse_set_Ex [OF A], blast)
paulson@14365
   679
qed
paulson@14335
   680
paulson@14335
   681
text{*Part 3 of Dedekind sections definition*}
paulson@14365
   682
lemma inverse_set_lemma3:
paulson@14365
   683
     "[|A \<in> preal; u \<in> inverse_set A; 0 < z; z < u|] 
paulson@14365
   684
      ==> z \<in> inverse_set A"
paulson@14365
   685
apply (auto simp add: inverse_set_def)
paulson@14365
   686
apply (auto intro: order_less_trans)
paulson@14335
   687
done
paulson@14335
   688
paulson@14365
   689
text{*Part 4 of Dedekind sections definition*}
paulson@14365
   690
lemma inverse_set_lemma4:
paulson@14365
   691
     "[|A \<in> preal; y \<in> inverse_set A|] ==> \<exists>u \<in> inverse_set A. y < u"
paulson@14365
   692
apply (auto simp add: inverse_set_def)
paulson@14365
   693
apply (drule dense [of y]) 
paulson@14365
   694
apply (blast intro: order_less_trans)
paulson@14335
   695
done
paulson@14335
   696
paulson@14365
   697
paulson@14365
   698
lemma mem_inverse_set:
paulson@14365
   699
     "A \<in> preal ==> inverse_set A \<in> preal"
paulson@14365
   700
apply (simp (no_asm_simp) add: preal_def cut_def)
paulson@14365
   701
apply (blast intro!: inverse_set_not_empty inverse_set_not_rat_set
paulson@14365
   702
                     inverse_set_lemma3 inverse_set_lemma4)
paulson@14335
   703
done
paulson@14335
   704
paulson@14365
   705
paulson@14335
   706
subsection{*Gleason's Lemma 9-3.4, page 122*}
paulson@14335
   707
paulson@14365
   708
lemma Gleason9_34_exists:
paulson@14365
   709
  assumes A: "A \<in> preal"
wenzelm@19765
   710
    and "\<forall>x\<in>A. x + u \<in> A"
wenzelm@19765
   711
    and "0 \<le> z"
wenzelm@19765
   712
  shows "\<exists>b\<in>A. b + (of_int z) * u \<in> A"
paulson@14369
   713
proof (cases z rule: int_cases)
paulson@14369
   714
  case (nonneg n)
paulson@14365
   715
  show ?thesis
paulson@14365
   716
  proof (simp add: prems, induct n)
paulson@14365
   717
    case 0
paulson@14365
   718
      from preal_nonempty [OF A]
paulson@14365
   719
      show ?case  by force 
paulson@14365
   720
    case (Suc k)
paulson@15013
   721
      from this obtain b where "b \<in> A" "b + of_nat k * u \<in> A" ..
paulson@14378
   722
      hence "b + of_int (int k)*u + u \<in> A" by (simp add: prems)
paulson@14365
   723
      thus ?case by (force simp add: left_distrib add_ac prems) 
paulson@14365
   724
  qed
paulson@14365
   725
next
paulson@14369
   726
  case (neg n)
paulson@14369
   727
  with prems show ?thesis by simp
paulson@14365
   728
qed
paulson@14365
   729
paulson@14365
   730
lemma Gleason9_34_contra:
paulson@14365
   731
  assumes A: "A \<in> preal"
paulson@14365
   732
    shows "[|\<forall>x\<in>A. x + u \<in> A; 0 < u; 0 < y; y \<notin> A|] ==> False"
paulson@14365
   733
proof (induct u, induct y)
paulson@14365
   734
  fix a::int and b::int
paulson@14365
   735
  fix c::int and d::int
paulson@14365
   736
  assume bpos [simp]: "0 < b"
wenzelm@19765
   737
    and dpos [simp]: "0 < d"
wenzelm@19765
   738
    and closed: "\<forall>x\<in>A. x + (Fract c d) \<in> A"
wenzelm@19765
   739
    and upos: "0 < Fract c d"
wenzelm@19765
   740
    and ypos: "0 < Fract a b"
wenzelm@19765
   741
    and notin: "Fract a b \<notin> A"
paulson@14365
   742
  have cpos [simp]: "0 < c" 
paulson@14365
   743
    by (simp add: zero_less_Fract_iff [OF dpos, symmetric] upos) 
paulson@14365
   744
  have apos [simp]: "0 < a" 
paulson@14365
   745
    by (simp add: zero_less_Fract_iff [OF bpos, symmetric] ypos) 
paulson@14365
   746
  let ?k = "a*d"
paulson@14378
   747
  have frle: "Fract a b \<le> Fract ?k 1 * (Fract c d)" 
paulson@14365
   748
  proof -
paulson@14365
   749
    have "?thesis = ((a * d * b * d) \<le> c * b * (a * d * b * d))"
paulson@14378
   750
      by (simp add: mult_rat le_rat order_less_imp_not_eq2 mult_ac) 
paulson@14365
   751
    moreover
paulson@14365
   752
    have "(1 * (a * d * b * d)) \<le> c * b * (a * d * b * d)"
paulson@14365
   753
      by (rule mult_mono, 
paulson@14365
   754
          simp_all add: int_one_le_iff_zero_less zero_less_mult_iff 
paulson@14365
   755
                        order_less_imp_le)
paulson@14365
   756
    ultimately
paulson@14365
   757
    show ?thesis by simp
paulson@14365
   758
  qed
paulson@14365
   759
  have k: "0 \<le> ?k" by (simp add: order_less_imp_le zero_less_mult_iff)  
paulson@14365
   760
  from Gleason9_34_exists [OF A closed k]
paulson@14365
   761
  obtain z where z: "z \<in> A" 
paulson@14378
   762
             and mem: "z + of_int ?k * Fract c d \<in> A" ..
paulson@14378
   763
  have less: "z + of_int ?k * Fract c d < Fract a b"
paulson@14365
   764
    by (rule not_in_preal_ub [OF A notin mem ypos])
paulson@14365
   765
  have "0<z" by (rule preal_imp_pos [OF A z])
paulson@14378
   766
  with frle and less show False by (simp add: Fract_of_int_eq) 
paulson@14365
   767
qed
paulson@14335
   768
paulson@14335
   769
paulson@14365
   770
lemma Gleason9_34:
paulson@14365
   771
  assumes A: "A \<in> preal"
wenzelm@19765
   772
    and upos: "0 < u"
wenzelm@19765
   773
  shows "\<exists>r \<in> A. r + u \<notin> A"
paulson@14365
   774
proof (rule ccontr, simp)
paulson@14365
   775
  assume closed: "\<forall>r\<in>A. r + u \<in> A"
paulson@14365
   776
  from preal_exists_bound [OF A]
paulson@14365
   777
  obtain y where y: "y \<notin> A" and ypos: "0 < y" by blast
paulson@14365
   778
  show False
paulson@14365
   779
    by (rule Gleason9_34_contra [OF A closed upos ypos y])
paulson@14365
   780
qed
paulson@14365
   781
paulson@14335
   782
paulson@14335
   783
paulson@14335
   784
subsection{*Gleason's Lemma 9-3.6*}
paulson@14335
   785
paulson@14365
   786
lemma lemma_gleason9_36:
paulson@14365
   787
  assumes A: "A \<in> preal"
wenzelm@19765
   788
    and x: "1 < x"
wenzelm@19765
   789
  shows "\<exists>r \<in> A. r*x \<notin> A"
paulson@14365
   790
proof -
paulson@14365
   791
  from preal_nonempty [OF A]
paulson@14365
   792
  obtain y where y: "y \<in> A" and  ypos: "0<y" ..
paulson@14365
   793
  show ?thesis 
paulson@14365
   794
  proof (rule classical)
paulson@14365
   795
    assume "~(\<exists>r\<in>A. r * x \<notin> A)"
paulson@14365
   796
    with y have ymem: "y * x \<in> A" by blast 
paulson@14365
   797
    from ypos mult_strict_left_mono [OF x]
paulson@14365
   798
    have yless: "y < y*x" by simp 
paulson@14365
   799
    let ?d = "y*x - y"
paulson@14365
   800
    from yless have dpos: "0 < ?d" and eq: "y + ?d = y*x" by auto
paulson@14365
   801
    from Gleason9_34 [OF A dpos]
paulson@14365
   802
    obtain r where r: "r\<in>A" and notin: "r + ?d \<notin> A" ..
paulson@14365
   803
    have rpos: "0<r" by (rule preal_imp_pos [OF A r])
paulson@14365
   804
    with dpos have rdpos: "0 < r + ?d" by arith
paulson@14365
   805
    have "~ (r + ?d \<le> y + ?d)"
paulson@14365
   806
    proof
paulson@14365
   807
      assume le: "r + ?d \<le> y + ?d" 
paulson@14365
   808
      from ymem have yd: "y + ?d \<in> A" by (simp add: eq)
paulson@14365
   809
      have "r + ?d \<in> A" by (rule preal_downwards_closed' [OF A yd rdpos le])
paulson@14365
   810
      with notin show False by simp
paulson@14365
   811
    qed
paulson@14365
   812
    hence "y < r" by simp
paulson@14365
   813
    with ypos have  dless: "?d < (r * ?d)/y"
paulson@14365
   814
      by (simp add: pos_less_divide_eq mult_commute [of ?d]
paulson@14365
   815
                    mult_strict_right_mono dpos)
paulson@14365
   816
    have "r + ?d < r*x"
paulson@14365
   817
    proof -
paulson@14365
   818
      have "r + ?d < r + (r * ?d)/y" by (simp add: dless)
paulson@14365
   819
      also with ypos have "... = (r/y) * (y + ?d)"
paulson@14430
   820
	by (simp only: right_distrib divide_inverse mult_ac, simp)
paulson@14365
   821
      also have "... = r*x" using ypos
paulson@15234
   822
	by (simp add: times_divide_eq_left) 
paulson@14365
   823
      finally show "r + ?d < r*x" .
paulson@14365
   824
    qed
paulson@14365
   825
    with r notin rdpos
paulson@14365
   826
    show "\<exists>r\<in>A. r * x \<notin> A" by (blast dest:  preal_downwards_closed [OF A])
paulson@14365
   827
  qed  
paulson@14365
   828
qed
paulson@14335
   829
paulson@14365
   830
subsection{*Existence of Inverse: Part 2*}
paulson@14365
   831
paulson@14365
   832
lemma mem_Rep_preal_inverse_iff:
paulson@14365
   833
      "(z \<in> Rep_preal(inverse R)) = 
paulson@14365
   834
       (0 < z \<and> (\<exists>y. z < y \<and> inverse y \<notin> Rep_preal R))"
paulson@14365
   835
apply (simp add: preal_inverse_def mem_inverse_set Rep_preal)
paulson@14365
   836
apply (simp add: inverse_set_def) 
paulson@14335
   837
done
paulson@14335
   838
paulson@14365
   839
lemma Rep_preal_of_rat:
paulson@14365
   840
     "0 < q ==> Rep_preal (preal_of_rat q) = {x. 0 < x \<and> x < q}"
paulson@14365
   841
by (simp add: preal_of_rat_def rat_mem_preal) 
paulson@14365
   842
paulson@14365
   843
lemma subset_inverse_mult_lemma:
wenzelm@19765
   844
  assumes xpos: "0 < x" and xless: "x < 1"
wenzelm@19765
   845
  shows "\<exists>r u y. 0 < r & r < y & inverse y \<notin> Rep_preal R & 
wenzelm@19765
   846
    u \<in> Rep_preal R & x = r * u"
paulson@14365
   847
proof -
paulson@14365
   848
  from xpos and xless have "1 < inverse x" by (simp add: one_less_inverse_iff)
paulson@14365
   849
  from lemma_gleason9_36 [OF Rep_preal this]
paulson@14365
   850
  obtain r where r: "r \<in> Rep_preal R" 
paulson@14365
   851
             and notin: "r * (inverse x) \<notin> Rep_preal R" ..
paulson@14365
   852
  have rpos: "0<r" by (rule preal_imp_pos [OF Rep_preal r])
paulson@14365
   853
  from preal_exists_greater [OF Rep_preal r]
paulson@14365
   854
  obtain u where u: "u \<in> Rep_preal R" and rless: "r < u" ..
paulson@14365
   855
  have upos: "0<u" by (rule preal_imp_pos [OF Rep_preal u])
paulson@14365
   856
  show ?thesis
paulson@14365
   857
  proof (intro exI conjI)
paulson@14365
   858
    show "0 < x/u" using xpos upos
paulson@14365
   859
      by (simp add: zero_less_divide_iff)  
paulson@14365
   860
    show "x/u < x/r" using xpos upos rpos
paulson@14430
   861
      by (simp add: divide_inverse mult_less_cancel_left rless) 
paulson@14365
   862
    show "inverse (x / r) \<notin> Rep_preal R" using notin
paulson@14430
   863
      by (simp add: divide_inverse mult_commute) 
paulson@14365
   864
    show "u \<in> Rep_preal R" by (rule u) 
paulson@14365
   865
    show "x = x / u * u" using upos 
paulson@14430
   866
      by (simp add: divide_inverse mult_commute) 
paulson@14365
   867
  qed
paulson@14365
   868
qed
paulson@14365
   869
paulson@14365
   870
lemma subset_inverse_mult: 
paulson@14365
   871
     "Rep_preal(preal_of_rat 1) \<subseteq> Rep_preal(inverse R * R)"
paulson@14365
   872
apply (auto simp add: Bex_def Rep_preal_of_rat mem_Rep_preal_inverse_iff 
paulson@14365
   873
                      mem_Rep_preal_mult_iff)
paulson@14365
   874
apply (blast dest: subset_inverse_mult_lemma) 
paulson@14335
   875
done
paulson@14335
   876
paulson@14365
   877
lemma inverse_mult_subset_lemma:
wenzelm@19765
   878
  assumes rpos: "0 < r" 
wenzelm@19765
   879
    and rless: "r < y"
wenzelm@19765
   880
    and notin: "inverse y \<notin> Rep_preal R"
wenzelm@19765
   881
    and q: "q \<in> Rep_preal R"
wenzelm@19765
   882
  shows "r*q < 1"
paulson@14365
   883
proof -
paulson@14365
   884
  have "q < inverse y" using rpos rless
paulson@14365
   885
    by (simp add: not_in_preal_ub [OF Rep_preal notin] q)
paulson@14365
   886
  hence "r * q < r/y" using rpos
paulson@14430
   887
    by (simp add: divide_inverse mult_less_cancel_left)
paulson@14365
   888
  also have "... \<le> 1" using rpos rless
paulson@14365
   889
    by (simp add: pos_divide_le_eq)
paulson@14365
   890
  finally show ?thesis .
paulson@14365
   891
qed
paulson@14365
   892
paulson@14365
   893
lemma inverse_mult_subset:
paulson@14365
   894
     "Rep_preal(inverse R * R) \<subseteq> Rep_preal(preal_of_rat 1)"
paulson@14365
   895
apply (auto simp add: Bex_def Rep_preal_of_rat mem_Rep_preal_inverse_iff 
paulson@14365
   896
                      mem_Rep_preal_mult_iff)
paulson@14365
   897
apply (simp add: zero_less_mult_iff preal_imp_pos [OF Rep_preal]) 
paulson@14365
   898
apply (blast intro: inverse_mult_subset_lemma) 
paulson@14365
   899
done
paulson@14365
   900
huffman@23287
   901
lemma preal_mult_inverse: "inverse R * R = (1::preal)"
huffman@23287
   902
unfolding preal_one_def
paulson@15413
   903
apply (rule Rep_preal_inject [THEN iffD1])
paulson@14365
   904
apply (rule equalityI [OF inverse_mult_subset subset_inverse_mult]) 
paulson@14365
   905
done
paulson@14365
   906
huffman@23287
   907
lemma preal_mult_inverse_right: "R * inverse R = (1::preal)"
paulson@14365
   908
apply (rule preal_mult_commute [THEN subst])
paulson@14365
   909
apply (rule preal_mult_inverse)
paulson@14335
   910
done
paulson@14335
   911
paulson@14335
   912
paulson@14365
   913
text{*Theorems needing @{text Gleason9_34}*}
paulson@14335
   914
paulson@14365
   915
lemma Rep_preal_self_subset: "Rep_preal (R) \<subseteq> Rep_preal(R + S)"
paulson@14365
   916
proof 
paulson@14365
   917
  fix r
paulson@14365
   918
  assume r: "r \<in> Rep_preal R"
paulson@14365
   919
  have rpos: "0<r" by (rule preal_imp_pos [OF Rep_preal r])
paulson@14365
   920
  from mem_Rep_preal_Ex 
paulson@14365
   921
  obtain y where y: "y \<in> Rep_preal S" ..
paulson@14365
   922
  have ypos: "0<y" by (rule preal_imp_pos [OF Rep_preal y])
paulson@14365
   923
  have ry: "r+y \<in> Rep_preal(R + S)" using r y
paulson@14365
   924
    by (auto simp add: mem_Rep_preal_add_iff)
paulson@14365
   925
  show "r \<in> Rep_preal(R + S)" using r ypos rpos 
paulson@14365
   926
    by (simp add:  preal_downwards_closed [OF Rep_preal ry]) 
paulson@14365
   927
qed
paulson@14335
   928
paulson@14365
   929
lemma Rep_preal_sum_not_subset: "~ Rep_preal (R + S) \<subseteq> Rep_preal(R)"
paulson@14365
   930
proof -
paulson@14365
   931
  from mem_Rep_preal_Ex 
paulson@14365
   932
  obtain y where y: "y \<in> Rep_preal S" ..
paulson@14365
   933
  have ypos: "0<y" by (rule preal_imp_pos [OF Rep_preal y])
paulson@14365
   934
  from  Gleason9_34 [OF Rep_preal ypos]
paulson@14365
   935
  obtain r where r: "r \<in> Rep_preal R" and notin: "r + y \<notin> Rep_preal R" ..
paulson@14365
   936
  have "r + y \<in> Rep_preal (R + S)" using r y
paulson@14365
   937
    by (auto simp add: mem_Rep_preal_add_iff)
paulson@14365
   938
  thus ?thesis using notin by blast
paulson@14365
   939
qed
paulson@14335
   940
paulson@14365
   941
lemma Rep_preal_sum_not_eq: "Rep_preal (R + S) \<noteq> Rep_preal(R)"
paulson@14365
   942
by (insert Rep_preal_sum_not_subset, blast)
paulson@14335
   943
paulson@14335
   944
text{*at last, Gleason prop. 9-3.5(iii) page 123*}
paulson@14365
   945
lemma preal_self_less_add_left: "(R::preal) < R + S"
berghofe@26806
   946
apply (unfold preal_less_def less_le)
paulson@14335
   947
apply (simp add: Rep_preal_self_subset Rep_preal_sum_not_eq [THEN not_sym])
paulson@14335
   948
done
paulson@14335
   949
paulson@14365
   950
lemma preal_self_less_add_right: "(R::preal) < S + R"
paulson@14365
   951
by (simp add: preal_add_commute preal_self_less_add_left)
paulson@14365
   952
paulson@14365
   953
lemma preal_not_eq_self: "x \<noteq> x + (y::preal)"
paulson@14365
   954
by (insert preal_self_less_add_left [of x y], auto)
paulson@14335
   955
paulson@14335
   956
paulson@14365
   957
subsection{*Subtraction for Positive Reals*}
paulson@14335
   958
wenzelm@22710
   959
text{*Gleason prop. 9-3.5(iv), page 123: proving @{prop "A < B ==> \<exists>D. A + D =
paulson@14365
   960
B"}. We define the claimed @{term D} and show that it is a positive real*}
paulson@14335
   961
paulson@14335
   962
text{*Part 1 of Dedekind sections definition*}
paulson@14365
   963
lemma diff_set_not_empty:
paulson@14365
   964
     "R < S ==> {} \<subset> diff_set (Rep_preal S) (Rep_preal R)"
paulson@14365
   965
apply (auto simp add: preal_less_def diff_set_def elim!: equalityE) 
paulson@14365
   966
apply (frule_tac x1 = S in Rep_preal [THEN preal_exists_greater])
paulson@14365
   967
apply (drule preal_imp_pos [OF Rep_preal], clarify)
paulson@14365
   968
apply (cut_tac a=x and b=u in add_eq_exists, force) 
paulson@14335
   969
done
paulson@14335
   970
paulson@14335
   971
text{*Part 2 of Dedekind sections definition*}
paulson@14365
   972
lemma diff_set_nonempty:
paulson@14365
   973
     "\<exists>q. 0 < q & q \<notin> diff_set (Rep_preal S) (Rep_preal R)"
paulson@14365
   974
apply (cut_tac X = S in Rep_preal_exists_bound)
paulson@14335
   975
apply (erule exE)
paulson@14335
   976
apply (rule_tac x = x in exI, auto)
paulson@14365
   977
apply (simp add: diff_set_def) 
paulson@14365
   978
apply (auto dest: Rep_preal [THEN preal_downwards_closed])
paulson@14335
   979
done
paulson@14335
   980
paulson@14365
   981
lemma diff_set_not_rat_set:
wenzelm@19765
   982
  "diff_set (Rep_preal S) (Rep_preal R) < {r. 0 < r}" (is "?lhs < ?rhs")
paulson@14365
   983
proof
paulson@14365
   984
  show "?lhs \<subseteq> ?rhs" by (auto simp add: diff_set_def) 
paulson@14365
   985
  show "?lhs \<noteq> ?rhs" using diff_set_nonempty by blast
paulson@14365
   986
qed
paulson@14335
   987
paulson@14335
   988
text{*Part 3 of Dedekind sections definition*}
paulson@14365
   989
lemma diff_set_lemma3:
paulson@14365
   990
     "[|R < S; u \<in> diff_set (Rep_preal S) (Rep_preal R); 0 < z; z < u|] 
paulson@14365
   991
      ==> z \<in> diff_set (Rep_preal S) (Rep_preal R)"
paulson@14365
   992
apply (auto simp add: diff_set_def) 
paulson@14365
   993
apply (rule_tac x=x in exI) 
paulson@14365
   994
apply (drule Rep_preal [THEN preal_downwards_closed], auto)
paulson@14335
   995
done
paulson@14335
   996
paulson@14365
   997
text{*Part 4 of Dedekind sections definition*}
paulson@14365
   998
lemma diff_set_lemma4:
paulson@14365
   999
     "[|R < S; y \<in> diff_set (Rep_preal S) (Rep_preal R)|] 
paulson@14365
  1000
      ==> \<exists>u \<in> diff_set (Rep_preal S) (Rep_preal R). y < u"
paulson@14365
  1001
apply (auto simp add: diff_set_def) 
paulson@14365
  1002
apply (drule Rep_preal [THEN preal_exists_greater], clarify) 
paulson@14365
  1003
apply (cut_tac a="x+y" and b=u in add_eq_exists, clarify)  
paulson@14365
  1004
apply (rule_tac x="y+xa" in exI) 
paulson@14365
  1005
apply (auto simp add: add_ac)
paulson@14335
  1006
done
paulson@14335
  1007
paulson@14365
  1008
lemma mem_diff_set:
paulson@14365
  1009
     "R < S ==> diff_set (Rep_preal S) (Rep_preal R) \<in> preal"
paulson@14365
  1010
apply (unfold preal_def cut_def)
paulson@14365
  1011
apply (blast intro!: diff_set_not_empty diff_set_not_rat_set
paulson@14365
  1012
                     diff_set_lemma3 diff_set_lemma4)
paulson@14365
  1013
done
paulson@14365
  1014
paulson@14365
  1015
lemma mem_Rep_preal_diff_iff:
paulson@14365
  1016
      "R < S ==>
paulson@14365
  1017
       (z \<in> Rep_preal(S-R)) = 
paulson@14365
  1018
       (\<exists>x. 0 < x & 0 < z & x \<notin> Rep_preal R & x + z \<in> Rep_preal S)"
paulson@14365
  1019
apply (simp add: preal_diff_def mem_diff_set Rep_preal)
paulson@14365
  1020
apply (force simp add: diff_set_def) 
paulson@14335
  1021
done
paulson@14335
  1022
paulson@14365
  1023
paulson@14365
  1024
text{*proving that @{term "R + D \<le> S"}*}
paulson@14365
  1025
paulson@14365
  1026
lemma less_add_left_lemma:
paulson@14365
  1027
  assumes Rless: "R < S"
wenzelm@19765
  1028
    and a: "a \<in> Rep_preal R"
wenzelm@19765
  1029
    and cb: "c + b \<in> Rep_preal S"
wenzelm@19765
  1030
    and "c \<notin> Rep_preal R"
wenzelm@19765
  1031
    and "0 < b"
wenzelm@19765
  1032
    and "0 < c"
paulson@14365
  1033
  shows "a + b \<in> Rep_preal S"
paulson@14365
  1034
proof -
paulson@14365
  1035
  have "0<a" by (rule preal_imp_pos [OF Rep_preal a])
paulson@14365
  1036
  moreover
paulson@14365
  1037
  have "a < c" using prems
paulson@14365
  1038
    by (blast intro: not_in_Rep_preal_ub ) 
paulson@14365
  1039
  ultimately show ?thesis using prems
paulson@14365
  1040
    by (simp add: preal_downwards_closed [OF Rep_preal cb]) 
paulson@14365
  1041
qed
paulson@14365
  1042
paulson@14365
  1043
lemma less_add_left_le1:
paulson@14365
  1044
       "R < (S::preal) ==> R + (S-R) \<le> S"
paulson@14365
  1045
apply (auto simp add: Bex_def preal_le_def mem_Rep_preal_add_iff 
paulson@14365
  1046
                      mem_Rep_preal_diff_iff)
paulson@14365
  1047
apply (blast intro: less_add_left_lemma) 
paulson@14335
  1048
done
paulson@14335
  1049
paulson@14365
  1050
subsection{*proving that @{term "S \<le> R + D"} --- trickier*}
paulson@14335
  1051
paulson@14335
  1052
lemma lemma_sum_mem_Rep_preal_ex:
paulson@14365
  1053
     "x \<in> Rep_preal S ==> \<exists>e. 0 < e & x + e \<in> Rep_preal S"
paulson@14365
  1054
apply (drule Rep_preal [THEN preal_exists_greater], clarify) 
paulson@14365
  1055
apply (cut_tac a=x and b=u in add_eq_exists, auto) 
paulson@14335
  1056
done
paulson@14335
  1057
paulson@14365
  1058
lemma less_add_left_lemma2:
paulson@14365
  1059
  assumes Rless: "R < S"
wenzelm@19765
  1060
    and x:     "x \<in> Rep_preal S"
wenzelm@19765
  1061
    and xnot: "x \<notin>  Rep_preal R"
paulson@14365
  1062
  shows "\<exists>u v z. 0 < v & 0 < z & u \<in> Rep_preal R & z \<notin> Rep_preal R & 
paulson@14365
  1063
                     z + v \<in> Rep_preal S & x = u + v"
paulson@14365
  1064
proof -
paulson@14365
  1065
  have xpos: "0<x" by (rule preal_imp_pos [OF Rep_preal x])
paulson@14365
  1066
  from lemma_sum_mem_Rep_preal_ex [OF x]
paulson@14365
  1067
  obtain e where epos: "0 < e" and xe: "x + e \<in> Rep_preal S" by blast
paulson@14365
  1068
  from  Gleason9_34 [OF Rep_preal epos]
paulson@14365
  1069
  obtain r where r: "r \<in> Rep_preal R" and notin: "r + e \<notin> Rep_preal R" ..
paulson@14365
  1070
  with x xnot xpos have rless: "r < x" by (blast intro: not_in_Rep_preal_ub)
paulson@14365
  1071
  from add_eq_exists [of r x]
paulson@14365
  1072
  obtain y where eq: "x = r+y" by auto
paulson@14365
  1073
  show ?thesis 
paulson@14365
  1074
  proof (intro exI conjI)
paulson@14365
  1075
    show "r \<in> Rep_preal R" by (rule r)
paulson@14365
  1076
    show "r + e \<notin> Rep_preal R" by (rule notin)
paulson@14365
  1077
    show "r + e + y \<in> Rep_preal S" using xe eq by (simp add: add_ac)
paulson@14365
  1078
    show "x = r + y" by (simp add: eq)
paulson@14365
  1079
    show "0 < r + e" using epos preal_imp_pos [OF Rep_preal r]
paulson@14365
  1080
      by simp
paulson@14365
  1081
    show "0 < y" using rless eq by arith
paulson@14365
  1082
  qed
paulson@14365
  1083
qed
paulson@14365
  1084
paulson@14365
  1085
lemma less_add_left_le2: "R < (S::preal) ==> S \<le> R + (S-R)"
paulson@14365
  1086
apply (auto simp add: preal_le_def)
paulson@14365
  1087
apply (case_tac "x \<in> Rep_preal R")
paulson@14365
  1088
apply (cut_tac Rep_preal_self_subset [of R], force)
paulson@14365
  1089
apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_diff_iff)
paulson@14365
  1090
apply (blast dest: less_add_left_lemma2)
paulson@14335
  1091
done
paulson@14335
  1092
paulson@14365
  1093
lemma less_add_left: "R < (S::preal) ==> R + (S-R) = S"
paulson@14365
  1094
by (blast intro: preal_le_anti_sym [OF less_add_left_le1 less_add_left_le2])
paulson@14335
  1095
paulson@14365
  1096
lemma less_add_left_Ex: "R < (S::preal) ==> \<exists>D. R + D = S"
paulson@14365
  1097
by (fast dest: less_add_left)
paulson@14335
  1098
paulson@14365
  1099
lemma preal_add_less2_mono1: "R < (S::preal) ==> R + T < S + T"
paulson@14365
  1100
apply (auto dest!: less_add_left_Ex simp add: preal_add_assoc)
paulson@14335
  1101
apply (rule_tac y1 = D in preal_add_commute [THEN subst])
paulson@14335
  1102
apply (auto intro: preal_self_less_add_left simp add: preal_add_assoc [symmetric])
paulson@14335
  1103
done
paulson@14335
  1104
paulson@14365
  1105
lemma preal_add_less2_mono2: "R < (S::preal) ==> T + R < T + S"
paulson@14365
  1106
by (auto intro: preal_add_less2_mono1 simp add: preal_add_commute [of T])
paulson@14335
  1107
paulson@14365
  1108
lemma preal_add_right_less_cancel: "R + T < S + T ==> R < (S::preal)"
paulson@14365
  1109
apply (insert linorder_less_linear [of R S], auto)
paulson@14365
  1110
apply (drule_tac R = S and T = T in preal_add_less2_mono1)
paulson@14365
  1111
apply (blast dest: order_less_trans) 
paulson@14335
  1112
done
paulson@14335
  1113
paulson@14365
  1114
lemma preal_add_left_less_cancel: "T + R < T + S ==> R <  (S::preal)"
paulson@14365
  1115
by (auto elim: preal_add_right_less_cancel simp add: preal_add_commute [of T])
paulson@14335
  1116
paulson@14365
  1117
lemma preal_add_less_cancel_right: "((R::preal) + T < S + T) = (R < S)"
paulson@14335
  1118
by (blast intro: preal_add_less2_mono1 preal_add_right_less_cancel)
paulson@14335
  1119
paulson@14365
  1120
lemma preal_add_less_cancel_left: "(T + (R::preal) < T + S) = (R < S)"
paulson@14335
  1121
by (blast intro: preal_add_less2_mono2 preal_add_left_less_cancel)
paulson@14335
  1122
paulson@14365
  1123
lemma preal_add_le_cancel_right: "((R::preal) + T \<le> S + T) = (R \<le> S)"
paulson@14365
  1124
by (simp add: linorder_not_less [symmetric] preal_add_less_cancel_right) 
paulson@14365
  1125
paulson@14365
  1126
lemma preal_add_le_cancel_left: "(T + (R::preal) \<le> T + S) = (R \<le> S)"
paulson@14365
  1127
by (simp add: linorder_not_less [symmetric] preal_add_less_cancel_left) 
paulson@14365
  1128
paulson@14335
  1129
lemma preal_add_less_mono:
paulson@14335
  1130
     "[| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::preal)"
paulson@14365
  1131
apply (auto dest!: less_add_left_Ex simp add: preal_add_ac)
paulson@14335
  1132
apply (rule preal_add_assoc [THEN subst])
paulson@14335
  1133
apply (rule preal_self_less_add_right)
paulson@14335
  1134
done
paulson@14335
  1135
paulson@14365
  1136
lemma preal_add_right_cancel: "(R::preal) + T = S + T ==> R = S"
paulson@14365
  1137
apply (insert linorder_less_linear [of R S], safe)
paulson@14365
  1138
apply (drule_tac [!] T = T in preal_add_less2_mono1, auto)
paulson@14335
  1139
done
paulson@14335
  1140
paulson@14365
  1141
lemma preal_add_left_cancel: "C + A = C + B ==> A = (B::preal)"
paulson@14335
  1142
by (auto intro: preal_add_right_cancel simp add: preal_add_commute)
paulson@14335
  1143
paulson@14365
  1144
lemma preal_add_left_cancel_iff: "(C + A = C + B) = ((A::preal) = B)"
paulson@14335
  1145
by (fast intro: preal_add_left_cancel)
paulson@14335
  1146
paulson@14365
  1147
lemma preal_add_right_cancel_iff: "(A + C = B + C) = ((A::preal) = B)"
paulson@14335
  1148
by (fast intro: preal_add_right_cancel)
paulson@14335
  1149
paulson@14365
  1150
lemmas preal_cancels =
paulson@14365
  1151
    preal_add_less_cancel_right preal_add_less_cancel_left
paulson@14365
  1152
    preal_add_le_cancel_right preal_add_le_cancel_left
paulson@14365
  1153
    preal_add_left_cancel_iff preal_add_right_cancel_iff
paulson@14335
  1154
huffman@23285
  1155
instance preal :: ordered_cancel_ab_semigroup_add
huffman@23285
  1156
proof
huffman@23285
  1157
  fix a b c :: preal
huffman@23285
  1158
  show "a + b = a + c \<Longrightarrow> b = c" by (rule preal_add_left_cancel)
huffman@23287
  1159
  show "a \<le> b \<Longrightarrow> c + a \<le> c + b" by (simp only: preal_add_le_cancel_left)
huffman@23285
  1160
qed
huffman@23285
  1161
paulson@14335
  1162
paulson@14335
  1163
subsection{*Completeness of type @{typ preal}*}
paulson@14335
  1164
paulson@14335
  1165
text{*Prove that supremum is a cut*}
paulson@14335
  1166
paulson@14365
  1167
text{*Part 1 of Dedekind sections definition*}
paulson@14365
  1168
paulson@14365
  1169
lemma preal_sup_set_not_empty:
paulson@14365
  1170
     "P \<noteq> {} ==> {} \<subset> (\<Union>X \<in> P. Rep_preal(X))"
paulson@14365
  1171
apply auto
paulson@14365
  1172
apply (cut_tac X = x in mem_Rep_preal_Ex, auto)
paulson@14335
  1173
done
paulson@14335
  1174
paulson@14335
  1175
paulson@14335
  1176
text{*Part 2 of Dedekind sections definition*}
paulson@14365
  1177
paulson@14365
  1178
lemma preal_sup_not_exists:
paulson@14365
  1179
     "\<forall>X \<in> P. X \<le> Y ==> \<exists>q. 0 < q & q \<notin> (\<Union>X \<in> P. Rep_preal(X))"
paulson@14365
  1180
apply (cut_tac X = Y in Rep_preal_exists_bound)
paulson@14365
  1181
apply (auto simp add: preal_le_def)
paulson@14335
  1182
done
paulson@14335
  1183
paulson@14365
  1184
lemma preal_sup_set_not_rat_set:
paulson@14365
  1185
     "\<forall>X \<in> P. X \<le> Y ==> (\<Union>X \<in> P. Rep_preal(X)) < {r. 0 < r}"
paulson@14365
  1186
apply (drule preal_sup_not_exists)
paulson@14365
  1187
apply (blast intro: preal_imp_pos [OF Rep_preal])  
paulson@14335
  1188
done
paulson@14335
  1189
paulson@14335
  1190
text{*Part 3 of Dedekind sections definition*}
paulson@14335
  1191
lemma preal_sup_set_lemma3:
paulson@14365
  1192
     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y; u \<in> (\<Union>X \<in> P. Rep_preal(X)); 0 < z; z < u|]
paulson@14365
  1193
      ==> z \<in> (\<Union>X \<in> P. Rep_preal(X))"
paulson@14365
  1194
by (auto elim: Rep_preal [THEN preal_downwards_closed])
paulson@14335
  1195
paulson@14365
  1196
text{*Part 4 of Dedekind sections definition*}
paulson@14335
  1197
lemma preal_sup_set_lemma4:
paulson@14365
  1198
     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y; y \<in> (\<Union>X \<in> P. Rep_preal(X)) |]
paulson@14365
  1199
          ==> \<exists>u \<in> (\<Union>X \<in> P. Rep_preal(X)). y < u"
paulson@14365
  1200
by (blast dest: Rep_preal [THEN preal_exists_greater])
paulson@14335
  1201
paulson@14335
  1202
lemma preal_sup:
paulson@14365
  1203
     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y|] ==> (\<Union>X \<in> P. Rep_preal(X)) \<in> preal"
paulson@14365
  1204
apply (unfold preal_def cut_def)
paulson@14365
  1205
apply (blast intro!: preal_sup_set_not_empty preal_sup_set_not_rat_set
paulson@14365
  1206
                     preal_sup_set_lemma3 preal_sup_set_lemma4)
paulson@14335
  1207
done
paulson@14335
  1208
paulson@14365
  1209
lemma preal_psup_le:
paulson@14365
  1210
     "[| \<forall>X \<in> P. X \<le> Y;  x \<in> P |] ==> x \<le> psup P"
paulson@14365
  1211
apply (simp (no_asm_simp) add: preal_le_def) 
paulson@14365
  1212
apply (subgoal_tac "P \<noteq> {}") 
paulson@14365
  1213
apply (auto simp add: psup_def preal_sup) 
paulson@14335
  1214
done
paulson@14335
  1215
paulson@14365
  1216
lemma psup_le_ub: "[| P \<noteq> {}; \<forall>X \<in> P. X \<le> Y |] ==> psup P \<le> Y"
paulson@14365
  1217
apply (simp (no_asm_simp) add: preal_le_def)
paulson@14365
  1218
apply (simp add: psup_def preal_sup) 
paulson@14335
  1219
apply (auto simp add: preal_le_def)
paulson@14335
  1220
done
paulson@14335
  1221
paulson@14335
  1222
text{*Supremum property*}
paulson@14335
  1223
lemma preal_complete:
paulson@14365
  1224
     "[| P \<noteq> {}; \<forall>X \<in> P. X \<le> Y |] ==> (\<exists>X \<in> P. Z < X) = (Z < psup P)"
paulson@14365
  1225
apply (simp add: preal_less_def psup_def preal_sup)
paulson@14365
  1226
apply (auto simp add: preal_le_def)
paulson@14365
  1227
apply (rename_tac U) 
paulson@14365
  1228
apply (cut_tac x = U and y = Z in linorder_less_linear)
paulson@14365
  1229
apply (auto simp add: preal_less_def)
paulson@14335
  1230
done
paulson@14335
  1231
paulson@14335
  1232
huffman@20495
  1233
subsection{*The Embedding from @{typ rat} into @{typ preal}*}
paulson@14335
  1234
paulson@14365
  1235
lemma preal_of_rat_add_lemma1:
paulson@14365
  1236
     "[|x < y + z; 0 < x; 0 < y|] ==> x * y * inverse (y + z) < (y::rat)"
paulson@14365
  1237
apply (frule_tac c = "y * inverse (y + z) " in mult_strict_right_mono)
paulson@14365
  1238
apply (simp add: zero_less_mult_iff) 
paulson@14365
  1239
apply (simp add: mult_ac)
paulson@14335
  1240
done
paulson@14335
  1241
paulson@14365
  1242
lemma preal_of_rat_add_lemma2:
paulson@14365
  1243
  assumes "u < x + y"
wenzelm@19765
  1244
    and "0 < x"
wenzelm@19765
  1245
    and "0 < y"
wenzelm@19765
  1246
    and "0 < u"
paulson@14365
  1247
  shows "\<exists>v w::rat. w < y & 0 < v & v < x & 0 < w & u = v + w"
paulson@14365
  1248
proof (intro exI conjI)
paulson@14365
  1249
  show "u * x * inverse(x+y) < x" using prems 
paulson@14365
  1250
    by (simp add: preal_of_rat_add_lemma1) 
paulson@14365
  1251
  show "u * y * inverse(x+y) < y" using prems 
paulson@14365
  1252
    by (simp add: preal_of_rat_add_lemma1 add_commute [of x]) 
paulson@14365
  1253
  show "0 < u * x * inverse (x + y)" using prems
paulson@14365
  1254
    by (simp add: zero_less_mult_iff) 
paulson@14365
  1255
  show "0 < u * y * inverse (x + y)" using prems
paulson@14365
  1256
    by (simp add: zero_less_mult_iff) 
paulson@14365
  1257
  show "u = u * x * inverse (x + y) + u * y * inverse (x + y)" using prems
paulson@14365
  1258
    by (simp add: left_distrib [symmetric] right_distrib [symmetric] mult_ac)
paulson@14365
  1259
qed
paulson@14365
  1260
paulson@14365
  1261
lemma preal_of_rat_add:
paulson@14365
  1262
     "[| 0 < x; 0 < y|] 
paulson@14365
  1263
      ==> preal_of_rat ((x::rat) + y) = preal_of_rat x + preal_of_rat y"
paulson@14365
  1264
apply (unfold preal_of_rat_def preal_add_def)
paulson@14365
  1265
apply (simp add: rat_mem_preal) 
paulson@14335
  1266
apply (rule_tac f = Abs_preal in arg_cong)
paulson@14365
  1267
apply (auto simp add: add_set_def) 
paulson@14365
  1268
apply (blast dest: preal_of_rat_add_lemma2) 
paulson@14365
  1269
done
paulson@14365
  1270
paulson@14365
  1271
lemma preal_of_rat_mult_lemma1:
paulson@14365
  1272
     "[|x < y; 0 < x; 0 < z|] ==> x * z * inverse y < (z::rat)"
paulson@14365
  1273
apply (frule_tac c = "z * inverse y" in mult_strict_right_mono)
paulson@14365
  1274
apply (simp add: zero_less_mult_iff)
paulson@14365
  1275
apply (subgoal_tac "y * (z * inverse y) = z * (y * inverse y)")
paulson@14365
  1276
apply (simp_all add: mult_ac)
paulson@14335
  1277
done
paulson@14335
  1278
paulson@14365
  1279
lemma preal_of_rat_mult_lemma2: 
paulson@14365
  1280
  assumes xless: "x < y * z"
wenzelm@19765
  1281
    and xpos: "0 < x"
wenzelm@19765
  1282
    and ypos: "0 < y"
paulson@14365
  1283
  shows "x * z * inverse y * inverse z < (z::rat)"
paulson@14365
  1284
proof -
paulson@14365
  1285
  have "0 < y * z" using prems by simp
paulson@14365
  1286
  hence zpos:  "0 < z" using prems by (simp add: zero_less_mult_iff)
paulson@14365
  1287
  have "x * z * inverse y * inverse z = x * inverse y * (z * inverse z)"
paulson@14365
  1288
    by (simp add: mult_ac)
paulson@14365
  1289
  also have "... = x/y" using zpos
paulson@14430
  1290
    by (simp add: divide_inverse)
wenzelm@23389
  1291
  also from xless have "... < z"
wenzelm@23389
  1292
    by (simp add: pos_divide_less_eq [OF ypos] mult_commute)
paulson@14365
  1293
  finally show ?thesis .
paulson@14365
  1294
qed
paulson@14335
  1295
paulson@14365
  1296
lemma preal_of_rat_mult_lemma3:
paulson@14365
  1297
  assumes uless: "u < x * y"
wenzelm@19765
  1298
    and "0 < x"
wenzelm@19765
  1299
    and "0 < y"
wenzelm@19765
  1300
    and "0 < u"
paulson@14365
  1301
  shows "\<exists>v w::rat. v < x & w < y & 0 < v & 0 < w & u = v * w"
paulson@14365
  1302
proof -
paulson@14365
  1303
  from dense [OF uless] 
paulson@14365
  1304
  obtain r where "u < r" "r < x * y" by blast
paulson@14365
  1305
  thus ?thesis
paulson@14365
  1306
  proof (intro exI conjI)
paulson@14365
  1307
  show "u * x * inverse r < x" using prems 
paulson@14365
  1308
    by (simp add: preal_of_rat_mult_lemma1) 
paulson@14365
  1309
  show "r * y * inverse x * inverse y < y" using prems
paulson@14365
  1310
    by (simp add: preal_of_rat_mult_lemma2)
paulson@14365
  1311
  show "0 < u * x * inverse r" using prems
paulson@14365
  1312
    by (simp add: zero_less_mult_iff) 
paulson@14365
  1313
  show "0 < r * y * inverse x * inverse y" using prems
paulson@14365
  1314
    by (simp add: zero_less_mult_iff) 
paulson@14365
  1315
  have "u * x * inverse r * (r * y * inverse x * inverse y) =
paulson@14365
  1316
        u * (r * inverse r) * (x * inverse x) * (y * inverse y)"
paulson@14365
  1317
    by (simp only: mult_ac)
paulson@14365
  1318
  thus "u = u * x * inverse r * (r * y * inverse x * inverse y)" using prems
paulson@14365
  1319
    by simp
paulson@14365
  1320
  qed
paulson@14365
  1321
qed
paulson@14365
  1322
paulson@14365
  1323
lemma preal_of_rat_mult:
paulson@14365
  1324
     "[| 0 < x; 0 < y|] 
paulson@14365
  1325
      ==> preal_of_rat ((x::rat) * y) = preal_of_rat x * preal_of_rat y"
paulson@14365
  1326
apply (unfold preal_of_rat_def preal_mult_def)
paulson@14365
  1327
apply (simp add: rat_mem_preal) 
paulson@14365
  1328
apply (rule_tac f = Abs_preal in arg_cong)
paulson@14365
  1329
apply (auto simp add: zero_less_mult_iff mult_strict_mono mult_set_def) 
paulson@14365
  1330
apply (blast dest: preal_of_rat_mult_lemma3) 
paulson@14335
  1331
done
paulson@14335
  1332
paulson@14365
  1333
lemma preal_of_rat_less_iff:
paulson@14365
  1334
      "[| 0 < x; 0 < y|] ==> (preal_of_rat x < preal_of_rat y) = (x < y)"
paulson@14365
  1335
by (force simp add: preal_of_rat_def preal_less_def rat_mem_preal) 
paulson@14335
  1336
paulson@14365
  1337
lemma preal_of_rat_le_iff:
paulson@14365
  1338
      "[| 0 < x; 0 < y|] ==> (preal_of_rat x \<le> preal_of_rat y) = (x \<le> y)"
paulson@14365
  1339
by (simp add: preal_of_rat_less_iff linorder_not_less [symmetric]) 
paulson@14365
  1340
paulson@14365
  1341
lemma preal_of_rat_eq_iff:
paulson@14365
  1342
      "[| 0 < x; 0 < y|] ==> (preal_of_rat x = preal_of_rat y) = (x = y)"
paulson@14365
  1343
by (simp add: preal_of_rat_le_iff order_eq_iff) 
paulson@14335
  1344
paulson@5078
  1345
end