src/HOL/Hyperreal/StarClasses.thy
author haftmann
Tue Nov 06 08:47:30 2007 +0100 (2007-11-06)
changeset 25304 7491c00f0915
parent 25230 022029099a83
child 25571 c9e39eafc7a0
permissions -rw-r--r--
removed subclass edge ordered_ring < lordered_ring
     1 (*  Title       : HOL/Hyperreal/StarClasses.thy
     2     ID          : $Id$
     3     Author      : Brian Huffman
     4 *)
     5 
     6 header {* Class Instances *}
     7 
     8 theory StarClasses
     9 imports StarDef
    10 begin
    11 
    12 subsection {* Syntactic classes *}
    13 
    14 instance star :: (zero) zero
    15   star_zero_def:    "0 \<equiv> star_of 0" ..
    16 
    17 instance star :: (one) one
    18   star_one_def:     "1 \<equiv> star_of 1" ..
    19 
    20 instance star :: (plus) plus
    21   star_add_def:     "(op +) \<equiv> *f2* (op +)" ..
    22 
    23 instance star :: (times) times
    24   star_mult_def:    "(op *) \<equiv> *f2* (op *)" ..
    25 
    26 instance star :: (minus) minus
    27   star_minus_def:   "uminus \<equiv> *f* uminus"
    28   star_diff_def:    "(op -) \<equiv> *f2* (op -)" ..
    29 
    30 instance star :: (abs) abs
    31   star_abs_def:     "abs \<equiv> *f* abs" ..
    32 
    33 instance star :: (sgn) sgn
    34   star_sgn_def:     "sgn \<equiv> *f* sgn" ..
    35 
    36 instance star :: (inverse) inverse
    37   star_divide_def:  "(op /) \<equiv> *f2* (op /)"
    38   star_inverse_def: "inverse \<equiv> *f* inverse" ..
    39 
    40 instance star :: (number) number
    41   star_number_def:  "number_of b \<equiv> star_of (number_of b)" ..
    42 
    43 instance star :: (Divides.div) Divides.div
    44   star_div_def:     "(op div) \<equiv> *f2* (op div)"
    45   star_mod_def:     "(op mod) \<equiv> *f2* (op mod)" ..
    46 
    47 instance star :: (power) power
    48   star_power_def:   "(op ^) \<equiv> \<lambda>x n. ( *f* (\<lambda>x. x ^ n)) x" ..
    49 
    50 instance star :: (ord) ord
    51   star_le_def:      "(op \<le>) \<equiv> *p2* (op \<le>)"
    52   star_less_def:    "(op <) \<equiv> *p2* (op <)" ..
    53 
    54 lemmas star_class_defs [transfer_unfold] =
    55   star_zero_def     star_one_def      star_number_def
    56   star_add_def      star_diff_def     star_minus_def
    57   star_mult_def     star_divide_def   star_inverse_def
    58   star_le_def       star_less_def     star_abs_def       star_sgn_def
    59   star_div_def      star_mod_def      star_power_def
    60 
    61 text {* Class operations preserve standard elements *}
    62 
    63 lemma Standard_zero: "0 \<in> Standard"
    64 by (simp add: star_zero_def)
    65 
    66 lemma Standard_one: "1 \<in> Standard"
    67 by (simp add: star_one_def)
    68 
    69 lemma Standard_number_of: "number_of b \<in> Standard"
    70 by (simp add: star_number_def)
    71 
    72 lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
    73 by (simp add: star_add_def)
    74 
    75 lemma Standard_diff: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x - y \<in> Standard"
    76 by (simp add: star_diff_def)
    77 
    78 lemma Standard_minus: "x \<in> Standard \<Longrightarrow> - x \<in> Standard"
    79 by (simp add: star_minus_def)
    80 
    81 lemma Standard_mult: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x * y \<in> Standard"
    82 by (simp add: star_mult_def)
    83 
    84 lemma Standard_divide: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x / y \<in> Standard"
    85 by (simp add: star_divide_def)
    86 
    87 lemma Standard_inverse: "x \<in> Standard \<Longrightarrow> inverse x \<in> Standard"
    88 by (simp add: star_inverse_def)
    89 
    90 lemma Standard_abs: "x \<in> Standard \<Longrightarrow> abs x \<in> Standard"
    91 by (simp add: star_abs_def)
    92 
    93 lemma Standard_div: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x div y \<in> Standard"
    94 by (simp add: star_div_def)
    95 
    96 lemma Standard_mod: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x mod y \<in> Standard"
    97 by (simp add: star_mod_def)
    98 
    99 lemma Standard_power: "x \<in> Standard \<Longrightarrow> x ^ n \<in> Standard"
   100 by (simp add: star_power_def)
   101 
   102 lemmas Standard_simps [simp] =
   103   Standard_zero  Standard_one  Standard_number_of
   104   Standard_add  Standard_diff  Standard_minus
   105   Standard_mult  Standard_divide  Standard_inverse
   106   Standard_abs  Standard_div  Standard_mod
   107   Standard_power
   108 
   109 text {* @{term star_of} preserves class operations *}
   110 
   111 lemma star_of_add: "star_of (x + y) = star_of x + star_of y"
   112 by transfer (rule refl)
   113 
   114 lemma star_of_diff: "star_of (x - y) = star_of x - star_of y"
   115 by transfer (rule refl)
   116 
   117 lemma star_of_minus: "star_of (-x) = - star_of x"
   118 by transfer (rule refl)
   119 
   120 lemma star_of_mult: "star_of (x * y) = star_of x * star_of y"
   121 by transfer (rule refl)
   122 
   123 lemma star_of_divide: "star_of (x / y) = star_of x / star_of y"
   124 by transfer (rule refl)
   125 
   126 lemma star_of_inverse: "star_of (inverse x) = inverse (star_of x)"
   127 by transfer (rule refl)
   128 
   129 lemma star_of_div: "star_of (x div y) = star_of x div star_of y"
   130 by transfer (rule refl)
   131 
   132 lemma star_of_mod: "star_of (x mod y) = star_of x mod star_of y"
   133 by transfer (rule refl)
   134 
   135 lemma star_of_power: "star_of (x ^ n) = star_of x ^ n"
   136 by transfer (rule refl)
   137 
   138 lemma star_of_abs: "star_of (abs x) = abs (star_of x)"
   139 by transfer (rule refl)
   140 
   141 text {* @{term star_of} preserves numerals *}
   142 
   143 lemma star_of_zero: "star_of 0 = 0"
   144 by transfer (rule refl)
   145 
   146 lemma star_of_one: "star_of 1 = 1"
   147 by transfer (rule refl)
   148 
   149 lemma star_of_number_of: "star_of (number_of x) = number_of x"
   150 by transfer (rule refl)
   151 
   152 text {* @{term star_of} preserves orderings *}
   153 
   154 lemma star_of_less: "(star_of x < star_of y) = (x < y)"
   155 by transfer (rule refl)
   156 
   157 lemma star_of_le: "(star_of x \<le> star_of y) = (x \<le> y)"
   158 by transfer (rule refl)
   159 
   160 lemma star_of_eq: "(star_of x = star_of y) = (x = y)"
   161 by transfer (rule refl)
   162 
   163 text{*As above, for 0*}
   164 
   165 lemmas star_of_0_less = star_of_less [of 0, simplified star_of_zero]
   166 lemmas star_of_0_le   = star_of_le   [of 0, simplified star_of_zero]
   167 lemmas star_of_0_eq   = star_of_eq   [of 0, simplified star_of_zero]
   168 
   169 lemmas star_of_less_0 = star_of_less [of _ 0, simplified star_of_zero]
   170 lemmas star_of_le_0   = star_of_le   [of _ 0, simplified star_of_zero]
   171 lemmas star_of_eq_0   = star_of_eq   [of _ 0, simplified star_of_zero]
   172 
   173 text{*As above, for 1*}
   174 
   175 lemmas star_of_1_less = star_of_less [of 1, simplified star_of_one]
   176 lemmas star_of_1_le   = star_of_le   [of 1, simplified star_of_one]
   177 lemmas star_of_1_eq   = star_of_eq   [of 1, simplified star_of_one]
   178 
   179 lemmas star_of_less_1 = star_of_less [of _ 1, simplified star_of_one]
   180 lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
   181 lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
   182 
   183 text{*As above, for numerals*}
   184 
   185 lemmas star_of_number_less =
   186   star_of_less [of "number_of w", standard, simplified star_of_number_of]
   187 lemmas star_of_number_le   =
   188   star_of_le   [of "number_of w", standard, simplified star_of_number_of]
   189 lemmas star_of_number_eq   =
   190   star_of_eq   [of "number_of w", standard, simplified star_of_number_of]
   191 
   192 lemmas star_of_less_number =
   193   star_of_less [of _ "number_of w", standard, simplified star_of_number_of]
   194 lemmas star_of_le_number   =
   195   star_of_le   [of _ "number_of w", standard, simplified star_of_number_of]
   196 lemmas star_of_eq_number   =
   197   star_of_eq   [of _ "number_of w", standard, simplified star_of_number_of]
   198 
   199 lemmas star_of_simps [simp] =
   200   star_of_add     star_of_diff    star_of_minus
   201   star_of_mult    star_of_divide  star_of_inverse
   202   star_of_div     star_of_mod
   203   star_of_power   star_of_abs
   204   star_of_zero    star_of_one     star_of_number_of
   205   star_of_less    star_of_le      star_of_eq
   206   star_of_0_less  star_of_0_le    star_of_0_eq
   207   star_of_less_0  star_of_le_0    star_of_eq_0
   208   star_of_1_less  star_of_1_le    star_of_1_eq
   209   star_of_less_1  star_of_le_1    star_of_eq_1
   210   star_of_number_less star_of_number_le star_of_number_eq
   211   star_of_less_number star_of_le_number star_of_eq_number
   212 
   213 subsection {* Ordering and lattice classes *}
   214 
   215 instance star :: (order) order
   216 apply (intro_classes)
   217 apply (transfer, rule order_less_le)
   218 apply (transfer, rule order_refl)
   219 apply (transfer, erule (1) order_trans)
   220 apply (transfer, erule (1) order_antisym)
   221 done
   222 
   223 instance star :: (lower_semilattice) lower_semilattice
   224   star_inf_def [transfer_unfold]: "inf \<equiv> *f2* inf"
   225   by default (transfer star_inf_def, auto)+
   226 
   227 instance star :: (upper_semilattice) upper_semilattice
   228   star_sup_def [transfer_unfold]: "sup \<equiv> *f2* sup"
   229   by default (transfer star_sup_def, auto)+
   230 
   231 instance star :: (lattice) lattice ..
   232 
   233 instance star :: (distrib_lattice) distrib_lattice
   234   by default (transfer, auto simp add: sup_inf_distrib1)
   235 
   236 lemma Standard_inf [simp]:
   237   "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> inf x y \<in> Standard"
   238 by (simp add: star_inf_def)
   239 
   240 lemma Standard_sup [simp]:
   241   "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> sup x y \<in> Standard"
   242 by (simp add: star_sup_def)
   243 
   244 lemma star_of_inf [simp]: "star_of (inf x y) = inf (star_of x) (star_of y)"
   245 by transfer (rule refl)
   246 
   247 lemma star_of_sup [simp]: "star_of (sup x y) = sup (star_of x) (star_of y)"
   248 by transfer (rule refl)
   249 
   250 instance star :: (linorder) linorder
   251 by (intro_classes, transfer, rule linorder_linear)
   252 
   253 lemma star_max_def [transfer_unfold]: "max = *f2* max"
   254 apply (rule ext, rule ext)
   255 apply (unfold max_def, transfer, fold max_def)
   256 apply (rule refl)
   257 done
   258 
   259 lemma star_min_def [transfer_unfold]: "min = *f2* min"
   260 apply (rule ext, rule ext)
   261 apply (unfold min_def, transfer, fold min_def)
   262 apply (rule refl)
   263 done
   264 
   265 lemma Standard_max [simp]:
   266   "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> max x y \<in> Standard"
   267 by (simp add: star_max_def)
   268 
   269 lemma Standard_min [simp]:
   270   "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> min x y \<in> Standard"
   271 by (simp add: star_min_def)
   272 
   273 lemma star_of_max [simp]: "star_of (max x y) = max (star_of x) (star_of y)"
   274 by transfer (rule refl)
   275 
   276 lemma star_of_min [simp]: "star_of (min x y) = min (star_of x) (star_of y)"
   277 by transfer (rule refl)
   278 
   279 
   280 subsection {* Ordered group classes *}
   281 
   282 instance star :: (semigroup_add) semigroup_add
   283 by (intro_classes, transfer, rule add_assoc)
   284 
   285 instance star :: (ab_semigroup_add) ab_semigroup_add
   286 by (intro_classes, transfer, rule add_commute)
   287 
   288 instance star :: (semigroup_mult) semigroup_mult
   289 by (intro_classes, transfer, rule mult_assoc)
   290 
   291 instance star :: (ab_semigroup_mult) ab_semigroup_mult
   292 by (intro_classes, transfer, rule mult_commute)
   293 
   294 instance star :: (comm_monoid_add) comm_monoid_add
   295 by (intro_classes, transfer, rule comm_monoid_add_class.zero_plus.add_0)
   296 
   297 instance star :: (monoid_mult) monoid_mult
   298 apply (intro_classes)
   299 apply (transfer, rule mult_1_left)
   300 apply (transfer, rule mult_1_right)
   301 done
   302 
   303 instance star :: (comm_monoid_mult) comm_monoid_mult
   304 by (intro_classes, transfer, rule mult_1)
   305 
   306 instance star :: (cancel_semigroup_add) cancel_semigroup_add
   307 apply (intro_classes)
   308 apply (transfer, erule add_left_imp_eq)
   309 apply (transfer, erule add_right_imp_eq)
   310 done
   311 
   312 instance star :: (cancel_ab_semigroup_add) cancel_ab_semigroup_add
   313 by (intro_classes, transfer, rule add_imp_eq)
   314 
   315 instance star :: (ab_group_add) ab_group_add
   316 apply (intro_classes)
   317 apply (transfer, rule left_minus)
   318 apply (transfer, rule diff_minus)
   319 done
   320 
   321 instance star :: (pordered_ab_semigroup_add) pordered_ab_semigroup_add
   322 by (intro_classes, transfer, rule add_left_mono)
   323 
   324 instance star :: (pordered_cancel_ab_semigroup_add) pordered_cancel_ab_semigroup_add ..
   325 
   326 instance star :: (pordered_ab_semigroup_add_imp_le) pordered_ab_semigroup_add_imp_le
   327 by (intro_classes, transfer, rule add_le_imp_le_left)
   328 
   329 instance star :: (pordered_comm_monoid_add) pordered_comm_monoid_add ..
   330 instance star :: (pordered_ab_group_add) pordered_ab_group_add ..
   331 
   332 instance star :: (pordered_ab_group_add_abs) pordered_ab_group_add_abs 
   333   by intro_classes (transfer,
   334     simp add: abs_ge_self abs_leI abs_triangle_ineq)+
   335 
   336 instance star :: (ordered_cancel_ab_semigroup_add) ordered_cancel_ab_semigroup_add ..
   337 instance star :: (lordered_ab_group_add_meet) lordered_ab_group_add_meet ..
   338 instance star :: (lordered_ab_group_add_meet) lordered_ab_group_add_meet ..
   339 instance star :: (lordered_ab_group_add) lordered_ab_group_add ..
   340 
   341 instance star :: (lordered_ab_group_add_abs) lordered_ab_group_add_abs
   342 by (intro_classes, transfer, rule abs_lattice)
   343 
   344 subsection {* Ring and field classes *}
   345 
   346 instance star :: (semiring) semiring
   347 apply (intro_classes)
   348 apply (transfer, rule left_distrib)
   349 apply (transfer, rule right_distrib)
   350 done
   351 
   352 instance star :: (semiring_0) semiring_0 
   353 by intro_classes (transfer, simp)+
   354 
   355 instance star :: (semiring_0_cancel) semiring_0_cancel ..
   356 
   357 instance star :: (comm_semiring) comm_semiring 
   358 by (intro_classes, transfer, rule left_distrib)
   359 
   360 instance star :: (comm_semiring_0) comm_semiring_0 ..
   361 instance star :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
   362 
   363 instance star :: (zero_neq_one) zero_neq_one
   364 by (intro_classes, transfer, rule zero_neq_one)
   365 
   366 instance star :: (semiring_1) semiring_1 ..
   367 instance star :: (comm_semiring_1) comm_semiring_1 ..
   368 
   369 instance star :: (no_zero_divisors) no_zero_divisors
   370 by (intro_classes, transfer, rule no_zero_divisors)
   371 
   372 instance star :: (semiring_1_cancel) semiring_1_cancel ..
   373 instance star :: (comm_semiring_1_cancel) comm_semiring_1_cancel ..
   374 instance star :: (ring) ring ..
   375 instance star :: (comm_ring) comm_ring ..
   376 instance star :: (ring_1) ring_1 ..
   377 instance star :: (comm_ring_1) comm_ring_1 ..
   378 instance star :: (ring_no_zero_divisors) ring_no_zero_divisors ..
   379 instance star :: (ring_1_no_zero_divisors) ring_1_no_zero_divisors ..
   380 instance star :: (idom) idom .. 
   381 
   382 instance star :: (division_ring) division_ring
   383 apply (intro_classes)
   384 apply (transfer, erule left_inverse)
   385 apply (transfer, erule right_inverse)
   386 done
   387 
   388 instance star :: (field) field
   389 apply (intro_classes)
   390 apply (transfer, erule left_inverse)
   391 apply (transfer, rule divide_inverse)
   392 done
   393 
   394 instance star :: (division_by_zero) division_by_zero
   395 by (intro_classes, transfer, rule inverse_zero)
   396 
   397 instance star :: (pordered_semiring) pordered_semiring
   398 apply (intro_classes)
   399 apply (transfer, erule (1) mult_left_mono)
   400 apply (transfer, erule (1) mult_right_mono)
   401 done
   402 
   403 instance star :: (pordered_cancel_semiring) pordered_cancel_semiring ..
   404 
   405 instance star :: (ordered_semiring_strict) ordered_semiring_strict
   406 apply (intro_classes)
   407 apply (transfer, erule (1) mult_strict_left_mono)
   408 apply (transfer, erule (1) mult_strict_right_mono)
   409 done
   410 
   411 instance star :: (pordered_comm_semiring) pordered_comm_semiring
   412 by (intro_classes, transfer, rule mult_mono1_class.times_zero_less_eq_less.mult_mono1)
   413 
   414 instance star :: (pordered_cancel_comm_semiring) pordered_cancel_comm_semiring ..
   415 
   416 instance star :: (ordered_comm_semiring_strict) ordered_comm_semiring_strict
   417 by (intro_classes, transfer, rule ordered_comm_semiring_strict_class.plus_times_zero_less_eq_less.mult_strict_mono)
   418 
   419 instance star :: (pordered_ring) pordered_ring ..
   420 instance star :: (pordered_ring_abs) pordered_ring_abs
   421   by intro_classes  (transfer, rule abs_eq_mult)
   422 instance star :: (lordered_ring) lordered_ring ..
   423 
   424 instance star :: (abs_if) abs_if
   425 by (intro_classes, transfer, rule abs_if)
   426 
   427 instance star :: (sgn_if) sgn_if
   428 by (intro_classes, transfer, rule sgn_if)
   429 
   430 instance star :: (ordered_ring_strict) ordered_ring_strict ..
   431 instance star :: (pordered_comm_ring) pordered_comm_ring ..
   432 
   433 instance star :: (ordered_semidom) ordered_semidom
   434 by (intro_classes, transfer, rule zero_less_one)
   435 
   436 instance star :: (ordered_idom) ordered_idom ..
   437 instance star :: (ordered_field) ordered_field ..
   438 
   439 subsection {* Power classes *}
   440 
   441 text {*
   442   Proving the class axiom @{thm [source] power_Suc} for type
   443   @{typ "'a star"} is a little tricky, because it quantifies
   444   over values of type @{typ nat}. The transfer principle does
   445   not handle quantification over non-star types in general,
   446   but we can work around this by fixing an arbitrary @{typ nat}
   447   value, and then applying the transfer principle.
   448 *}
   449 
   450 instance star :: (recpower) recpower
   451 proof
   452   show "\<And>a::'a star. a ^ 0 = 1"
   453     by transfer (rule power_0)
   454 next
   455   fix n show "\<And>a::'a star. a ^ Suc n = a * a ^ n"
   456     by transfer (rule power_Suc)
   457 qed
   458 
   459 subsection {* Number classes *}
   460 
   461 lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
   462 by (induct n, simp_all)
   463 
   464 lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
   465 by (simp add: star_of_nat_def)
   466 
   467 lemma star_of_of_nat [simp]: "star_of (of_nat n) = of_nat n"
   468 by transfer (rule refl)
   469 
   470 lemma star_of_int_def [transfer_unfold]: "of_int z = star_of (of_int z)"
   471 by (rule_tac z=z in int_diff_cases, simp)
   472 
   473 lemma Standard_of_int [simp]: "of_int z \<in> Standard"
   474 by (simp add: star_of_int_def)
   475 
   476 lemma star_of_of_int [simp]: "star_of (of_int z) = of_int z"
   477 by transfer (rule refl)
   478 
   479 instance star :: (semiring_char_0) semiring_char_0
   480 by intro_classes (simp only: star_of_nat_def star_of_eq of_nat_eq_iff)
   481 
   482 instance star :: (ring_char_0) ring_char_0 ..
   483 
   484 instance star :: (number_ring) number_ring
   485 by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
   486 
   487 subsection {* Finite class *}
   488 
   489 lemma starset_finite: "finite A \<Longrightarrow> *s* A = star_of ` A"
   490 by (erule finite_induct, simp_all)
   491 
   492 instance star :: (finite) finite
   493 apply (intro_classes)
   494 apply (subst starset_UNIV [symmetric])
   495 apply (subst starset_finite [OF finite])
   496 apply (rule finite_imageI [OF finite])
   497 done
   498 
   499 end