398 by (simp add: rat_number_expand) |
398 by (simp add: rat_number_expand) |
399 |
399 |
400 |
400 |
401 subsubsection {* The ordered field of rational numbers *} |
401 subsubsection {* The ordered field of rational numbers *} |
402 |
402 |
403 instantiation rat :: linorder |
403 lift_definition positive :: "rat \<Rightarrow> bool" |
404 begin |
404 is "\<lambda>x. 0 < fst x * snd x" |
405 |
|
406 lift_definition less_eq_rat :: "rat \<Rightarrow> rat \<Rightarrow> bool" |
|
407 is "\<lambda>x y. (fst x * snd y) * (snd x * snd y) \<le> (fst y * snd x) * (snd x * snd y)" |
|
408 proof (clarsimp) |
405 proof (clarsimp) |
409 fix a b a' b' c d c' d'::int |
406 fix a b c d :: int |
410 assume neq: "b \<noteq> 0" "b' \<noteq> 0" "d \<noteq> 0" "d' \<noteq> 0" |
407 assume "b \<noteq> 0" and "d \<noteq> 0" and "a * d = c * b" |
411 assume eq1: "a * b' = a' * b" |
408 hence "a * d * b * d = c * b * b * d" |
412 assume eq2: "c * d' = c' * d" |
409 by simp |
413 |
410 hence "a * b * d\<twosuperior> = c * d * b\<twosuperior>" |
414 let ?le = "\<lambda>a b c d. ((a * d) * (b * d) \<le> (c * b) * (b * d))" |
411 unfolding power2_eq_square by (simp add: mult_ac) |
415 { |
412 hence "0 < a * b * d\<twosuperior> \<longleftrightarrow> 0 < c * d * b\<twosuperior>" |
416 fix a b c d x :: int assume x: "x \<noteq> 0" |
413 by simp |
417 have "?le a b c d = ?le (a * x) (b * x) c d" |
414 thus "0 < a * b \<longleftrightarrow> 0 < c * d" |
418 proof - |
415 using `b \<noteq> 0` and `d \<noteq> 0` |
419 from x have "0 < x * x" by (auto simp add: zero_less_mult_iff) |
416 by (simp add: zero_less_mult_iff) |
420 hence "?le a b c d = |
417 qed |
421 ((a * d) * (b * d) * (x * x) \<le> (c * b) * (b * d) * (x * x))" |
418 |
422 by (simp add: mult_le_cancel_right) |
419 lemma positive_zero: "\<not> positive 0" |
423 also have "... = ?le (a * x) (b * x) c d" |
420 by transfer simp |
424 by (simp add: mult_ac) |
421 |
425 finally show ?thesis . |
422 lemma positive_add: |
426 qed |
423 "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x + y)" |
427 } note le_factor = this |
424 apply transfer |
428 |
425 apply (simp add: zero_less_mult_iff) |
429 let ?D = "b * d" and ?D' = "b' * d'" |
426 apply (elim disjE, simp_all add: add_pos_pos add_neg_neg |
430 from neq have D: "?D \<noteq> 0" by simp |
427 mult_pos_pos mult_pos_neg mult_neg_pos mult_neg_neg) |
431 from neq have "?D' \<noteq> 0" by simp |
428 done |
432 hence "?le a b c d = ?le (a * ?D') (b * ?D') c d" |
429 |
433 by (rule le_factor) |
430 lemma positive_mult: |
434 also have "... = ((a * b') * ?D * ?D' * d * d' \<le> (c * d') * ?D * ?D' * b * b')" |
431 "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x * y)" |
435 by (simp add: mult_ac) |
432 by transfer (drule (1) mult_pos_pos, simp add: mult_ac) |
436 also have "... = ((a' * b) * ?D * ?D' * d * d' \<le> (c' * d) * ?D * ?D' * b * b')" |
433 |
437 by (simp only: eq1 eq2) |
434 lemma positive_minus: |
438 also have "... = ?le (a' * ?D) (b' * ?D) c' d'" |
435 "\<not> positive x \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> positive (- x)" |
439 by (simp add: mult_ac) |
436 by transfer (force simp: neq_iff zero_less_mult_iff mult_less_0_iff) |
440 also from D have "... = ?le a' b' c' d'" |
437 |
441 by (rule le_factor [symmetric]) |
438 instantiation rat :: linordered_field_inverse_zero |
442 finally show "?le a b c d = ?le a' b' c' d'" . |
439 begin |
443 qed |
440 |
|
441 definition |
|
442 "x < y \<longleftrightarrow> positive (y - x)" |
|
443 |
|
444 definition |
|
445 "x \<le> (y::rat) \<longleftrightarrow> x < y \<or> x = y" |
|
446 |
|
447 definition |
|
448 "abs (a::rat) = (if a < 0 then - a else a)" |
|
449 |
|
450 definition |
|
451 "sgn (a::rat) = (if a = 0 then 0 else if 0 < a then 1 else - 1)" |
|
452 |
|
453 instance proof |
|
454 fix a b c :: rat |
|
455 show "\<bar>a\<bar> = (if a < 0 then - a else a)" |
|
456 by (rule abs_rat_def) |
|
457 show "a < b \<longleftrightarrow> a \<le> b \<and> \<not> b \<le> a" |
|
458 unfolding less_eq_rat_def less_rat_def |
|
459 by (auto, drule (1) positive_add, simp_all add: positive_zero) |
|
460 show "a \<le> a" |
|
461 unfolding less_eq_rat_def by simp |
|
462 show "a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> a \<le> c" |
|
463 unfolding less_eq_rat_def less_rat_def |
|
464 by (auto, drule (1) positive_add, simp add: algebra_simps) |
|
465 show "a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> a = b" |
|
466 unfolding less_eq_rat_def less_rat_def |
|
467 by (auto, drule (1) positive_add, simp add: positive_zero) |
|
468 show "a \<le> b \<Longrightarrow> c + a \<le> c + b" |
|
469 unfolding less_eq_rat_def less_rat_def by (auto simp: diff_minus) |
|
470 show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)" |
|
471 by (rule sgn_rat_def) |
|
472 show "a \<le> b \<or> b \<le> a" |
|
473 unfolding less_eq_rat_def less_rat_def |
|
474 by (auto dest!: positive_minus) |
|
475 show "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b" |
|
476 unfolding less_rat_def |
|
477 by (drule (1) positive_mult, simp add: algebra_simps) |
|
478 qed |
|
479 |
|
480 end |
|
481 |
|
482 instantiation rat :: distrib_lattice |
|
483 begin |
|
484 |
|
485 definition |
|
486 "(inf :: rat \<Rightarrow> rat \<Rightarrow> rat) = min" |
|
487 |
|
488 definition |
|
489 "(sup :: rat \<Rightarrow> rat \<Rightarrow> rat) = max" |
|
490 |
|
491 instance proof |
|
492 qed (auto simp add: inf_rat_def sup_rat_def min_max.sup_inf_distrib1) |
|
493 |
|
494 end |
|
495 |
|
496 lemma positive_rat: "positive (Fract a b) \<longleftrightarrow> 0 < a * b" |
|
497 by transfer simp |
|
498 |
|
499 lemma less_rat [simp]: |
|
500 assumes "b \<noteq> 0" and "d \<noteq> 0" |
|
501 shows "Fract a b < Fract c d \<longleftrightarrow> (a * d) * (b * d) < (c * b) * (b * d)" |
|
502 using assms unfolding less_rat_def |
|
503 by (simp add: positive_rat algebra_simps) |
444 |
504 |
445 lemma le_rat [simp]: |
505 lemma le_rat [simp]: |
446 assumes "b \<noteq> 0" and "d \<noteq> 0" |
506 assumes "b \<noteq> 0" and "d \<noteq> 0" |
447 shows "Fract a b \<le> Fract c d \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)" |
507 shows "Fract a b \<le> Fract c d \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)" |
448 using assms by transfer simp |
508 using assms unfolding le_less by (simp add: eq_rat) |
449 |
|
450 definition |
|
451 less_rat_def: "z < (w::rat) \<longleftrightarrow> z \<le> w \<and> z \<noteq> w" |
|
452 |
|
453 lemma less_rat [simp]: |
|
454 assumes "b \<noteq> 0" and "d \<noteq> 0" |
|
455 shows "Fract a b < Fract c d \<longleftrightarrow> (a * d) * (b * d) < (c * b) * (b * d)" |
|
456 using assms by (simp add: less_rat_def eq_rat order_less_le) |
|
457 |
|
458 instance proof |
|
459 fix q r s :: rat |
|
460 { |
|
461 assume "q \<le> r" and "r \<le> s" |
|
462 then show "q \<le> s" |
|
463 proof (induct q, induct r, induct s) |
|
464 fix a b c d e f :: int |
|
465 assume neq: "b > 0" "d > 0" "f > 0" |
|
466 assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract e f" |
|
467 show "Fract a b \<le> Fract e f" |
|
468 proof - |
|
469 from neq obtain bb: "0 < b * b" and dd: "0 < d * d" and ff: "0 < f * f" |
|
470 by (auto simp add: zero_less_mult_iff linorder_neq_iff) |
|
471 have "(a * d) * (b * d) * (f * f) \<le> (c * b) * (b * d) * (f * f)" |
|
472 proof - |
|
473 from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)" |
|
474 by simp |
|
475 with ff show ?thesis by (simp add: mult_le_cancel_right) |
|
476 qed |
|
477 also have "... = (c * f) * (d * f) * (b * b)" by algebra |
|
478 also have "... \<le> (e * d) * (d * f) * (b * b)" |
|
479 proof - |
|
480 from neq 2 have "(c * f) * (d * f) \<le> (e * d) * (d * f)" |
|
481 by simp |
|
482 with bb show ?thesis by (simp add: mult_le_cancel_right) |
|
483 qed |
|
484 finally have "(a * f) * (b * f) * (d * d) \<le> e * b * (b * f) * (d * d)" |
|
485 by (simp only: mult_ac) |
|
486 with dd have "(a * f) * (b * f) \<le> (e * b) * (b * f)" |
|
487 by (simp add: mult_le_cancel_right) |
|
488 with neq show ?thesis by simp |
|
489 qed |
|
490 qed |
|
491 next |
|
492 assume "q \<le> r" and "r \<le> q" |
|
493 then show "q = r" |
|
494 proof (induct q, induct r) |
|
495 fix a b c d :: int |
|
496 assume neq: "b > 0" "d > 0" |
|
497 assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract a b" |
|
498 show "Fract a b = Fract c d" |
|
499 proof - |
|
500 from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)" |
|
501 by simp |
|
502 also have "... \<le> (a * d) * (b * d)" |
|
503 proof - |
|
504 from neq 2 have "(c * b) * (d * b) \<le> (a * d) * (d * b)" |
|
505 by simp |
|
506 thus ?thesis by (simp only: mult_ac) |
|
507 qed |
|
508 finally have "(a * d) * (b * d) = (c * b) * (b * d)" . |
|
509 moreover from neq have "b * d \<noteq> 0" by simp |
|
510 ultimately have "a * d = c * b" by simp |
|
511 with neq show ?thesis by (simp add: eq_rat) |
|
512 qed |
|
513 qed |
|
514 next |
|
515 show "q \<le> q" |
|
516 by (induct q) simp |
|
517 show "(q < r) = (q \<le> r \<and> \<not> r \<le> q)" |
|
518 by (induct q, induct r) (auto simp add: le_less mult_commute) |
|
519 show "q \<le> r \<or> r \<le> q" |
|
520 by (induct q, induct r) |
|
521 (simp add: mult_commute, rule linorder_linear) |
|
522 } |
|
523 qed |
|
524 |
|
525 end |
|
526 |
|
527 instantiation rat :: "{distrib_lattice, abs_if, sgn_if}" |
|
528 begin |
|
529 |
|
530 definition |
|
531 abs_rat_def: "\<bar>q\<bar> = (if q < 0 then -q else (q::rat))" |
|
532 |
509 |
533 lemma abs_rat [simp, code]: "\<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>" |
510 lemma abs_rat [simp, code]: "\<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>" |
534 by (auto simp add: abs_rat_def zabs_def Zero_rat_def not_less le_less eq_rat zero_less_mult_iff) |
511 by (auto simp add: abs_rat_def zabs_def Zero_rat_def not_less le_less eq_rat zero_less_mult_iff) |
535 |
|
536 definition |
|
537 sgn_rat_def: "sgn (q::rat) = (if q = 0 then 0 else if 0 < q then 1 else - 1)" |
|
538 |
512 |
539 lemma sgn_rat [simp, code]: "sgn (Fract a b) = of_int (sgn a * sgn b)" |
513 lemma sgn_rat [simp, code]: "sgn (Fract a b) = of_int (sgn a * sgn b)" |
540 unfolding Fract_of_int_eq |
514 unfolding Fract_of_int_eq |
541 by (auto simp: zsgn_def sgn_rat_def Zero_rat_def eq_rat) |
515 by (auto simp: zsgn_def sgn_rat_def Zero_rat_def eq_rat) |
542 (auto simp: rat_number_collapse not_less le_less zero_less_mult_iff) |
516 (auto simp: rat_number_collapse not_less le_less zero_less_mult_iff) |
543 |
|
544 definition |
|
545 "(inf \<Colon> rat \<Rightarrow> rat \<Rightarrow> rat) = min" |
|
546 |
|
547 definition |
|
548 "(sup \<Colon> rat \<Rightarrow> rat \<Rightarrow> rat) = max" |
|
549 |
|
550 instance by intro_classes |
|
551 (auto simp add: abs_rat_def sgn_rat_def min_max.sup_inf_distrib1 inf_rat_def sup_rat_def) |
|
552 |
|
553 end |
|
554 |
|
555 instance rat :: linordered_field_inverse_zero |
|
556 proof |
|
557 fix q r s :: rat |
|
558 show "q \<le> r ==> s + q \<le> s + r" |
|
559 proof (induct q, induct r, induct s) |
|
560 fix a b c d e f :: int |
|
561 assume neq: "b > 0" "d > 0" "f > 0" |
|
562 assume le: "Fract a b \<le> Fract c d" |
|
563 show "Fract e f + Fract a b \<le> Fract e f + Fract c d" |
|
564 proof - |
|
565 let ?F = "f * f" from neq have F: "0 < ?F" |
|
566 by (auto simp add: zero_less_mult_iff) |
|
567 from neq le have "(a * d) * (b * d) \<le> (c * b) * (b * d)" |
|
568 by simp |
|
569 with F have "(a * d) * (b * d) * ?F * ?F \<le> (c * b) * (b * d) * ?F * ?F" |
|
570 by (simp add: mult_le_cancel_right) |
|
571 with neq show ?thesis by (simp add: mult_ac int_distrib) |
|
572 qed |
|
573 qed |
|
574 show "q < r ==> 0 < s ==> s * q < s * r" |
|
575 proof (induct q, induct r, induct s) |
|
576 fix a b c d e f :: int |
|
577 assume neq: "b > 0" "d > 0" "f > 0" |
|
578 assume le: "Fract a b < Fract c d" |
|
579 assume gt: "0 < Fract e f" |
|
580 show "Fract e f * Fract a b < Fract e f * Fract c d" |
|
581 proof - |
|
582 let ?E = "e * f" and ?F = "f * f" |
|
583 from neq gt have "0 < ?E" |
|
584 by (auto simp add: Zero_rat_def order_less_le eq_rat) |
|
585 moreover from neq have "0 < ?F" |
|
586 by (auto simp add: zero_less_mult_iff) |
|
587 moreover from neq le have "(a * d) * (b * d) < (c * b) * (b * d)" |
|
588 by simp |
|
589 ultimately have "(a * d) * (b * d) * ?E * ?F < (c * b) * (b * d) * ?E * ?F" |
|
590 by (simp add: mult_less_cancel_right) |
|
591 with neq show ?thesis |
|
592 by (simp add: mult_ac) |
|
593 qed |
|
594 qed |
|
595 qed auto |
|
596 |
517 |
597 lemma Rat_induct_pos [case_names Fract, induct type: rat]: |
518 lemma Rat_induct_pos [case_names Fract, induct type: rat]: |
598 assumes step: "\<And>a b. 0 < b \<Longrightarrow> P (Fract a b)" |
519 assumes step: "\<And>a b. 0 < b \<Longrightarrow> P (Fract a b)" |
599 shows "P q" |
520 shows "P q" |
600 proof (cases q) |
521 proof (cases q) |