R&F: added sgn lemma
authornipkow
Thu Dec 06 19:58:21 2007 +0100 (2007-12-06)
changeset 255644ca31a3706a4
parent 25563 cab4f808f791
child 25565 33d30a53fae7
R&F: added sgn lemma
Prefix: sledge-hammered
src/HOL/Library/List_Prefix.thy
src/HOL/Ring_and_Field.thy
     1.1 --- a/src/HOL/Library/List_Prefix.thy	Thu Dec 06 17:05:44 2007 +0100
     1.2 +++ b/src/HOL/Library/List_Prefix.thy	Thu Dec 06 19:58:21 2007 +0100
     1.3 @@ -63,6 +63,8 @@
     1.4    assume "xs \<le> ys @ [y]"
     1.5    then obtain zs where zs: "ys @ [y] = xs @ zs" ..
     1.6    show "xs = ys @ [y] \<or> xs \<le> ys"
     1.7 +    by (metis append_Nil2 butlast_append butlast_snoc prefixI zs)
     1.8 +(*
     1.9    proof (cases zs rule: rev_cases)
    1.10      assume "zs = []"
    1.11      with zs have "xs = ys @ [y]" by simp
    1.12 @@ -73,9 +75,12 @@
    1.13      then have "xs \<le> ys" ..
    1.14      then show ?thesis ..
    1.15    qed
    1.16 +*)
    1.17  next
    1.18    assume "xs = ys @ [y] \<or> xs \<le> ys"
    1.19    then show "xs \<le> ys @ [y]"
    1.20 +    by (metis order_eq_iff strict_prefixE strict_prefixI' xt1(7))
    1.21 +(*
    1.22    proof
    1.23      assume "xs = ys @ [y]"
    1.24      then show ?thesis by simp
    1.25 @@ -85,6 +90,7 @@
    1.26      then have "ys @ [y] = xs @ (zs @ [y])" by simp
    1.27      then show ?thesis ..
    1.28    qed
    1.29 +*)
    1.30  qed
    1.31  
    1.32  lemma Cons_prefix_Cons [simp]: "(x # xs \<le> y # ys) = (x = y \<and> xs \<le> ys)"
    1.33 @@ -94,19 +100,23 @@
    1.34    by (induct xs) simp_all
    1.35  
    1.36  lemma same_prefix_nil [iff]: "(xs @ ys \<le> xs) = (ys = [])"
    1.37 +by (metis append_Nil2 append_self_conv order_eq_iff prefixI)
    1.38 +(*
    1.39  proof -
    1.40    have "(xs @ ys \<le> xs @ []) = (ys \<le> [])" by (rule same_prefix_prefix)
    1.41    then show ?thesis by simp
    1.42  qed
    1.43 -
    1.44 +*)
    1.45  lemma prefix_prefix [simp]: "xs \<le> ys ==> xs \<le> ys @ zs"
    1.46 +by (metis order_le_less_trans prefixI strict_prefixE strict_prefixI)
    1.47 +(*
    1.48  proof -
    1.49    assume "xs \<le> ys"
    1.50    then obtain us where "ys = xs @ us" ..
    1.51    then have "ys @ zs = xs @ (us @ zs)" by simp
    1.52    then show ?thesis ..
    1.53  qed
    1.54 -
    1.55 +*)
    1.56  lemma append_prefixD: "xs @ ys \<le> zs \<Longrightarrow> xs \<le> zs"
    1.57    by (auto simp add: prefix_def)
    1.58  
    1.59 @@ -114,28 +124,34 @@
    1.60    by (cases xs) (auto simp add: prefix_def)
    1.61  
    1.62  theorem prefix_append:
    1.63 -    "(xs \<le> ys @ zs) = (xs \<le> ys \<or> (\<exists>us. xs = ys @ us \<and> us \<le> zs))"
    1.64 +  "(xs \<le> ys @ zs) = (xs \<le> ys \<or> (\<exists>us. xs = ys @ us \<and> us \<le> zs))"
    1.65    apply (induct zs rule: rev_induct)
    1.66     apply force
    1.67    apply (simp del: append_assoc add: append_assoc [symmetric])
    1.68 +  apply (metis append_eq_appendI)
    1.69 +(*
    1.70    apply simp
    1.71    apply blast
    1.72 +*)
    1.73    done
    1.74  
    1.75  lemma append_one_prefix:
    1.76 -    "xs \<le> ys ==> length xs < length ys ==> xs @ [ys ! length xs] \<le> ys"
    1.77 -  apply (unfold prefix_def)
    1.78 +  "xs \<le> ys ==> length xs < length ys ==> xs @ [ys ! length xs] \<le> ys"
    1.79 +by (unfold prefix_def)
    1.80 +   (metis Cons_eq_appendI append_eq_appendI append_eq_conv_conj eq_Nil_appendI nth_drop')
    1.81 +(*
    1.82    apply (auto simp add: nth_append)
    1.83    apply (case_tac zs)
    1.84     apply auto
    1.85    done
    1.86 -
    1.87 +*)
    1.88  theorem prefix_length_le: "xs \<le> ys ==> length xs \<le> length ys"
    1.89    by (auto simp add: prefix_def)
    1.90  
    1.91  lemma prefix_same_cases:
    1.92 -    "(xs\<^isub>1::'a list) \<le> ys \<Longrightarrow> xs\<^isub>2 \<le> ys \<Longrightarrow> xs\<^isub>1 \<le> xs\<^isub>2 \<or> xs\<^isub>2 \<le> xs\<^isub>1"
    1.93 -  apply (simp add: prefix_def)
    1.94 +  "(xs\<^isub>1::'a list) \<le> ys \<Longrightarrow> xs\<^isub>2 \<le> ys \<Longrightarrow> xs\<^isub>1 \<le> xs\<^isub>2 \<or> xs\<^isub>2 \<le> xs\<^isub>1"
    1.95 +by (unfold prefix_def) (metis append_eq_append_conv2)
    1.96 +(*
    1.97    apply (erule exE)+
    1.98    apply (simp add: append_eq_append_conv_if split: if_splits)
    1.99     apply (rule disjI2)
   1.100 @@ -150,43 +166,45 @@
   1.101    apply (insert append_take_drop_id [of "length xs\<^isub>1" xs\<^isub>2])
   1.102    apply simp
   1.103    done
   1.104 +*)
   1.105 +lemma set_mono_prefix: "xs \<le> ys \<Longrightarrow> set xs \<subseteq> set ys"
   1.106 +by (auto simp add: prefix_def)
   1.107  
   1.108 -lemma set_mono_prefix:
   1.109 -    "xs \<le> ys \<Longrightarrow> set xs \<subseteq> set ys"
   1.110 -  by (auto simp add: prefix_def)
   1.111 -
   1.112 -lemma take_is_prefix:
   1.113 -  "take n xs \<le> xs"
   1.114 -  apply (simp add: prefix_def)
   1.115 +lemma take_is_prefix: "take n xs \<le> xs"
   1.116 +by (unfold prefix_def) (metis append_take_drop_id)
   1.117 +(*
   1.118    apply (rule_tac x="drop n xs" in exI)
   1.119    apply simp
   1.120    done
   1.121 -
   1.122 +*)
   1.123  lemma map_prefixI:
   1.124    "xs \<le> ys \<Longrightarrow> map f xs \<le> map f ys"
   1.125 -  by (clarsimp simp: prefix_def)
   1.126 +by (clarsimp simp: prefix_def)
   1.127  
   1.128  lemma prefix_length_less:
   1.129    "xs < ys \<Longrightarrow> length xs < length ys"
   1.130 -  apply (clarsimp simp: strict_prefix_def)
   1.131 +by (clarsimp simp: strict_prefix_def prefix_def)
   1.132 +(*
   1.133    apply (frule prefix_length_le)
   1.134    apply (rule ccontr, simp)
   1.135    apply (clarsimp simp: prefix_def)
   1.136    done
   1.137 -
   1.138 +*)
   1.139  lemma strict_prefix_simps [simp]:
   1.140    "xs < [] = False"
   1.141    "[] < (x # xs) = True"
   1.142    "(x # xs) < (y # ys) = (x = y \<and> xs < ys)"
   1.143 -  by (simp_all add: strict_prefix_def cong: conj_cong)
   1.144 +by (simp_all add: strict_prefix_def cong: conj_cong)
   1.145  
   1.146 -lemma take_strict_prefix:
   1.147 -  "xs < ys \<Longrightarrow> take n xs < ys"
   1.148 -  apply (induct n arbitrary: xs ys)
   1.149 -   apply (case_tac ys, simp_all)[1]
   1.150 +lemma take_strict_prefix: "xs < ys \<Longrightarrow> take n xs < ys"
   1.151 +apply (induct n arbitrary: xs ys)
   1.152 + apply (case_tac ys, simp_all)[1]
   1.153 +apply (metis order_less_trans strict_prefixI take_is_prefix)
   1.154 +(*
   1.155    apply (case_tac xs, simp)
   1.156    apply (case_tac ys, simp_all)
   1.157 -  done
   1.158 +*)
   1.159 +done
   1.160  
   1.161  lemma not_prefix_cases:
   1.162    assumes pfx: "\<not> ps \<le> ls"
   1.163 @@ -195,17 +213,17 @@
   1.164    | (c2) a as x xs where "ps = a#as" and "ls = x#xs" and "x = a" and "\<not> as \<le> xs"
   1.165    | (c3) a as x xs where "ps = a#as" and "ls = x#xs" and "x \<noteq> a"
   1.166  proof (cases ps)
   1.167 -  case Nil
   1.168 -  then show ?thesis using pfx by simp
   1.169 +  case Nil thus ?thesis using pfx by simp
   1.170  next
   1.171    case (Cons a as)
   1.172 -  then have c: "ps = a#as" .
   1.173 -
   1.174 +  hence c: "ps = a#as" .
   1.175    show ?thesis
   1.176    proof (cases ls)
   1.177 -    case Nil
   1.178 +    case Nil thus ?thesis by (metis append_Nil2 pfx c1 same_prefix_nil)
   1.179 +(*
   1.180      have "ps \<noteq> []" by (simp add: Nil Cons)
   1.181      from this and Nil show ?thesis by (rule c1)
   1.182 +*)
   1.183    next
   1.184      case (Cons x xs)
   1.185      show ?thesis
   1.186 @@ -234,12 +252,14 @@
   1.187    then have npfx: "\<not> ps \<le> (y # ys)" by simp
   1.188    then obtain x xs where pv: "ps = x # xs"
   1.189      by (rule not_prefix_cases) auto
   1.190 -
   1.191 +  show ?case by (metis Cons.hyps Cons_prefix_Cons npfx pv r1 r2)
   1.192 +(*
   1.193    from Cons
   1.194    have ih: "\<And>ps. \<not>ps \<le> ys \<Longrightarrow> P ps ys" by simp
   1.195  
   1.196    show ?case using npfx
   1.197      by (simp only: pv) (erule not_prefix_cases, auto intro: r1 r2 ih)
   1.198 +*)
   1.199  qed
   1.200  
   1.201  
   1.202 @@ -250,16 +270,16 @@
   1.203    "(xs \<parallel> ys) = (\<not> xs \<le> ys \<and> \<not> ys \<le> xs)"
   1.204  
   1.205  lemma parallelI [intro]: "\<not> xs \<le> ys ==> \<not> ys \<le> xs ==> xs \<parallel> ys"
   1.206 -  unfolding parallel_def by blast
   1.207 +unfolding parallel_def by blast
   1.208  
   1.209  lemma parallelE [elim]:
   1.210 -  assumes "xs \<parallel> ys"
   1.211 -  obtains "\<not> xs \<le> ys \<and> \<not> ys \<le> xs"
   1.212 -  using assms unfolding parallel_def by blast
   1.213 +assumes "xs \<parallel> ys"
   1.214 +obtains "\<not> xs \<le> ys \<and> \<not> ys \<le> xs"
   1.215 +using assms unfolding parallel_def by blast
   1.216  
   1.217  theorem prefix_cases:
   1.218 -  obtains "xs \<le> ys" | "ys < xs" | "xs \<parallel> ys"
   1.219 -  unfolding parallel_def strict_prefix_def by blast
   1.220 +obtains "xs \<le> ys" | "ys < xs" | "xs \<parallel> ys"
   1.221 +unfolding parallel_def strict_prefix_def by blast
   1.222  
   1.223  theorem parallel_decomp:
   1.224    "xs \<parallel> ys ==> \<exists>as b bs c cs. b \<noteq> c \<and> xs = as @ b # bs \<and> ys = as @ c # cs"
   1.225 @@ -275,17 +295,25 @@
   1.226      then obtain ys' where ys: "ys = xs @ ys'" ..
   1.227      show ?thesis
   1.228      proof (cases ys')
   1.229 -      assume "ys' = []" with ys have "xs = ys" by simp
   1.230 +      assume "ys' = []"
   1.231 +      thus ?thesis by (metis append_Nil2 parallelE prefixI snoc.prems ys)
   1.232 +(*
   1.233 +      with ys have "xs = ys" by simp
   1.234        with snoc have "[x] \<parallel> []" by auto
   1.235        then have False by blast
   1.236        then show ?thesis ..
   1.237 +*)
   1.238      next
   1.239        fix c cs assume ys': "ys' = c # cs"
   1.240 +      thus ?thesis
   1.241 +	by (metis Cons_eq_appendI eq_Nil_appendI parallelE prefixI same_prefix_prefix snoc.prems ys)
   1.242 +(*
   1.243        with snoc ys have "xs @ [x] \<parallel> xs @ c # cs" by (simp only:)
   1.244        then have "x \<noteq> c" by auto
   1.245        moreover have "xs @ [x] = xs @ x # []" by simp
   1.246        moreover from ys ys' have "ys = xs @ c # cs" by (simp only:)
   1.247        ultimately show ?thesis by blast
   1.248 +*)
   1.249      qed
   1.250    next
   1.251      assume "ys < xs" then have "ys \<le> xs @ [x]" by (simp add: strict_prefix_def)
   1.252 @@ -301,18 +329,16 @@
   1.253    qed
   1.254  qed
   1.255  
   1.256 -lemma parallel_append:
   1.257 -  "a \<parallel> b \<Longrightarrow> a @ c \<parallel> b @ d"
   1.258 -  by (rule parallelI)
   1.259 -     (erule parallelE, erule conjE,
   1.260 -            induct rule: not_prefix_induct, simp+)+
   1.261 +lemma parallel_append: "a \<parallel> b \<Longrightarrow> a @ c \<parallel> b @ d"
   1.262 +by (rule parallelI)
   1.263 +   (erule parallelE, erule conjE,
   1.264 +          induct rule: not_prefix_induct, simp+)+
   1.265  
   1.266 -lemma parallel_appendI:
   1.267 -  "\<lbrakk> xs \<parallel> ys; x = xs @ xs' ; y = ys @ ys' \<rbrakk> \<Longrightarrow> x \<parallel> y"
   1.268 -  by simp (rule parallel_append)
   1.269 +lemma parallel_appendI: "\<lbrakk> xs \<parallel> ys; x = xs @ xs' ; y = ys @ ys' \<rbrakk> \<Longrightarrow> x \<parallel> y"
   1.270 +by simp (rule parallel_append)
   1.271  
   1.272  lemma parallel_commute: "(a \<parallel> b) = (b \<parallel> a)"
   1.273 -  unfolding parallel_def by auto
   1.274 +unfolding parallel_def by auto
   1.275  
   1.276  
   1.277  subsection {* Postfix order on lists *}
   1.278 @@ -322,12 +348,12 @@
   1.279    "(xs >>= ys) = (\<exists>zs. xs = zs @ ys)"
   1.280  
   1.281  lemma postfixI [intro?]: "xs = zs @ ys ==> xs >>= ys"
   1.282 -  unfolding postfix_def by blast
   1.283 +unfolding postfix_def by blast
   1.284  
   1.285  lemma postfixE [elim?]:
   1.286 -  assumes "xs >>= ys"
   1.287 -  obtains zs where "xs = zs @ ys"
   1.288 -  using assms unfolding postfix_def by blast
   1.289 +assumes "xs >>= ys"
   1.290 +obtains zs where "xs = zs @ ys"
   1.291 +using assms unfolding postfix_def by blast
   1.292  
   1.293  lemma postfix_refl [iff]: "xs >>= xs"
   1.294    by (auto simp add: postfix_def)
   1.295 @@ -380,42 +406,37 @@
   1.296    then show "xs >>= ys" ..
   1.297  qed
   1.298  
   1.299 -lemma distinct_postfix:
   1.300 -  assumes "distinct xs"
   1.301 -    and "xs >>= ys"
   1.302 -  shows "distinct ys"
   1.303 -  using assms by (clarsimp elim!: postfixE)
   1.304 +lemma distinct_postfix: "distinct xs \<Longrightarrow> xs >>= ys \<Longrightarrow> distinct ys"
   1.305 +by (clarsimp elim!: postfixE)
   1.306  
   1.307 -lemma postfix_map:
   1.308 -  assumes "xs >>= ys"
   1.309 -  shows "map f xs >>= map f ys"
   1.310 -  using assms by (auto elim!: postfixE intro: postfixI)
   1.311 +lemma postfix_map: "xs >>= ys \<Longrightarrow> map f xs >>= map f ys"
   1.312 +by (auto elim!: postfixE intro: postfixI)
   1.313  
   1.314  lemma postfix_drop: "as >>= drop n as"
   1.315 -  unfolding postfix_def
   1.316 -  by (rule exI [where x = "take n as"]) simp
   1.317 +unfolding postfix_def
   1.318 +by (rule exI [where x = "take n as"]) simp
   1.319  
   1.320 -lemma postfix_take:
   1.321 -    "xs >>= ys \<Longrightarrow> xs = take (length xs - length ys) xs @ ys"
   1.322 -  by (clarsimp elim!: postfixE)
   1.323 +lemma postfix_take: "xs >>= ys \<Longrightarrow> xs = take (length xs - length ys) xs @ ys"
   1.324 +by (clarsimp elim!: postfixE)
   1.325  
   1.326  lemma parallelD1: "x \<parallel> y \<Longrightarrow> \<not> x \<le> y"
   1.327 -  by blast
   1.328 +by blast
   1.329  
   1.330  lemma parallelD2: "x \<parallel> y \<Longrightarrow> \<not> y \<le> x"
   1.331 -  by blast
   1.332 +by blast
   1.333  
   1.334  lemma parallel_Nil1 [simp]: "\<not> x \<parallel> []"
   1.335 -  unfolding parallel_def by simp
   1.336 +unfolding parallel_def by simp
   1.337  
   1.338  lemma parallel_Nil2 [simp]: "\<not> [] \<parallel> x"
   1.339 -  unfolding parallel_def by simp
   1.340 +unfolding parallel_def by simp
   1.341  
   1.342 -lemma Cons_parallelI1:
   1.343 -  "a \<noteq> b \<Longrightarrow> a # as \<parallel> b # bs" by auto
   1.344 +lemma Cons_parallelI1: "a \<noteq> b \<Longrightarrow> a # as \<parallel> b # bs"
   1.345 +by auto
   1.346  
   1.347 -lemma Cons_parallelI2:
   1.348 -  "\<lbrakk> a = b; as \<parallel> bs \<rbrakk> \<Longrightarrow> a # as \<parallel> b # bs"
   1.349 +lemma Cons_parallelI2: "\<lbrakk> a = b; as \<parallel> bs \<rbrakk> \<Longrightarrow> a # as \<parallel> b # bs"
   1.350 +by (metis Cons_prefix_Cons parallelE parallelI)
   1.351 +(*
   1.352    apply simp
   1.353    apply (rule parallelI)
   1.354     apply simp
   1.355 @@ -423,7 +444,7 @@
   1.356    apply simp
   1.357    apply (erule parallelD2)
   1.358   done
   1.359 -
   1.360 +*)
   1.361  lemma not_equal_is_parallel:
   1.362    assumes neq: "xs \<noteq> ys"
   1.363      and len: "length xs = length ys"
   1.364 @@ -435,7 +456,6 @@
   1.365  next
   1.366    case (2 a as b bs)
   1.367    have ih: "as \<noteq> bs \<Longrightarrow> as \<parallel> bs" by fact
   1.368 -
   1.369    show ?case
   1.370    proof (cases "a = b")
   1.371      case True
     2.1 --- a/src/HOL/Ring_and_Field.thy	Thu Dec 06 17:05:44 2007 +0100
     2.2 +++ b/src/HOL/Ring_and_Field.thy	Thu Dec 06 19:58:21 2007 +0100
     2.3 @@ -522,6 +522,9 @@
     2.4  class sgn_if = sgn + zero + one + minus + ord +
     2.5    assumes sgn_if: "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
     2.6  
     2.7 +lemma (in sgn_if) sgn0[simp]: "sgn 0 = 0"
     2.8 +by(simp add:sgn_if)
     2.9 +
    2.10  class ordered_ring = ring + ordered_semiring
    2.11    + ordered_ab_group_add + abs_if
    2.12  begin