src/HOL/OrderedGroup.thy
changeset 21312 1d39091a3208
parent 21245 23e6eb4d0975
child 21328 73bb86d0f483
equal deleted inserted replaced
21311:3556301c18cd 21312:1d39091a3208
   571 
   571 
   572 axclass lordered_ab_group_join < pordered_ab_group_add, join_semilorder
   572 axclass lordered_ab_group_join < pordered_ab_group_add, join_semilorder
   573 
   573 
   574 lemma add_meet_distrib_left: "a + (meet b c) = meet (a + b) (a + (c::'a::{pordered_ab_group_add, meet_semilorder}))"
   574 lemma add_meet_distrib_left: "a + (meet b c) = meet (a + b) (a + (c::'a::{pordered_ab_group_add, meet_semilorder}))"
   575 apply (rule order_antisym)
   575 apply (rule order_antisym)
   576 apply (rule meet_imp_le, simp_all add: meet_join_le)
   576 apply (simp_all add: le_meetI)
   577 apply (rule add_le_imp_le_left [of "-a"])
   577 apply (rule add_le_imp_le_left [of "-a"])
   578 apply (simp only: add_assoc[symmetric], simp)
   578 apply (simp only: add_assoc[symmetric], simp)
   579 apply (rule meet_imp_le)
   579 apply rule
   580 apply (rule add_le_imp_le_left[of "a"], simp only: add_assoc[symmetric], simp add: meet_join_le)+
   580 apply (rule add_le_imp_le_left[of "a"], simp only: add_assoc[symmetric], simp)+
   581 done
   581 done
   582 
   582 
   583 lemma add_join_distrib_left: "a + (join b c) = join (a + b) (a+ (c::'a::{pordered_ab_group_add, join_semilorder}))" 
   583 lemma add_join_distrib_left: "a + (join b c) = join (a + b) (a+ (c::'a::{pordered_ab_group_add, join_semilorder}))" 
   584 apply (rule order_antisym)
   584 apply (rule order_antisym)
   585 apply (rule add_le_imp_le_left [of "-a"])
   585 apply (rule add_le_imp_le_left [of "-a"])
   586 apply (simp only: add_assoc[symmetric], simp)
   586 apply (simp only: add_assoc[symmetric], simp)
   587 apply (rule join_imp_le)
   587 apply rule
   588 apply (rule add_le_imp_le_left [of "a"], simp only: add_assoc[symmetric], simp add: meet_join_le)+
   588 apply (rule add_le_imp_le_left [of "a"], simp only: add_assoc[symmetric], simp)+
   589 apply (rule join_imp_le)
   589 apply (rule join_leI)
   590 apply (simp_all add: meet_join_le)
   590 apply (simp_all)
   591 done
   591 done
   592 
   592 
   593 lemma is_join_neg_meet: "is_join (% (a::'a::{pordered_ab_group_add, meet_semilorder}) b. - (meet (-a) (-b)))"
   593 lemma is_join_neg_meet: "is_join (% (a::'a::{pordered_ab_group_add, meet_semilorder}) b. - (meet (-a) (-b)))"
   594 apply (auto simp add: is_join_def)
   594 apply (auto simp add: is_join_def)
   595 apply (rule_tac c="meet (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_meet_distrib_left meet_join_le)
   595 apply (rule_tac c="meet (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_meet_distrib_left)
   596 apply (rule_tac c="meet (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_meet_distrib_left meet_join_le)
   596 apply (rule_tac c="meet (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_meet_distrib_left)
   597 apply (subst neg_le_iff_le[symmetric]) 
   597 apply (subst neg_le_iff_le[symmetric]) 
   598 apply (simp add: meet_imp_le)
   598 apply (simp add: le_meetI)
   599 done
   599 done
   600 
   600 
   601 lemma is_meet_neg_join: "is_meet (% (a::'a::{pordered_ab_group_add, join_semilorder}) b. - (join (-a) (-b)))"
   601 lemma is_meet_neg_join: "is_meet (% (a::'a::{pordered_ab_group_add, join_semilorder}) b. - (join (-a) (-b)))"
   602 apply (auto simp add: is_meet_def)
   602 apply (auto simp add: is_meet_def)
   603 apply (rule_tac c="join (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_join_distrib_left meet_join_le)
   603 apply (rule_tac c="join (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_join_distrib_left)
   604 apply (rule_tac c="join (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_join_distrib_left meet_join_le)
   604 apply (rule_tac c="join (-a) (-b)" in add_le_imp_le_right, simp, simp add: add_join_distrib_left)
   605 apply (subst neg_le_iff_le[symmetric]) 
   605 apply (subst neg_le_iff_le[symmetric]) 
   606 apply (simp add: join_imp_le)
   606 apply (simp add: join_leI)
   607 done
   607 done
   608 
   608 
   609 axclass lordered_ab_group \<subseteq> pordered_ab_group_add, lorder
   609 axclass lordered_ab_group \<subseteq> pordered_ab_group_add, lorder
   610 
   610 
   611 instance lordered_ab_group_meet \<subseteq> lordered_ab_group
   611 instance lordered_ab_group_meet \<subseteq> lordered_ab_group
   662 
   662 
   663 lemma prts: "a = pprt a + nprt a"
   663 lemma prts: "a = pprt a + nprt a"
   664 by (simp add: pprt_def nprt_def add_eq_meet_join[symmetric])
   664 by (simp add: pprt_def nprt_def add_eq_meet_join[symmetric])
   665 
   665 
   666 lemma zero_le_pprt[simp]: "0 \<le> pprt a"
   666 lemma zero_le_pprt[simp]: "0 \<le> pprt a"
   667 by (simp add: pprt_def meet_join_le)
   667 by (simp add: pprt_def)
   668 
   668 
   669 lemma nprt_le_zero[simp]: "nprt a \<le> 0"
   669 lemma nprt_le_zero[simp]: "nprt a \<le> 0"
   670 by (simp add: nprt_def meet_join_le)
   670 by (simp add: nprt_def)
   671 
   671 
   672 lemma le_eq_neg: "(a \<le> -b) = (a + b \<le> (0::_::lordered_ab_group))" (is "?l = ?r")
   672 lemma le_eq_neg: "(a \<le> -b) = (a + b \<le> (0::_::lordered_ab_group))" (is "?l = ?r")
   673 proof -
   673 proof -
   674   have a: "?l \<longrightarrow> ?r"
   674   have a: "?l \<longrightarrow> ?r"
   675     apply (auto)
   675     apply (auto)
   792   show ?thesis by (simp add: abs_lattice join_eq_if)
   792   show ?thesis by (simp add: abs_lattice join_eq_if)
   793 qed
   793 qed
   794 
   794 
   795 lemma abs_ge_zero[simp]: "0 \<le> abs (a::'a::lordered_ab_group_abs)"
   795 lemma abs_ge_zero[simp]: "0 \<le> abs (a::'a::lordered_ab_group_abs)"
   796 proof -
   796 proof -
   797   have a:"a <= abs a" and b:"-a <= abs a" by (auto simp add: abs_lattice meet_join_le)
   797   have a:"a <= abs a" and b:"-a <= abs a" by (auto simp add: abs_lattice)
   798   show ?thesis by (rule add_mono[OF a b, simplified])
   798   show ?thesis by (rule add_mono[OF a b, simplified])
   799 qed
   799 qed
   800   
   800   
   801 lemma abs_le_zero_iff [simp]: "(abs a \<le> (0::'a::lordered_ab_group_abs)) = (a = 0)" 
   801 lemma abs_le_zero_iff [simp]: "(abs a \<le> (0::'a::lordered_ab_group_abs)) = (a = 0)" 
   802 proof
   802 proof
   816   have a:"!! x (y::_::order). x <= y \<Longrightarrow> ~(y < x)" by auto
   816   have a:"!! x (y::_::order). x <= y \<Longrightarrow> ~(y < x)" by auto
   817   show ?thesis by (simp add: a)
   817   show ?thesis by (simp add: a)
   818 qed
   818 qed
   819 
   819 
   820 lemma abs_ge_self: "a \<le> abs (a::'a::lordered_ab_group_abs)"
   820 lemma abs_ge_self: "a \<le> abs (a::'a::lordered_ab_group_abs)"
   821 by (simp add: abs_lattice meet_join_le)
   821 by (simp add: abs_lattice)
   822 
   822 
   823 lemma abs_ge_minus_self: "-a \<le> abs (a::'a::lordered_ab_group_abs)"
   823 lemma abs_ge_minus_self: "-a \<le> abs (a::'a::lordered_ab_group_abs)"
   824 by (simp add: abs_lattice meet_join_le)
   824 by (simp add: abs_lattice)
   825 
       
   826 lemma le_imp_join_eq: "a \<le> b \<Longrightarrow> join a b = b" 
       
   827 by (simp add: le_def_join)
       
   828 
       
   829 lemma ge_imp_join_eq: "b \<le> a \<Longrightarrow> join a b = a"
       
   830 by (simp add: le_def_join join_aci)
       
   831 
       
   832 lemma le_imp_meet_eq: "a \<le> b \<Longrightarrow> meet a b = a"
       
   833 by (simp add: le_def_meet)
       
   834 
       
   835 lemma ge_imp_meet_eq: "b \<le> a \<Longrightarrow> meet a b = b"
       
   836 by (simp add: le_def_meet meet_aci)
       
   837 
   825 
   838 lemma abs_prts: "abs (a::_::lordered_ab_group_abs) = pprt a - nprt a"
   826 lemma abs_prts: "abs (a::_::lordered_ab_group_abs) = pprt a - nprt a"
   839 apply (simp add: pprt_def nprt_def diff_minus)
   827 apply (simp add: pprt_def nprt_def diff_minus)
   840 apply (simp add: add_meet_join_distribs join_aci abs_lattice[symmetric])
   828 apply (simp add: add_meet_join_distribs join_aci abs_lattice[symmetric])
   841 apply (subst le_imp_join_eq, auto)
   829 apply (subst join_absorp2, auto)
   842 done
   830 done
   843 
   831 
   844 lemma abs_minus_cancel [simp]: "abs (-a) = abs(a::'a::lordered_ab_group_abs)"
   832 lemma abs_minus_cancel [simp]: "abs (-a) = abs(a::'a::lordered_ab_group_abs)"
   845 by (simp add: abs_lattice join_comm)
   833 by (simp add: abs_lattice join_comm)
   846 
   834 
   847 lemma abs_idempotent [simp]: "abs (abs a) = abs (a::'a::lordered_ab_group_abs)"
   835 lemma abs_idempotent [simp]: "abs (abs a) = abs (a::'a::lordered_ab_group_abs)"
   848 apply (simp add: abs_lattice[of "abs a"])
   836 apply (simp add: abs_lattice[of "abs a"])
   849 apply (subst ge_imp_join_eq)
   837 apply (subst join_absorp1)
   850 apply (rule order_trans[of _ 0])
   838 apply (rule order_trans[of _ 0])
   851 by auto
   839 by auto
   852 
   840 
   853 lemma abs_minus_commute: 
   841 lemma abs_minus_commute: 
   854   fixes a :: "'a::lordered_ab_group_abs"
   842   fixes a :: "'a::lordered_ab_group_abs"
   898 lemma abs_of_neg: "(x::'a::lordered_ab_group_abs) <  0 ==> 
   886 lemma abs_of_neg: "(x::'a::lordered_ab_group_abs) <  0 ==> 
   899   abs x = - x"
   887   abs x = - x"
   900 by (rule abs_of_nonpos, rule order_less_imp_le)
   888 by (rule abs_of_nonpos, rule order_less_imp_le)
   901 
   889 
   902 lemma abs_leI: "[|a \<le> b; -a \<le> b|] ==> abs a \<le> (b::'a::lordered_ab_group_abs)"
   890 lemma abs_leI: "[|a \<le> b; -a \<le> b|] ==> abs a \<le> (b::'a::lordered_ab_group_abs)"
   903 by (simp add: abs_lattice join_imp_le)
   891 by (simp add: abs_lattice join_leI)
   904 
   892 
   905 lemma le_minus_self_iff: "(a \<le> -a) = (a \<le> (0::'a::lordered_ab_group))"
   893 lemma le_minus_self_iff: "(a \<le> -a) = (a \<le> (0::'a::lordered_ab_group))"
   906 proof -
   894 proof -
   907   from add_le_cancel_left[of "-a" "a+a" "0"] have "(a <= -a) = (a+a <= 0)" 
   895   from add_le_cancel_left[of "-a" "a+a" "0"] have "(a <= -a) = (a+a <= 0)" 
   908     by (simp add: add_assoc[symmetric])
   896     by (simp add: add_assoc[symmetric])
   927 
   915 
   928 lemma abs_triangle_ineq: "abs(a+b) \<le> abs a + abs(b::'a::lordered_ab_group_abs)"
   916 lemma abs_triangle_ineq: "abs(a+b) \<le> abs a + abs(b::'a::lordered_ab_group_abs)"
   929 proof -
   917 proof -
   930   have g:"abs a + abs b = join (a+b) (join (-a-b) (join (-a+b) (a + (-b))))" (is "_=join ?m ?n")
   918   have g:"abs a + abs b = join (a+b) (join (-a-b) (join (-a+b) (a + (-b))))" (is "_=join ?m ?n")
   931     by (simp add: abs_lattice add_meet_join_distribs join_aci diff_minus)
   919     by (simp add: abs_lattice add_meet_join_distribs join_aci diff_minus)
   932   have a:"a+b <= join ?m ?n" by (simp add: meet_join_le)
   920   have a:"a+b <= join ?m ?n" by (simp)
   933   have b:"-a-b <= ?n" by (simp add: meet_join_le) 
   921   have b:"-a-b <= ?n" by (simp) 
   934   have c:"?n <= join ?m ?n" by (simp add: meet_join_le)
   922   have c:"?n <= join ?m ?n" by (simp)
   935   from b c have d: "-a-b <= join ?m ?n" by simp
   923   from b c have d: "-a-b <= join ?m ?n" by(rule order_trans)
   936   have e:"-a-b = -(a+b)" by (simp add: diff_minus)
   924   have e:"-a-b = -(a+b)" by (simp add: diff_minus)
   937   from a d e have "abs(a+b) <= join ?m ?n" 
   925   from a d e have "abs(a+b) <= join ?m ?n" 
   938     by (drule_tac abs_leI, auto)
   926     by (drule_tac abs_leI, auto)
   939   with g[symmetric] show ?thesis by simp
   927   with g[symmetric] show ?thesis by simp
   940 qed
   928 qed
  1172 val abs_le_zero_iff = thm "abs_le_zero_iff";
  1160 val abs_le_zero_iff = thm "abs_le_zero_iff";
  1173 val zero_less_abs_iff = thm "zero_less_abs_iff";
  1161 val zero_less_abs_iff = thm "zero_less_abs_iff";
  1174 val abs_not_less_zero = thm "abs_not_less_zero";
  1162 val abs_not_less_zero = thm "abs_not_less_zero";
  1175 val abs_ge_self = thm "abs_ge_self";
  1163 val abs_ge_self = thm "abs_ge_self";
  1176 val abs_ge_minus_self = thm "abs_ge_minus_self";
  1164 val abs_ge_minus_self = thm "abs_ge_minus_self";
  1177 val le_imp_join_eq = thm "le_imp_join_eq";
  1165 val le_imp_join_eq = thm "join_absorp2";
  1178 val ge_imp_join_eq = thm "ge_imp_join_eq";
  1166 val ge_imp_join_eq = thm "join_absorp1";
  1179 val le_imp_meet_eq = thm "le_imp_meet_eq";
  1167 val le_imp_meet_eq = thm "meet_absorp1";
  1180 val ge_imp_meet_eq = thm "ge_imp_meet_eq";
  1168 val ge_imp_meet_eq = thm "meet_absorp2";
  1181 val abs_prts = thm "abs_prts";
  1169 val abs_prts = thm "abs_prts";
  1182 val abs_minus_cancel = thm "abs_minus_cancel";
  1170 val abs_minus_cancel = thm "abs_minus_cancel";
  1183 val abs_idempotent = thm "abs_idempotent";
  1171 val abs_idempotent = thm "abs_idempotent";
  1184 val zero_le_iff_zero_nprt = thm "zero_le_iff_zero_nprt";
  1172 val zero_le_iff_zero_nprt = thm "zero_le_iff_zero_nprt";
  1185 val le_zero_iff_zero_pprt = thm "le_zero_iff_zero_pprt";
  1173 val le_zero_iff_zero_pprt = thm "le_zero_iff_zero_pprt";