# HG changeset patch # User paulson # Date 1745749264 -3600 # Node ID 0af7fe946bfd9543697a6736ce244f1b2e004060 # Parent a151c934824cce83e0aec762b1d7e1af686ce5c8# Parent 88043331f1662f8196be3bfd70779d5ee8106403 merged diff -r a151c934824c -r 0af7fe946bfd src/HOL/Orderings.thy --- a/src/HOL/Orderings.thy Sat Apr 26 21:33:48 2025 +0200 +++ b/src/HOL/Orderings.thy Sun Apr 27 11:21:04 2025 +0100 @@ -1307,6 +1307,9 @@ class unbounded_dense_linorder = dense_linorder + no_top + no_bot +class unbounded_dense_order = dense_order + no_top + no_bot + +instance unbounded_dense_linorder \ unbounded_dense_order .. subsection \Wellorders\ diff -r a151c934824c -r 0af7fe946bfd src/HOL/Rat.thy --- a/src/HOL/Rat.thy Sat Apr 26 21:33:48 2025 +0200 +++ b/src/HOL/Rat.thy Sun Apr 27 11:21:04 2025 +0100 @@ -463,12 +463,11 @@ lemma positive_add: "positive x \ positive y \ positive (x + y)" apply transfer - apply (auto simp add: zero_less_mult_iff add_pos_pos add_neg_neg mult_pos_neg mult_neg_pos mult_neg_neg) - done + by (metis add_neg_neg fst_eqD mult_less_0_iff pos_add_strict snd_eqD zero_less_mult_iff) lemma positive_mult: "positive x \ positive y \ positive (x * y)" apply transfer - by (metis fst_conv mult.commute mult_pos_neg2 snd_conv zero_less_mult_iff) + by (metis mult_less_0_iff split_pairs zero_less_mult_iff) lemma positive_minus: "\ positive x \ x \ 0 \ positive (- x)" by transfer (auto simp: neq_iff zero_less_mult_iff mult_less_0_iff) diff -r a151c934824c -r 0af7fe946bfd src/HOL/Rings.thy --- a/src/HOL/Rings.thy Sat Apr 26 21:33:48 2025 +0200 +++ b/src/HOL/Rings.thy Sun Apr 27 11:21:04 2025 +0100 @@ -1953,6 +1953,21 @@ end +class ordered_semiring_1 = ordered_semiring + semiring_1 + zero_neq_one +begin + +lemma convex_bound_le: + assumes "x \ a" and "y \ a" and "0 \ u" and "0 \ v" and "u + v = 1" + shows "u * x + v * y \ a" +proof- + from assms have "u * x + v * y \ u * a + v * a" + by (simp add: add_mono mult_left_mono) + with assms show ?thesis + unfolding distrib_right[symmetric] by simp +qed + +end + class ordered_cancel_semiring = ordered_semiring + cancel_comm_monoid_add begin @@ -1991,6 +2006,77 @@ end + +class ordered_semiring_strict = semiring + comm_monoid_add + ordered_cancel_ab_semigroup_add + + assumes mult_strict_left_mono: "a < b \ 0 < c \ c * a < c * b" + assumes mult_strict_right_mono: "a < b \ 0 < c \ a * c < b * c" +begin + +subclass semiring_0_cancel .. + +subclass ordered_semiring +proof + fix a b c :: 'a + assume \
: "a \ b" "0 \ c" + thus "c * a \ c * b" + unfolding le_less + using mult_strict_left_mono by (cases "c = 0") auto + show "a * c \ b * c" + using \
by (force simp: le_less intro: mult_strict_right_mono dest: sym) +qed + +lemma mult_pos_pos[simp]: "0 < a \ 0 < b \ 0 < a * b" + using mult_strict_left_mono [of 0 b a] by simp + +lemma mult_pos_neg: "0 < a \ b < 0 \ a * b < 0" + using mult_strict_left_mono [of b 0 a] by simp + +lemma mult_neg_pos: "a < 0 \ 0 < b \ a * b < 0" + using mult_strict_right_mono [of a 0 b] by simp + +text \Strict monotonicity in both arguments\ +lemma mult_strict_mono: + assumes "a < b" "c < d" "0 < b" "0 \ c" + shows "a * c < b * d" +proof- + have "a * c \ b * c" + using assms by (intro mult_right_mono) auto + also have "... < b * d" + using assms by (intro mult_strict_left_mono) auto + finally show ?thesis . +qed + + +text \This weaker variant has more natural premises\ +lemma mult_strict_mono': + assumes "a < b" and "c < d" and "0 \ a" and "0 \ c" + shows "a * c < b * d" + using assms by (intro mult_strict_mono) auto + +lemma mult_less_le_imp_less: + assumes "a < b" "c \ d" "0 \ a" "0 < c" + shows "a * c < b * d" +proof- + have "a * c < b * c" + using assms by (intro mult_strict_right_mono) auto + also have "... \ b * d" + using assms by (intro mult_left_mono) auto + finally show ?thesis . +qed + +lemma mult_le_less_imp_less: + assumes "a \ b" and "c < d" and "0 < a" and "0 \ c" + shows "a * c < b * d" +proof- + have "a * c \ b * c" + using assms by (intro mult_right_mono) auto + also have "... < b * d" + using assms by (intro mult_strict_left_mono) auto + finally show ?thesis . +qed + +end + class linordered_semiring_1 = linordered_semiring + semiring_1 + zero_less_one begin @@ -2005,6 +2091,8 @@ qed end + +subclass (in linordered_semiring_1) ordered_semiring_1 .. class linordered_semiring_strict = semiring + comm_monoid_add + linordered_cancel_ab_semigroup_add + assumes mult_strict_left_mono: "a < b \ 0 < c \ c * a < c * b" @@ -2025,25 +2113,15 @@ using mult_strict_right_mono by (cases "c = 0") auto qed +subclass (in linordered_semiring_strict) ordered_semiring_strict +proof qed (auto simp: mult_strict_left_mono mult_strict_right_mono) + lemma mult_left_le_imp_le: "c * a \ c * b \ 0 < c \ a \ b" - by (auto simp add: mult_strict_left_mono _not_less [symmetric]) + by (auto simp add: mult_strict_left_mono simp flip: not_less) lemma mult_right_le_imp_le: "a * c \ b * c \ 0 < c \ a \ b" by (auto simp add: mult_strict_right_mono not_less [symmetric]) -lemma mult_pos_pos[simp]: "0 < a \ 0 < b \ 0 < a * b" - using mult_strict_left_mono [of 0 b a] by simp - -lemma mult_pos_neg: "0 < a \ b < 0 \ a * b < 0" - using mult_strict_left_mono [of b 0 a] by simp - -lemma mult_neg_pos: "a < 0 \ 0 < b \ a * b < 0" - using mult_strict_right_mono [of a 0 b] by simp - -text \Legacy -- use @{thm [source] mult_neg_pos}.\ -lemma mult_pos_neg2: "0 < a \ b < 0 \ b * a < 0" - by (drule mult_strict_right_mono [of b 0]) auto - lemma zero_less_mult_pos: assumes "0 < a * b" "0 < a" shows "0 < b" proof (cases "b \ 0") @@ -2052,60 +2130,14 @@ using assms by (auto simp: le_less dest: less_not_sym mult_pos_neg [of a b]) qed (auto simp add: le_less not_less) - lemma zero_less_mult_pos2: assumes "0 < b * a" "0 < a" shows "0 < b" proof (cases "b \ 0") case True then show ?thesis - using assms by (auto simp: le_less dest: less_not_sym mult_pos_neg2 [of a b]) + using assms by (auto simp: le_less dest: less_not_sym mult_neg_pos) qed (auto simp add: le_less not_less) -text \Strict monotonicity in both arguments\ -lemma mult_strict_mono: - assumes "a < b" "c < d" "0 < b" "0 \ c" - shows "a * c < b * d" -proof (cases "c = 0") - case True - with assms show ?thesis - by simp -next - case False - with assms have "a*c < b*c" - by (simp add: mult_strict_right_mono [OF \a < b\]) - also have "\ < b*d" - by (simp add: assms mult_strict_left_mono) - finally show ?thesis . -qed - -text \This weaker variant has more natural premises\ -lemma mult_strict_mono': - assumes "a < b" and "c < d" and "0 \ a" and "0 \ c" - shows "a * c < b * d" - using assms by (auto simp add: mult_strict_mono) - -lemma mult_less_le_imp_less: - assumes "a < b" and "c \ d" and "0 \ a" and "0 < c" - shows "a * c < b * d" -proof - - have "a * c < b * c" - by (simp add: assms mult_strict_right_mono) - also have "... \ b * d" - by (intro mult_left_mono) (use assms in auto) - finally show ?thesis . -qed - -lemma mult_le_less_imp_less: - assumes "a \ b" and "c < d" and "0 < a" and "0 \ c" - shows "a * c < b * d" -proof - - have "a * c \ b * c" - by (simp add: assms mult_right_mono) - also have "... < b * d" - by (intro mult_strict_left_mono) (use assms in auto) - finally show ?thesis . -qed - end class linordered_semiring_1_strict = linordered_semiring_strict + semiring_1 + zero_less_one @@ -2125,6 +2157,26 @@ end +class ordered_semiring_1_strict = ordered_semiring_strict + semiring_1 + \ \analogous to \<^class>\linordered_semiring_1_strict\ not requiring a total order\ +begin + +subclass ordered_semiring_1 .. + +lemma convex_bound_lt: + assumes "x < a" and "y < a" and "0 \ u" and "0 \ v" and "u + v = 1" + shows "u * x + v * y < a" +proof - + from assms have "u * x + v * y < u * a + v * a" + by (cases "u = 0") (auto intro!: add_less_le_mono mult_strict_left_mono mult_left_mono) + with assms show ?thesis + unfolding distrib_right[symmetric] by simp +qed + +end + +subclass (in linordered_semiring_1_strict) ordered_semiring_1_strict .. + class ordered_comm_semiring = comm_semiring_0 + ordered_ab_semigroup_add + assumes comm_mult_left_mono: "a \ b \ 0 \ c \ c * a \ c * b" begin @@ -2173,6 +2225,35 @@ end +class ordered_comm_semiring_strict = comm_semiring_0 + ordered_cancel_ab_semigroup_add + + \ \analogous to \<^class>\linordered_comm_semiring_strict\ not requiring a total order\ + assumes comm_mult_strict_left_mono: "a < b \ 0 < c \ c * a < c * b" +begin + +subclass ordered_semiring_strict +proof + fix a b c :: 'a + assume "a < b" and "0 < c" + thus "c * a < c * b" + by (rule comm_mult_strict_left_mono) + thus "a * c < b * c" + by (simp only: mult.commute) +qed + +subclass ordered_cancel_comm_semiring +proof + fix a b c :: 'a + assume "a \ b" and "0 \ c" + thus "c * a \ c * b" + unfolding le_less + using mult_strict_left_mono by (cases "c = 0") auto +qed + +end + +subclass (in linordered_comm_semiring_strict) ordered_comm_semiring_strict +proof qed (simp add: local.mult_strict_left_mono) + class ordered_ring = ring + ordered_cancel_semiring begin diff -r a151c934824c -r 0af7fe946bfd src/HOL/Transcendental.thy --- a/src/HOL/Transcendental.thy Sat Apr 26 21:33:48 2025 +0200 +++ b/src/HOL/Transcendental.thy Sun Apr 27 11:21:04 2025 +0100 @@ -4339,7 +4339,8 @@ using sin_gt_zero by auto then have "cos x - cos y < 0" unfolding cos_diff minus_mult_commute[symmetric] - using \- (x - y) < 0\ by (rule mult_pos_neg2) + using \- (x - y) < 0\ + using mult_neg_pos by blast then show ?thesis by auto qed