(*  Title:      Length.thy
    Author:     Sven Linker

The length of cars visible to the owner of a given view.
*)

section\<open>Visible Length of Cars with Perfect Sensors\<close>
text\<open>
Given a sensor function, we can define the length
of a car \(c\) as perceived by the owner of a view \(v\). This
length is restricted by the size of the extension of the view \(v\),
but always given by a continuous interval, which may possibly
be degenerate (i.e., a point-interval).

The lemmas connect the end-points of the perceived length
with the end-points of the current view. Furthermore, they
show how the chopping and subview relations affect
the perceived length of a car.
\<close>

theory Length
  imports  Sensors
begin

context sensors
begin

declare[[show_types=false]]

definition len:: "view \<Rightarrow> traffic \<Rightarrow> cars \<Rightarrow> real_int"
  where len_def :"len v ts c = intersect (ext v) (space ts v c)"

(*"Abs_real_int (
    if (left (space ts v c) > right (ext v))
      then   (right (ext v),right (ext v))
    else
      if (right (space ts v c) < left (ext v))
        then  (left (ext v),left (ext v))
      else
        (max (left (ext v)) (left (space ts v c)),
                      min (right (ext v)) (right (space ts v c)))
    )"
*)
print_theorems

lemma len_left: " left ((len v  ts) c) \<ge> left (ext v)"
  using intersect_left len_def by auto

lemma len_right: " right ((len v  ts) c) \<le> right (ext v)"
  using intersect_right len_def by auto

lemma len_sub_int:"len v ts c \<le> ext v"
  using intersect_leq len_def by auto

lemma len_space_left:
  "left (space ts v c) \<le> right (ext v) \<longrightarrow> left (len v ts c) \<ge> left (space ts v c)"
  using intersect_left' len_def by auto

lemma len_space_right:
  "right (space ts v c) \<ge> left (ext v) \<longrightarrow> right (len v ts c) \<le> right (space ts v c)"
  using intersect_right' len_def by auto

(*lemma len_hchop_left_right_border:
  "(len v ts c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> (right (len v1 ts c) = right (ext v1))" sledgehammer
proof
  assume assm:"((len v ts) c = ext v) \<and> (v=v1\<parallel>v2)"
  have l1:"left ((len v ts) c) = left (ext v)" using assm by auto
  from assm have l2:"left (ext v) = left (ext v1)"
    by (simp add: hchop_def real_int.rchop_def)
  from l1 and l2 have l3:"left ((len v ts) c) = left (ext v1)" by simp
  have r1:"right ((len v ts) c) = right (ext v)" using assm by auto
  have r2:"right (ext v1) \<le> right (ext v)"
    by (metis (no_types, lifting) assm hchop_def real_int.rchop_def
        real_int.left_leq_right )
  have r3:"right ((len v1 ts) c) \<le> right (ext v1)"
    using len_right by blast
  show "right ((len v1 ts) c) = right (ext v1)"
  proof (rule ccontr)
    assume contra:"right ((len v1 ts) c) \<noteq> right (ext v1)"
    with r3 have less:"right ((len v1 ts) c) < right (ext v1)" by simp
    show False
    proof (cases "left ((space ts v) c) \<le> right (ext v1)")
      assume neg1:"\<not> left ((space ts v) c) \<le> right (ext v1)"
      then have "left (space ts v c) > right (ext v1)" by auto
      then have "left (space ts v1 c) > right (ext v1)"
        using left_space by auto
      have "right ((len v1 ts) c) = right (ext v1)"
        using Abs_real_int_inverse left_space len_def neg1 right.rep_eq sledgehammer
      with contra show False ..
    next
      assume less1:"left ((space ts v) c) \<le> right (ext v1)"
      show False
      proof (cases "right ((space ts v) c) \<ge> left (ext v1)")
        assume neg2:"\<not> left (ext v1) \<le> right ((space ts v) c)"
        have "right ((len v1 ts) c) = right (ext v1)"
        proof -
          have "(len v1 ts) c = Abs_real_int (left (ext v1),left (ext v1))"
            using len_def  neg2 assm hchop_def real_int.left_leq_right less1 space_def
            by auto
          hence  "right ((len v1 ts) c) = left ((len v1 ts )c)"
            using l3 assm contra less1 len_def neg2 r2 r3  real_int.left_leq_right
            by auto
          with l1 have r4:"right((len v1 ts)c ) = right (ext v)"
            using assm l2 len_def neg2 assm hchop_def less1 real_int.left_leq_right r2
              space_def
            by auto
          hence "right (ext v) = right (ext v1)"
            using r2 r3 by auto
          thus "right ((len v1 ts) c) = right (ext v1)"
            using r4 by auto
        qed
        with contra  show False ..
      next
        assume less2:"left (ext v1) \<le> right ((space ts v) c)"
        have len_in_type:
          "(max (left (ext v1)) (left ((space ts v) c)),
            min (right (ext v1)) (right ((space ts v) c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
          using Rep_real_int less1 less2 by auto
        from less1 and less2 have len_def_v1:"len v1 (ts) c =
                Abs_real_int ((max (left (ext v1)) (left ((space ts v) c))),
                              min (right (ext v1)) (right ((space ts v) c)))"
          using len_def assm hchop_def  space_def  by auto
        with less have
          "min (right (ext v1)) (right ((space ts v) c)) = right ((space ts v) c)"
          using Abs_real_int_inverse len_in_type snd_conv by auto
        hence "right ((space ts v) c) \<le> right (ext v1)" by simp
        hence "right ((space ts v) c) \<le> right (ext v)"
          using r2 by linarith
        from len_def_v1 and less and len_in_type
        have "right ((space ts v) c) < right (ext v1)"
          using Abs_real_int_inverse sndI by auto
        hence r4:"right ((space ts v) c) < right (ext v)"
          using r2 by linarith
        from assm have len_v_in_type:
          "(max (left (ext v)) (left ((space ts v) c)),
            min (right (ext v)) (right ((space ts v) c)))
          \<in> {r :: real*real . fst r \<le> snd r}"
          using r4 l2 len_in_type by auto
        hence " right (len v ( ts) c) \<noteq> right (ext v)"
          using Abs_real_int_inverse Pair_inject r4 len_def real_int.left_leq_right
            surjective_pairing by auto
        with r1 show False by best
      qed
    qed
  qed
qed

lemma len_hchop_left_left_border:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> (left ((len v1 ts) c) = left (ext v1))"
proof
  assume assm:"((len v ts) c = ext v) \<and> (v=v1\<parallel>v2)"
  have l1:"left ((len v ts) c) = left (ext v)" using assm by auto
  from assm have l2:"left (ext v) = left (ext v1)"
    by (simp add: hchop_def real_int.rchop_def )
  from l1 and l2 have l3:"left ((len v ts) c) = left (ext v1)" by simp
  have r1:"right ((len v ts) c) = right (ext v)" using assm by auto
  have r2:"right (ext v1) \<le> right (ext v)"
    by (metis (no_types, lifting) assm hchop_def real_int.rchop_def
        real_int.left_leq_right )
  have r3:"right ((len v1 ts) c) \<le> right (ext v1)"
    using len_right by blast
  show "(left ((len v1 ts) c) = left (ext v1))"
  proof (cases
      "left ((space ts v) c) \<le> right (ext v1) \<and> right ((space ts v) c) \<ge> left (ext v1)")
    case True
    show "(left ((len v1 ts) c) = left (ext v1))"
    proof (rule ccontr)
      assume neq:" left (len v1 ( ts) c) \<noteq> left (ext v1)"
      then have greater: "left (len v1 ( ts) c) > left (ext v1)"
        by (meson dual_order.order_iff_strict len_left)
      have len_in_type:
        "(max (left (ext v1)) (left ((space ts v) c)),
           min (right (ext v1)) (right ((space ts v) c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
        using Rep_real_int True by auto
      from True have "len v1 ( ts) c =
        Abs_real_int ((max (left (ext v1)) (left ((space ts v) c))),
                       min (right (ext v1)) (right ((space ts v) c)))"
        using len_def assm hchop_def space_def  by auto
      hence maximum:
        "left (len v1 ( ts) c) = max (left (ext v1)) (left ((space ts v) c))"
        using Abs_real_int_inverse len_in_type by auto
      have "max (left (ext v1)) (left ((space ts v) c)) = left ((space ts v) c)"
        using maximum neq by linarith
      hence "left ((space ts v) c) > left (ext v1)"
        using greater maximum by auto
      hence l4:"left ((space ts v) c) > left (ext v)" using l2 by auto
      with assm have len_v_in_type:
        "(max (left (ext v)) (left ((space ts v) c)),
          min (right (ext v)) (right ((space ts v) c)))
        \<in> {r :: real*real . fst r \<le> snd r}"
        using len_in_type r2 by auto
      hence " left (len v ( ts) c) \<noteq> left (ext v)"
        using Abs_real_int_inverse l4 sensors.len_def sensors_axioms by auto
      thus False using l1 by best
    qed
  next
    case False
    then have
      "\<not>left ((space ts v) c) \<le> right (ext v1) \<or> \<not>right ((space ts v) c) \<ge> left (ext v1)"
      by auto
    then show "(left ((len v1 ts) c) = left (ext v1))"
    proof
      assume negative:"\<not> left ((space ts v) c) \<le> right (ext v1)"
      then have "len v1 ( ts) c = Abs_real_int (right (ext v1),right (ext v1))"
        using len_def assm hchop_def space_def by auto
      hence empty:"left (len v1 ( ts) c) = right (len v1 ( ts) c)"
        by (metis real_int.chop_assoc2 real_int.chop_singleton_right real_int.rch op_def)
      have len_geq:"left(len v1 ( ts) c) \<ge> left (ext v)"
        using l2 len_left by auto
      show "left (len v1 ( ts) c) = left (ext v1)"
      proof (rule ccontr)
        assume contra:"left (len v1 ( ts) c) \<noteq> left (ext v1)"
        with len_left have "left (ext v1) < left (len v1 ( ts) c)  "
          using dual_order.order_iff_strict by blast
        hence l5:"left (ext v) < left (len v1 ( ts) c)" using l2 by auto
        hence l6:"left (len v ( ts) c) < left (len v1 ( ts) c)" using l1 by auto
        show "False"
        proof (cases "left ((space ts v) c) \<le> right (ext v)")
          case True
          have well_sp:"left ((space ts v) c) \<le> right ((space ts v) c)"
            using real_int.left_leq_right by auto
          have well_v:"left (ext v) \<le> right (ext v)"
            using real_int.left_leq_right by auto
          hence rs_geq_vl:"right ((space ts v) c) \<ge> left (ext v)"
            using empty len_geq negative r3 well_sp by linarith
          from True and rs_geq_vl have len_in_type:
            "(max (left (ext v)) (left ((space ts v) c)),
              min (right (ext v)) (right ((space ts v) c)))
              \<in> {r :: real*real . fst r \<le> snd r}"
            using CollectD CollectI Rep_real_int fst_conv snd_conv by auto
          have "len v (ts) c  =
                Abs_real_int (max (left (ext v)) (left ((space ts v) c)),
                               min (right (ext v)) (right ((space ts v) c)))"
            using len_def using True rs_geq_vl by auto
          hence max_less:
            "max (left (ext v)) (left ((space ts v) c)) <  left (len v1 ( ts) c)"
            using Abs_real_int_inverse
            by (metis (full_types) l5 assm fst_conv left.rep_eq len_in_type)
          show False
            using empty max_less negative r3 by auto
        next
          case False
          then have "len v ( ts) c = Abs_real_int (right (ext v), right (ext v))"
            using len_def by auto
          hence empty_len_v:"left (len v ( ts) c) = right (ext v)" using Abs_real_int_inverse
            by simp
          show False
            using l6 empty empty_len_v r2 r3 by linarith
        qed
      qed
    next
      have "space ts v1 c \<le> space ts v c" using assm hchop_def space_def  by auto
      hence r4:"right (space ts v1 c) \<le> right (space ts v c)"
        using  less_eq_real_int_def by auto
      assume left_outside:"\<not> left (ext v1) \<le> right ((space ts v) c)"
      hence "left (ext v1 ) > right (space ts v1 c)" using r4 by linarith
      then have "len v1 ( ts) c = Abs_real_int (left (ext v1),left (ext v1))"
        using len_def assm hchop_def real_int.left_leq_right r1 r2 l1 l2 l3 r3
        by (meson le_less_trans less_trans not_less)
      thus "(left ((len v1 ts) c) = left (ext v1))"
        using  Abs_real_int_inverse by auto
    qed
  qed
qed
*)
lemma len_view_hchop_left:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> ((len v1 ts) c = ext v1)"
  by (metis chop_leq1 left_right_eq len_def rchop_intersect_leq_left rchop_intersect_leq_right space_def view.hchop_def)

lemma len_view_hchop_right:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> ((len v2 ts) c = ext v2)"
  by (metis chop_leq2 left_right_eq len_def rchop_intersect_leq_left rchop_intersect_leq_right space_def view.hchop_def)

(*
lemma len_hchop_right_left_border:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> (left ((len v2 ts) c) = left (ext v2))"
proof
  assume assm:"((len v ts) c = ext v) \<and> (v=v1\<parallel>v2)"
  have r1:"right ((len v ts) c) = right (ext v)" using assm by auto
  from assm have r2:"right (ext v) = right (ext v2)"
    by (simp add: hchop_def real_int.rchop_def )
  from r1 and r2 have r3:"right ((len v ts) c) = right (ext v2)" by simp
  have l1:"left ((len v ts) c) = left (ext v)" using assm by auto
  have l2:"left (ext v2) \<ge> left (ext v)"
    using assm less_eq_real_int_def real_int.chop_leq2 view.hchop_def by blast
  have l3:"left ((len v2 ts) c) \<ge> left (ext v2)"
    using len_left by blast
  show "left ((len v2 ts) c) = left (ext v2)"
  proof (rule ccontr)
    assume contra:"left ((len v2 ts) c) \<noteq> left (ext v2)"
    with l3 have less:"left ((len v2 ts) c) > left (ext v2)" by simp
    show False
    proof (cases "left ((space ts v) c) \<le> right (ext v2)")
      assume neg1:"\<not> left ((space ts v) c) \<le> right (ext v2)"
      have "left ((len v2 ts) c) = left (ext v2)"
      proof -
        have "(len v2 ts) c = Abs_real_int (right (ext v2),right (ext v2))"
          using len_def  neg1 assm hchop_def space_def  by auto
        thus "left ((len v2 ts) c) = left (ext v2)"
          using assm l2 l3 len_def neg1 r3 by auto
      qed
      with contra show False ..
    next
      assume less1:"left ((space ts v) c) \<le> right (ext v2)"
      show False
      proof (cases "right ((space ts v) c) \<ge> left (ext v2)")
        assume neg2:"\<not> left (ext v2) \<le> right ((space ts v) c)"
        have "space ts v2 c \<le> space ts v c" using assm hchop_def space_def  by auto
        hence "right (space ts v2 c) \<le> right (space ts v c)" using less_eq_real_int_def
          by auto
        with neg2 have greater:"left (ext v2 ) > right (space ts v2 c)" by auto
        have "left ((len v2 ts) c) = left (ext v2)"
        proof -
          have len_empty:"(len v2 ts) c = Abs_real_int (left (ext v2),left (ext v2))"
            using len_def  neg2 assm hchop_def   less1 space_def by auto
          have l4:"left((len v2 ts)c ) = left (ext v)"
            using Abs_real_int_inverse len_def less neg2  assm hchop_def
              CollectI len_empty prod.collapse prod.inject by auto
          hence "left (ext v) = left (ext v2)"
            using l2 l3 by auto
          thus "left ((len v2 ts) c) = left (ext v2)" using l4 by auto
        qed
        with contra  show False ..
      next
        assume less2:"left (ext v2) \<le> right ((space ts v) c)"
        have len_in_type:
          "(max (left (ext v2)) (left ((space ts v) c)),
            min (right (ext v2)) (right ((space ts v) c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
          using Rep_real_int less1 less2 by auto
        from less1 and less2 have len_def_v2:"len v2 ( ts) c =
                Abs_real_int (max (left (ext v2)) (left ((space ts v) c)),
                              min (right (ext v2)) (right ((space ts v) c)))"
          using len_def assm hchop_def space_def  by auto
        with less have
          "max (left (ext v2)) (left ((space ts v) c)) = left ((space ts v) c)"
          using Abs_real_int_inverse len_in_type snd_conv by auto
        hence "left ((space ts v) c) \<ge> left (ext v2)" by simp
        hence "left ((space ts v) c) \<ge> left (ext v)"
          using l2 by auto
        from len_def_v2 and less and len_in_type
        have "left ((space ts v) c) > left (ext v2)"
          using Abs_real_int_inverse sndI by auto
        hence l5:"left ((space ts v) c) > left (ext v)"
          using l2 by linarith
        with assm have len_v_in_type:
          "(max (left (ext v)) (left (space ts v c)),
             min (right (ext v)) (right (space ts v c)))
          \<in> {r :: real*real . fst r \<le> snd r}"
          using r2 len_in_type by auto
        hence "left (len v ( ts) c) \<noteq> left (ext v)"
          using Abs_real_int_inverse Pair_inject l5 len_def real_int.left_leq_right
            surjective_pairing by auto
        with l1 show False by best
      qed
    qed
  qed
qed

lemma len_hchop_right_right_border:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> (right ((len v2 ts) c) = right (ext v2))"
proof
  assume assm:"((len v ts) c = ext v) \<and> (v=v1\<parallel>v2)"
  have r1:"right ((len v ts) c) = right (ext v)" using assm by auto
  from assm have r2:"right (ext v) = right (ext v2)"
    by (simp add: hchop_def real_int.rchop_def )
  from r1 and r2 have r3:"right ((len v ts) c) = right (ext v2)" by simp
  have l1:"left ((len v ts) c) = left (ext v)" using assm by auto
  have l2:"left (ext v2) \<le> right (ext v)"
    using assm view.h_chop_middle2 by blast
  have l3:"left ((len v2 ts) c) \<ge> left (ext v2)"
    using len_left by blast
  show "(right ((len v2 ts) c) = right (ext v2))"
  proof (cases
      "left ((space ts v) c) \<le> right (ext v2) \<and> right ((space ts v) c) \<ge> left (ext v2)")
    case True
    show "(right ((len v2 ts) c) = right (ext v2))"
    proof (rule ccontr)
      assume neq:" right (len v2 ( ts) c) \<noteq> right (ext v2)"
      then have lesser: "right (len v2 ( ts) c) < right (ext v2)"
        using len_right less_eq_real_def by blast
      have len_in_type:
        "(max (left (ext v2)) (left (space ts v c)),
          min (right (ext v2)) (right (space ts v c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
        using Rep_real_int True by auto
      from True have
        "len v2 ( ts) c =
          Abs_real_int (max (left (ext v2)) (left (space ts v c)),
                         min (right (ext v2)) (right (space ts v c)))"
        using len_def assm hchop_def space_def by auto
      hence maximum:
        "right (len v2 ( ts) c) = min (right (ext v2)) (right ((space ts v) c))"
        using Abs_real_int_inverse len_in_type by auto
      have min_right:
        "min (right (ext v2)) (right ((space ts v) c)) = right ((space ts v) c)"
        using maximum neq by linarith
      hence "right ((space ts v) c) < right (ext v2)"
        using lesser maximum by auto
      hence right_v:"right ((space ts v) c) < right (ext v)"
          using r2 by auto
      have right_inside:"right ((space ts v) c) \<ge> left (ext v)"
        by (meson True assm less_eq_real_int_def less_eq_view_def
            order_trans view.horizontal_chop_leq2)
      with assm and True and right_inside
      have len_v_in_type:
        "(max (left (ext v)) (left (space ts v c)),
          min (right (ext v)) (right (space ts v c)))
        \<in> {r :: real*real . fst r \<le> snd r}"
        using min_right r2 real_int.left_leq_right by auto
      hence " right (len v ( ts) c) \<noteq> right (ext v)"
        using Abs_real_int_inverse Pair_inject right_v len_def
          real_int.left_leq_right surjective_pairing
        by auto
      thus False using r1 by best
    qed
  next
    case False
    then have "\<not>left ((space ts v) c) \<le> right (ext v2) \<or>
               \<not>right ((space ts v) c) \<ge> left (ext v2)"
      by auto
    thus "right ((len v2 ts) c) = right (ext v2)"
    proof
      assume negative:"\<not> left ((space ts v) c) \<le> right (ext v2)"
      show ?thesis
       using left_space negative r1 r3 sensors.len_def sensors_axioms by auto
    next
      assume left_outside:"\<not> left (ext v2) \<le> right ((space ts v) c)"
      hence "left (ext v2) > right (space ts v2 c)"
        using assm hchop_def space_def by auto
      then have len:"len v2 ( ts) c = Abs_real_int (left (ext v2),left (ext v2))"
        by (metis (no_types, hide_lams) len_def l2 le_less_trans not_less order.asym
            space_nonempty r2)
      show "(right ((len v2 ts) c) = right (ext v2))"
      proof (cases "right ((space ts v) c) \<ge> left (ext v)")
        assume "\<not> left (ext v) \<le> right ((space ts v) c)"
        hence len_empty:"len v (ts) c = Abs_real_int (left (ext v), left (ext v))"
          using len_def real_int.left_leq_right Abs_real_int_inverse
          by (meson less_trans not_less space_nonempty)
        show "(right ((len v2 ts) c) = right (ext v2))"
          by (metis (no_types, hide_lams) Rep_real_int_inverse assm dual_order.antisym
              left.rep_eq len len_empty prod.collapse real_int.chop_singleton_left
              real_int.rchop_def right.rep_eq view.h_chop_middle1 view.hchop_def)
      next
        assume "left (ext v) \<le> right ((space ts v) c)"
        then show ?thesis
          using l2 left_outside len_space_right r1  by fastforce
      qed
    qed
  qed
qed

lemma len_view_hchop_right:
  "((len v ts) c = ext v) \<and> (v=v1\<parallel>v2) \<longrightarrow> ((len v2 ts) c = ext v2)"
  by (metis Rep_real_int_inverse left.rep_eq len_hchop_right_left_border
      len_hchop_right_right_border prod.collapse right.rep_eq)
*)

lemma len_compose_hchop:
  "(v=v1\<parallel>v2) \<and> (len v1 ( ts) c = ext v1) \<and> (len v2 ( ts) c = ext v2)
     \<longrightarrow> (len v ( ts) c = ext v)"
proof
  assume 1:"(v=v1\<parallel>v2) \<and> (len v1 ts c = ext v1) \<and> (len v2 ts c = ext v2)"
  then have "R_Chop(ext v, ext v1, ext v2)" using hchop_def by blast
  then have "intersect (ext v) (space ts v c) = (ext v)" using rchop_intersect_compose len_def 1
    by (metis chop_singleton_right rchop_intersect_left space_def view.hchop_def)
  then show "len v ts c = ext v" using len_def by simp
qed
(*proof
  assume assm:"(v=v1\<parallel>v2) \<and> (len v1 ( ts) c = ext v1) \<and> (len v2 ( ts) c = ext v2)"
  then have left_v1:"left (len v1 ( ts) c) = left (ext v1)" by auto
  from assm have right_v1:"right (len v1 ( ts) c) = left (ext v2)"
    by (simp add: hchop_def real_int.rchop_def )
  from assm have left_v2:"left (len v2 ( ts) c) = right (ext v1)"
    using right_v1 by auto
  from assm have right_v2:"right (len v2 ( ts) c) = right (ext v2)" by auto
  show "(len v ( ts) c = ext v)"
  proof (cases " left ((space ts v) c) > right (ext v)")
    case True
    then have "left (space ts v c) > right (ext v2)" using assm right_v2
      by (simp add: hchop_def real_int.rchop_def )
    then have "left (space ts v2 c) > right( ext v2)"
      using assm hchop_def sensors.space_def sensors_axioms  by auto
    then have "len v2 ts c = Abs_real_int(right (ext v2), right (ext v2))"
      using len_def by simp
    then have "ext v2 = Abs_real_int(right (ext v2), right (ext v2))" using assm by simp
    then have "\<parallel>ext v2\<parallel> = 0"
      by (metis Rep_real_int_inverse fst_conv left.rep_eq
          real_int.chop_singleton_right real_int.length_zero_iff_borders_eq
          real_int.rchop_def right.rep_eq snd_conv surj_pair)
    then have "ext v = ext v1"
      using assm hchop_def real_int.rchop_def real_int.chop_empty2
      by simp
    then show ?thesis
      using assm hchop_def len_def sensors.space_def sensors_axioms
      by auto
  next
    case False
    then have in_left:"left (space ts v c) \<le> right (ext v)" by simp
    show "len v ts c = ext v"
    proof (cases "right (space ts v c) < left (ext v)")
      case True
      then have "right (space ts v c) < left (ext v1)" using assm left_v1
        by (simp add: hchop_def real_int.rchop_def)
      then have out_v1:"right (space ts v1 c) < left (ext v1)"
        using assm hchop_def sensors.space_def sensors_axioms  by auto
      then have "len v1 ts c = Abs_real_int(left (ext v1), left (ext v1))"
        using len_def in_left
        by (meson le_less_trans less_trans not_le real_int.left_leq_right)
      then have "ext v1 = Abs_real_int (left (ext v1), left (ext v1))" using assm by simp
      then have "\<parallel>ext v1\<parallel> = 0"
        by (metis add.right_neutral real_int.chop_singleton_left
            real_int.length_zero_iff_borders_eq real_int.rchop_def real_int.shift_def
            real_int.shift_zero)
      then have "ext v = ext v2" using assm hchop_def real_int.rchop_def real_int.chop_empty1
        by auto
      then show ?thesis
        using assm hchop_def len_def sensors.space_def sensors_axioms by auto
    next
      case False
      then  have in_right:"right (space ts v c) \<ge> left (ext v)"  by simp
      have f1: "own v = own v2" using assm hchop_def
        by (auto)
      have f2: "own v = own v1"
        using assm hchop_def  by auto
      have chop:"R_Chop(ext v,ext v1,ext v2)" using assm hchop_def
        by (auto )
      have len:"len v ts c = Abs_real_int(max (left (ext v)) (left (space ts v c)),
                      min (right (ext v)) (right (space ts v c)))"
        using len_def in_left in_right by simp
      have len1:"len v1 ts c = Abs_real_int(max (left (ext v1)) (left (space ts v1 c)),
                      min (right (ext v1)) (right (space ts v1 c)))"
        by (metis assm f2 f1 chop assm in_left in_right len_def len_space_left
            not_le real_int.rchop_def space_def)
      then have "max (left (ext v1)) (left (space ts v1 c)) = left (len v1 ts c)"
        by (metis assm chop f1 f2 in_left len_space_left max.orderE
            real_int.rchop_def space_def)
      then have left_border:"max (left (ext v1)) (left (space ts v1 c)) = left (ext v1)"
        using left_v1 by simp
      have len2:"len v2 ts c = Abs_real_int(max (left (ext v2)) (left (space ts v2 c)),
                      min (right (ext v2)) (right (space ts v2 c)))"
        by (metis len_def in_left in_right assm f2 f1 chop len_space_right not_le
            real_int.rchop_def space_def)
      then have "min (right (ext v2)) (right (space ts v2 c)) = right (len v2 ts c)"
        by (metis assm chop f1 f2 in_right len_space_right min.absorb_iff1
            real_int.rchop_def space_def)
      then have right_border:
        "min (right (ext v2)) (right (space ts v2 c)) = right (ext v2)"
        using right_v2 by simp
      have "left (space ts v c) = left (space ts v1 c)"
        using assm hchop_def sensors.space_def sensors_axioms by auto
      then have max:
        "  max (left (ext v)) (left (space ts v c))
         = max (left (ext v1)) (left (space ts v1 c))"
        using assm hchop_def real_int.rchop_def  by auto
      have "right (space ts v c) = right (space ts v2 c)"
        using assm hchop_def sensors.space_def sensors_axioms by auto
      then have min:
        "  min (right (ext v)) (right (space ts v c))
         = min (right (ext v2)) (right (space ts v2 c))"
        using assm hchop_def real_int.rchop_def by auto
      show ?thesis
        by (metis min max left_border right_border False add.right_neutral
            chop in_left len_def not_le real_int.rchop_def real_int.shift_def
            real_int.shift_zero)
    qed
  qed
qed
*)

lemma len_stable:"(v=v1--v2) \<longrightarrow> len v1 ts c = len v2 ts c"
proof
  assume assm:"v=v1--v2"
  then have ext_eq1:"ext v = ext v1" and ext_eq2:"ext v = ext v2"
    using vchop_def by auto
  hence ext1_eq_ext2:"ext v1 = ext v2" by simp
  show "len v1 ts c = len v2 ts c"
    using assm ext1_eq_ext2 left_space right_space sensors.len_def sensors_axioms
      view.vertical_chop_own_trans space_def by auto
qed

lemma len_empty_on_subview1:
  "\<parallel>len v ( ts) c\<parallel> = 0 \<and> (v=v1\<parallel>v2) \<longrightarrow> \<parallel>len v1 ( ts) c\<parallel> = 0"
  using rchop_intersect_empty_left
  using len_def space_def view.hchop_def by auto
(*proof
  assume assm:"\<parallel>len v ( ts) c\<parallel> = 0 \<and> (v=v1\<parallel>v2)"
  then have len_v_borders:"left (len v ( ts) c) = right (len v ( ts) c)"
    by (simp add:real_int.length_zero_iff_borders_eq)
  show "\<parallel>len v1 ( ts) c\<parallel> = 0"
  proof (cases "left ((space ts v) c) > right (ext v1)")
    assume left_outside_v1:"left ((space ts v) c) > right (ext v1)"
    thus "\<parallel>len v1 ( ts) c\<parallel> = 0"
      using Abs_real_int_inverse assm fst_conv hchop_def len_def real_int.length_zero_iff_borders_eq
        mem_Collect_eq snd_conv space_def  by auto
  next
    assume left_inside_v1:"\<not>left ((space ts v) c) > right (ext v1)"
    show "\<parallel>len v1 ( ts) c\<parallel> = 0"
    proof (cases "left (ext v1) > right ((space ts v) c)")
      assume right_outside_v1:"left (ext v1) > right ((space ts v) c)"
      hence "left (ext v1) > right ((space ts v1) c)" using assm hchop_def space_def
        by auto
      thus "\<parallel>len v1 (ts) c\<parallel> = 0"
        using assm hchop_def len_def real_int.length_def  Abs_real_int_inverse by auto
    next
      assume right_inside_v1:"\<not>left (ext v1) > right ((space ts v) c)"
      have len_v1:
        "len v1 ( ts) c = Abs_real_int (max (left (ext v1)) (left (space ts v c)),
                                        min (right (ext v1)) (right (space ts v c)))"
        using left_inside_v1 len_def right_inside_v1 assm hchop_def space_def by auto
      from left_inside_v1 and right_inside_v1 have inside_v:
        "\<not>left (space ts v c) > right (ext v) \<and> \<not>left (ext v) > right (space ts v c)"
      proof -
        have "fst (Rep_real_int (ext v2)) \<le> snd (Rep_real_int (ext v))"
          using assm view.h_chop_middle2 by force
        then show ?thesis
          using assm left_inside_v1 real_int.rchop_def right_inside_v1 view.hchop_def
          by force
      qed
      hence len_v:
        "len v ts c = Abs_real_int (max (left (ext v)) (left (space ts v c)),
                                    min (right (ext v)) (right (space ts v c)))"
        by (simp add: len_def)
      have less_eq:
        "  max (left (ext v)) (left (space ts v c))
         \<le> min (right (ext v)) (right (space ts v c))"
        using inside_v real_int.left_leq_right by auto
      from len_v have len_v_empty:
        "  max (left (ext v)) (left ((space ts v) c))
         = min (right (ext v)) (right ((space ts v) c))"
        using Abs_real_int_inverse Rep_real_int_inverse inside_v
        len_v_borders local.less_eq by auto
      have left_len_eq:
        " max (left (ext v)) (left (space ts v c))
        = max (left (ext v1)) (left (space ts v c))"
        using assm hchop_def real_int.rchop_def  by auto
      have right_len_leq:
        "  min (right (ext v)) (right (space ts v c))
         \<ge> min (right (ext v1)) (right (space ts v c))"
        by (metis (no_types, hide_lams) assm min.bounded_iff min_less_iff_conj not_le
            order_refl real_int.rchop_def view.h_chop_middle2 view.hchop_def)
      hence left_geq_right:
        "  max (left (ext v1)) (left (space ts v c))
         \<ge> min (right (ext v1)) (right (space ts v c))"
        using left_len_eq len_v_empty by auto
      thus "\<parallel>len v1 ( ts) c\<parallel> = 0"
      proof -
        have f1:
          " \<not> max (left (ext v)) (left (space ts v c))
            \<le> min (right (ext v1)) (right (space ts v c))
          \<or>
              min (right (ext v1)) (right (space ts v c))
            = max (left (ext v)) (left (space ts v c))"
          by (metis antisym_conv left_geq_right left_len_eq)
        have
          "\<And>r. \<not> left (ext v1) \<le> r
             \<or> \<not> left (space ts v c) \<le> r
             \<or> max (left (ext v)) (left (space ts v c)) \<le> r"
          using left_len_eq by auto
        then have
          "  min (right (ext v1)) (right (space ts v c))
           = max (left (ext v)) (left (space ts v c))"
          using f1 inside_v left_inside_v1 real_int.left_leq_right by force
        then show ?thesis
          using assm left_len_eq len_v len_v1 len_v_empty by auto
      qed
    qed
  qed
qed
*)

lemma len_empty_on_subview2:
  "\<parallel>len v ts c\<parallel> = 0 \<and> (v=v1\<parallel>v2) \<longrightarrow> \<parallel>len v2 ts c\<parallel> = 0"
  using rchop_intersect_empty_right
  using len_def space_def view.hchop_def by auto

(*
proof
  assume assm:"\<parallel>len v ( ts) c\<parallel> = 0 \<and> (v=v1\<parallel>v2)"
  then have len_v_borders:"left (len v ( ts) c) = right (len v ( ts) c)"
     by (simp add:real_int.length_zero_iff_borders_eq)
  show "\<parallel>len v2 ( ts) c\<parallel> = 0"
  proof (cases "left ((space ts v) c) > right (ext v2)")
    assume left_outside_v2:"left ((space ts v) c) > right (ext v2)"
    thus "\<parallel>len v2 ( ts) c\<parallel> = 0"
      using Abs_real_int_inverse assm fst_conv hchop_def len_def
        real_int.length_zero_iff_borders_eq mem_Collect_eq snd_conv space_def
      by auto
  next
    assume left_inside_v2:"\<not>left (space ts v c) > right (ext v2)"
    show "\<parallel>len v2 ( ts) c\<parallel> = 0"
    proof (cases "left (ext v2) > right (space ts v c)")
      assume right_outside_v2:"left (ext v2) > right ((space ts v) c)"
      thus "\<parallel>len v2 ( ts) c\<parallel> = 0"
        using Abs_real_int_inverse assm fst_conv hchop_def len_def
          real_int.length_zero_iff_borders_eq mem_Collect_eq snd_conv
          right_outside_v2 space_def
        by auto
    next
      assume right_inside_v2:"\<not>left (ext v2) > right ((space ts v) c)"
      have len_v2:
        "len v2 ts c = Abs_real_int (max (left (ext v2)) (left (space ts v c)),
                                     min (right (ext v2)) (right (space ts v c)))"
        using left_inside_v2 len_def right_inside_v2 assm hchop_def space_def by auto
      from left_inside_v2 and right_inside_v2 have inside_v:
        "\<not>left ((space ts v) c) > right (ext v) \<and> \<not>left (ext v) > right ((space ts v) c)"
      proof -
        have "left (ext v) \<le> right (ext v1)"
          using assm view.h_chop_middle1 by auto
        then show ?thesis
          using assm left_inside_v2 real_int.rchop_def right_inside_v2 view.hchop_def
          by force
      qed
      hence len_v:
        "len v ts c = Abs_real_int (max (left (ext v)) (left (space ts v c)),
                                    min (right (ext v)) (right (space ts v c)))"
        by (simp add: len_def)
      have less_eq:
        "  max (left (ext v)) (left (space ts v c))
         \<le> min (right (ext v)) (right (space ts v c))"
        using inside_v real_int.left_leq_right by auto
      from len_v have len_v_empty:
        "  max (left (ext v)) (left (space ts v c))
         = min (right (ext v)) (right (space ts v c))"
        using Abs_real_int_inverse Rep_real_int_inverse inside_v
        using len_v_borders local.less_eq by auto
      have left_len_eq:
        "  max (left (ext v)) (left (space ts v c))
        \<le> max (left (ext v2)) (left (space ts v c))"
        by (metis (no_types, hide_lams) assm left_leq_right max.mono order_refl
            real_int.rchop_def view.hchop_def)
      have right_len_leq:
        "  min (right (ext v)) (right (space ts v c))
         = min (right (ext v2)) (right (space ts v c))"
        using assm real_int.rchop_def view.hchop_def by auto
      hence left_geq_right:
        " max (left (ext v2)) (left (space ts v c))
        \<ge> min (right (ext v2)) (right (space ts v c))"
        using left_len_eq len_v_empty by auto
      then have
        "  max (left (ext v2)) (left (space ts v2 c))
         \<ge> min (right (ext v2)) (right (space ts v2 c))"
        using assm hchop_def space_def  by auto
      then have
        "  max (left (ext v2)) (left (space ts v2 c))
         = min (right (ext v2)) (right (space ts v2 c))"
        by (metis (no_types, hide_lams) antisym_conv assm hchop_def len_v_empty
            max_def min.bounded_iff not_le space_def right_inside_v2 right_len_leq
            view.h_chop_middle2)
      thus "\<parallel>len v2 ( ts) c\<parallel> = 0"
        by (metis (no_types, hide_lams)  assm hchop_def len_v len_v2 len_v_empty
            space_def right_len_leq)
    qed
  qed
qed
*)

lemma len_hchop_add:
  "(v=v1\<parallel>v2) \<longrightarrow> \<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>" using rchop_intersect_add
  using len_def space_def view.hchop_def by auto
(*
proof
  assume chop:"v=v1\<parallel>v2"
  show "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>"
  proof (cases "left ((space ts v) c) > right (ext v)")
    assume outside_right:"left (space ts v c) > right (ext v)"
    hence len_zero:"\<parallel>len v ( ts) c\<parallel> = 0"
      by (simp add: Abs_real_int_inverse  len_def real_int.length_zero_iff_borders_eq
          snd_eqD)
    with chop have "\<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel> = 0"
      by (metis add_cancel_right_left len_empty_on_subview1 len_empty_on_subview2)
    thus ?thesis using len_zero by (simp)
  next
    assume inside_right:"\<not>left ((space ts v) c) > right (ext v)"
    show "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>"
    proof (cases " left (ext v) > right ((space ts v) c) ")
      assume outside_left:" left (ext v) > right (space ts v c) "
      hence len_zero:"\<parallel>len v ( ts) c\<parallel> = 0"
        by (simp add: Abs_real_int_inverse len_def real_int.length_zero_iff_borders_eq
            snd_eqD)
      with chop have "\<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel> = 0"
        by (metis add_cancel_right_left len_empty_on_subview1 len_empty_on_subview2)
      thus ?thesis using len_zero by (simp )
    next
      assume inside_left:" \<not>left (ext v) > right ((space ts v) c) "
      hence len_def_v:"len v ( ts) c =
                Abs_real_int ((max (left (ext v)) (left ((space ts v) c))),
                              min (right (ext v)) (right ((space ts v) c)))"
        using len_def inside_left inside_right by simp
      from inside_left and inside_right have
        len_in_type:"(max (left (ext v)) (left ((space ts v) c)),
                      min (right (ext v)) (right ((space ts v) c)))
                     \<in> {r :: real*real . fst r \<le> snd r}"
        using CollectD CollectI Rep_real_int fst_conv snd_conv by auto
      show "\<parallel>len v ( ts) c\<parallel> = \<parallel>len v1 ( ts) c\<parallel> + \<parallel>len v2 ( ts) c\<parallel>"
      proof (cases "right (len v ( ts) c) < right (ext v1)")
        assume inside_v1:"right (len v ( ts) c) < right (ext v1)"
        then have min_less_v1:
          "min (right (ext v)) (right (space ts v c)) < right (ext v1)"
          using Abs_real_int_inverse len_in_type len_def_v by auto
        hence outside_v2:"right ((space ts v) c) < left (ext v2)"
        proof -
          have "left (ext v2) = right (ext v1)"
            using chop real_int.rchop_def view.hchop_def by force
          then show ?thesis
            by (metis (no_types) chop dual_order.order_iff_strict
                min_less_iff_conj min_less_v1 not_less view.h_chop_middle2)
        qed
        hence len_v2_0:"\<parallel>len v2 ( ts) c\<parallel> = 0" using  Abs_real_int_inverse len_def
            real_int.length_zero_iff_borders_eq outside_v2  snd_eqD Rep_real_int_inverse
            chop hchop_def prod.collapse real_int.rchop_def real_int.chop_singleton_right
            space_def
            by auto
        have inside_left_v1:"  \<not>left (ext v1) > right ((space ts v) c) "
          using chop hchop_def inside_left real_int.rchop_def  by auto
        have inside_right_v1:"\<not>left ((space ts v) c) > right (ext v1)"
          by (meson inside_right less_trans min_less_iff_disj min_less_v1
              order.asym space_nonempty)
        have len1_def:"len v1 ( ts) c =
                Abs_real_int ((max (left (ext v1)) (left ((space ts v) c))),
                              min (right (ext v1)) (right ((space ts v) c)))"
          using len_def inside_left_v1 inside_right_v1 chop hchop_def space_def
          by auto
        hence "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel>"
        proof -
          have "right (ext v1) \<le> right (ext v2)"
            using chop left_leq_right real_int.rchop_def view.hchop_def by auto
          then show ?thesis
            using chop len1_def len_def_v min_less_v1 real_int.rchop_def view.hchop_def
            by auto
        qed
        thus "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>"
          using len_v2_0 by (simp)
      next
        assume r_inside_v2:"\<not> right (len v ( ts) c) < right (ext v1)"
        show "\<parallel>len v ( ts) c\<parallel> = \<parallel>len v1 ( ts) c\<parallel> + \<parallel>len v2 ( ts) c\<parallel>"
        proof (cases "left (len v ( ts) c) > left (ext v2)")
          assume inside_v2:"left (len v ( ts) c) > left (ext v2)"
          hence max_geq_v1:"max (left (ext v)) (left ((space ts v) c)) > left (ext v2)"
            using Abs_real_int_inverse len_in_type len_def by (simp )
          hence outside_v1:"left ((space ts v) c) > right (ext v1)"
          proof -
            have "left (ext v) \<le> right (ext v1)"
              by (meson chop view.h_chop_middle1)
            then show ?thesis
              using chop max_geq_v1 real_int.rchop_def view.hchop_def by fastforce
          qed
          hence len_v1_0:"\<parallel>len v1 ts c\<parallel> = 0"
            using Abs_real_int_inverse len_def real_int.length_zero_iff_borders_eq
              outside_v1 snd_eqD Rep_real_int_inverse chop hchop_def prod.collapse
              real_int.rchop_def real_int.chop_singleton_right space_def
            by auto
          have inside_left_v2:"  \<not>left (ext v2) > right ((space ts v) c) "
            by (meson inside_left less_max_iff_disj less_trans max_geq_v1 order.asym
                space_nonempty)
          have inside_right_v2:"\<not>left ((space ts v) c) > right (ext v2)"
            using chop hchop_def inside_right real_int.rchop_def  by auto
          have len2_def:"len v2 ( ts) c =
                Abs_real_int ((max (left (ext v2)) (left ((space ts v) c))),
                              min (right (ext v2)) (right ((space ts v) c)))"
            using len_def inside_left_v2 inside_right_v2 hchop_def chop space_def
            by auto
          hence "\<parallel>len v ts c\<parallel> = \<parallel>len v2 ts c\<parallel>"
          proof -
            have "left (ext v) \<le> left (ext v2)"
              by (metis (no_types) chop real_int.rchop_def view.h_chop_middle1
                  view.hchop_def)
            then show ?thesis
              using chop inside_left inside_right len2_def len_def outside_v1
                real_int.rchop_def view.hchop_def
              by auto
          qed
          thus "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>"
            using len_v1_0 by (simp)
        next
          assume l_inside_v1: "\<not>left (len v ( ts) c) > left (ext v2)"
          have inside_left_v1:"  \<not>left (ext v1) > right ((space ts v) c) "
            using chop hchop_def inside_left real_int.rchop_def  by auto
          have inside_right_v1:"\<not>left ((space ts v) c) > right (ext v1)"
            using Abs_real_int_inverse chop hchop_def l_inside_v1 len_in_type
              len_def real_int.rchop_def
            by auto
          hence len1_def:"len v1 ( ts) c =
                Abs_real_int ((max (left (ext v1)) (left ((space ts v) c))),
                              min (right (ext v1)) (right ((space ts v) c)))"
            using inside_left_v1 inside_right_v1 len_def chop hchop_def space_def
            by (simp )
          from inside_left_v1 and inside_right_v1 have len1_in_type:
            "(max (left (ext v1)) (left (space ts v c)),
              min (right (ext v1)) (right (space ts v c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
            using CollectD CollectI Rep_real_int fst_conv snd_conv by auto
          have inside_left_v2:"  \<not>left (ext v2) > right ((space ts v) c) "
            using real_int.rchop_def hchop_def inside_left chop Abs_real_int_inverse
              len_def_v len_in_type r_inside_v2 snd_conv
            by auto
          have inside_right_v2:"\<not>left ((space ts v) c) > right (ext v2)"
            using Abs_real_int_inverse chop hchop_def l_inside_v1 len_in_type len_def
              real_int.rchop_def
            by auto
          hence len2_def:"len v2 ts c =
                Abs_real_int (max (left (ext v2)) (left (space ts v c)),
                              min (right (ext v2)) (right (space ts v c)))"
            using inside_left_v2 inside_right_v2 len_def chop hchop_def space_def
            by (auto )
          from inside_left_v2 and inside_right_v2 have len2_in_type:
            "(max (left (ext v2)) (left (space ts v c)),
              min (right (ext v2)) (right (space ts v c)))
            \<in> {r :: real*real . fst r \<le> snd r}"
            using CollectD CollectI Rep_real_int fst_conv snd_conv
            by auto
          have left_v_v1:"left (ext v) = left (ext v1)"
            using chop hchop_def real_int.rchop_def  by auto
          have max:
               "max (left (ext v)) (left (space ts v c)) =
                max (left (ext v1)) (left (space ts v c))"
            using left_v_v1 by auto
          have right_v_v2:"right (ext v) = right (ext v2)"
            using chop hchop_def real_int.rchop_def  by auto
          have min: "(min (right (ext v)) (right ((space ts v) c))) =
                (min (right (ext v2)) (right ((space ts v) c)))"
            using right_v_v2 by auto
          from max have left_len_v1_v:"left (len v ( ts) c) = left (len v1 ( ts) c)"
            using Abs_real_int_inverse fst_conv len1_def len1_in_type
              len_def_v len_in_type
            by auto
          from min have right_len_v2_v:"right (len v ( ts) c) = right (len v2 ( ts) c)"
            using Abs_real_int_inverse fst_conv len1_def len2_in_type len_def_v
              len_in_type using len2_def snd_eqD by auto
          have "right (len v1 ( ts) c) = left (len v2 ( ts) c)"
            using Abs_real_int_inverse chop hchop_def len1_def len1_in_type len2_def
              len2_in_type real_int.rchop_def
            by auto
          thus "\<parallel>len v ts c\<parallel> = \<parallel>len v1 ts c\<parallel> + \<parallel>len v2 ts c\<parallel>"
            using left_len_v1_v real_int.consec_add right_len_v2_v  by simp
        qed
      qed
    qed
  qed
qed
*)
lemma len_non_empty_inside:
 "\<parallel>len v ( ts) c\<parallel> > 0
  \<longrightarrow> left (space ts v c) < right (ext v) \<and> right (space ts v c) > left (ext v)"
  using intersect_length_not_empty
  by (simp add: len_def)
(*proof
  assume assm: "\<parallel>len v ( ts) c\<parallel> > 0"
  show "left ((space ts v) c) < right (ext v) \<and> right ((space ts v) c) > left (ext v)"
  proof (rule ccontr)
    assume "\<not>(left ((space ts v) c) < right (ext v)
              \<and> right ((space ts v) c) > left (ext v))"
    hence "\<not>left ((space ts v) c) < right (ext v)
          \<or> \<not>right ((space ts v) c) > left (ext v)"
      by best
    thus False
    proof
      assume "\<not>left ((space ts v) c) < right (ext v)"
      hence "(left ((space ts v) c) = right (ext v))
            \<or> left ((space ts v) c) > right (ext v)"
        by auto
      thus False
      proof
        assume left_eq:"left ((space ts v) c) = right (ext v)"
        hence inside_left:"right ((space ts v) c) \<ge> left (ext v)"
          by (metis order_trans real_int.left_leq_right)
        from left_eq and inside_left have len_v:
          "len v ( ts) c = Abs_real_int (max (left (ext v)) (left (space ts v c)),
                                         min (right (ext v)) (right (space ts v c)))"
          using len_def by auto
        hence "len v ( ts) c = Abs_real_int (left (space ts v c), left(space ts v c))"
          by (metis left_eq max_def min_def real_int.left_leq_right)
        thus False using Abs_real_int_inverse assm real_int.length_def by auto
      next
        assume "left ((space ts v) c) > right (ext v)"
        thus False
          using Abs_real_int_inverse assm len_def real_int.length_def by auto
      qed
    next
      assume "\<not>right ((space ts v) c) > left (ext v)"
      hence " right ((space ts v) c) = left (ext v)
            \<or> right ((space ts v) c) < left (ext v)"
        by auto
      thus False
      proof
        assume right_eq:"right ((space ts v) c) = left (ext v)"
        hence inside_right:"right (ext v) \<ge> left ((space ts v) c)"
          by (metis order_trans real_int.left_leq_right)
        from right_eq and inside_right have len_v:
          "len v ts c = Abs_real_int (max (left (ext v)) (left (space ts v c)),
                              min (right (ext v)) (right (space ts v c)))"
          using len_def by auto
        hence
          "len v ( ts) c = Abs_real_int(right (space ts v c), right (space ts v c))"
          by (metis max.commute max_def min_def real_int.left_leq_right right_eq)
        thus False using Abs_real_int_inverse assm real_int.length_def by auto
      next
        assume right_le:"right ((space ts v) c) < left (ext v)"
        thus False
          by (metis (no_types, hide_lams) Rep_real_int_inverse assm left.rep_eq len_def
              length_zero_iff_borders_eq less_irrefl prod.collapse real_int.rchop_def
              right.rep_eq view.hchop_def view.horizontal_chop_empty_left
              view.horizontal_chop_empty_right)
      qed
    qed
  qed
qed
*)

lemma len_fills_subview:
  "\<parallel>len v ts c\<parallel> > 0
      \<longrightarrow> (\<exists> v1 v2 v3 v'. (v=v1\<parallel>v2) \<and> (v2=v'\<parallel>v3) \<and> len v' ts c = ext v' \<and>
                          \<parallel>len v' ts c\<parallel> = \<parallel>len v ts c\<parallel>)"
proof
  assume assm: "\<parallel>len v ( ts) c\<parallel> > 0"
  then obtain e1 e2 e3 e' where "R_Chop(ext v,e1,e2) \<and> R_Chop(e2,e',e3)  \<and> intersect e' (space ts v c) = e' \<and> \<parallel>len v ts c\<parallel> = \<parallel>intersect e' (space ts v c) \<parallel>"
    using intersect_fills_chop len_def
    by fastforce
  obtain v1 where v1:"ext v1 = e1 \<and> lan v1 = lan v \<and> own v1 = own v"
    by (metis Abs_view_inverse basic_view.simps(1) basic_view.simps(2) basic_view.simps(3) ext.rep_eq horizontal_chop_empty_right horizontal_chop_lanes_continuous lan.rep_eq mem_Collect_eq own.rep_eq)
  obtain v2 where v2:"ext v2 = e2 \<and> lan v2 = lan v \<and> own v2 = own v"
    by (metis Abs_view_inverse basic_view.simps(1) basic_view.simps(2) basic_view.simps(3) ext.rep_eq horizontal_chop_empty_right horizontal_chop_lanes_continuous lan.rep_eq mem_Collect_eq own.rep_eq)
  obtain v3 where v3:"ext v3 = e3 \<and> lan v3 = lan v \<and> own v3 = own v"
    by (metis Abs_view_inverse basic_view.simps(1) basic_view.simps(2) basic_view.simps(3) ext.rep_eq horizontal_chop_empty_right horizontal_chop_lanes_continuous lan.rep_eq mem_Collect_eq own.rep_eq)
  obtain v' where v':"ext v' = e' \<and> lan v' = lan v \<and> own v' = own v"
    by (metis Abs_view_inverse basic_view.simps(1) basic_view.simps(2) basic_view.simps(3) ext.rep_eq horizontal_chop_empty_right horizontal_chop_lanes_continuous lan.rep_eq mem_Collect_eq own.rep_eq)
  have h:"space ts v c = space ts v' c"
    by (simp add: space_def v')
  then have 1:"len v' ts c = ext v'"
   using \<open>R_Chop(Views.ext v,e1,e2) \<and> R_Chop(e2,e',e3) \<and> intersect e' (space ts v c) = e' \<and> \<parallel>len v ts c\<parallel> = \<parallel>intersect e' (space ts v c)\<parallel>\<close> len_def v' by auto
  have 2:"\<parallel>len v ts c\<parallel> = \<parallel>len v' ts c\<parallel>" using h
    using "1" \<open>R_Chop(Views.ext v,e1,e2) \<and> R_Chop(e2,e',e3) \<and> intersect e' (space ts v c) = e' \<and> \<parallel>len v ts c\<parallel> = \<parallel>intersect e' (space ts v c)\<parallel>\<close> v' by auto
  show " \<exists> v1 v2 v3 v'. (v=v1\<parallel>v2) \<and> (v2=v'\<parallel>v3) \<and> len v' ( ts) c = ext v' \<and>
          \<parallel>len v' ( ts) c\<parallel> = \<parallel>len v ( ts) c\<parallel>" using 1 2
    by (metis \<open>R_Chop(Views.ext v,e1,e2) \<and> R_Chop(e2,e',e3) \<and> intersect e' (space ts v c) = e' \<and> \<parallel>len v ts c\<parallel> = \<parallel>intersect e' (space ts v c)\<parallel>\<close> \<open>\<And>thesis. (\<And>v2. Views.ext v2 = e2 \<and> Views.lan v2 = Views.lan v \<and> Views.own v2 = Views.own v \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> v' v1 v3 view.hchop_def)
qed
(*  proof -
    from assm have inside:
      "left ((space ts v) c) < right (ext v) \<and> right ((space ts v) c) > left (ext v)"
      using len_non_empty_inside by auto
    hence len_v:
      "len v ( ts) c = Abs_real_int (max (left (ext v)) (left (space ts v c)),
                              min (right (ext v)) (right (space ts v c)))"
      using len_def by auto
    obtain v1 and v2 and v3 and v'
      where v1:
        "v1=Abs_view \<lparr>basic_view.ext =Abs_real_int(left(ext v), left (len v ts c)),
             lan = lan v,
             own = own v\<rparr>"
      and v2:
      "v2= \<lparr>basic_view.ext =Abs_real_int(left(len v ts c), right (ext v)),
           lan = lan v,
           own = own v\<rparr>"
      and v':
      "v'= \<lparr>basic_view.ext =Abs_real_int(left(len v ts c), right (len v ts c)),
           lan = lan v,
           own = own v\<rparr>"
      and v3:
      "v3= \<lparr>basic_view.ext =Abs_real_int(right(len v ts c), right (ext v)),
           lan = lan v,
           own = own v\<rparr>"
      by blast
    have "left (ext (Abs_view v2)) = left (ext (Abs_view v'))"
    have "(Abs_view v2)=(Abs_view v')\<parallel>(Abs_view v3)" using hchop_def v2 v' v3 Abs_real_int_inverse Abs_view_inverse
    hence 1:" (v=v1\<parallel>v2) \<and> (v2=v'\<parallel>v3)" using v1 v2 v3 v'
      using inside hchop_def real_int.rchop_def Abs_real_int_inverse real_int.left_leq_right
        v1 v2 v' v3 len_def Abs_view_inverse
      by auto
    have right:"right (ext v') = right (len v ts c)"
      by (simp add: Rep_real_int_inverse  v')
    then have right':"left ((space ts v) c) \<le> right (ext v')"
      by (metis inside len_space_left less_imp_le order_trans real_int.left_leq_right)
    have left:"left (ext v') = left (len v ts c)"
      by (simp add: Rep_real_int_inverse  v')
    then have left':"right ((space ts v) c) \<ge> left (ext v')"
      by (metis inside len_space_right less_imp_le order_trans real_int.left_leq_right)
    have inside':
      "left ((space ts v) c) < right (ext v') \<and> right ((space ts v) c) > left (ext v')"
      by (metis (no_types) left' right' antisym_conv assm inside left len_space_left
          len_space_right less_imp_le not_le real_int.left_leq_right
          real_int.length_zero_iff_borders_eq right)
    have inside'':
      "left (space ts v' c) < right (ext v') \<and> right (space ts v' c) > left (ext v')"
      using "1" hchop_def inside' sensors.space_def sensors_axioms
      by auto
    have len_v_v':"len v ts c = ext v'"
      by (metis left prod.collapse right left.rep_eq right.rep_eq Rep_real_int_inverse)
    have "left (len v ts c) = max (left (ext v)) (left ((space ts v) c)) "
      using len_v Abs_real_int_inverse Rep_real_int inside
      by auto
    with left have left_len':"left (ext v') = max (left (ext v)) (left (space ts v c))"
      by auto
    then have left_len:"left (ext v') = max (left (ext v')) (left (space ts v' c))"
      using "1"  hchop_def space_def  by fastforce
    have "right (len v ts c) = min (right (ext v)) (right ((space ts v) c))"
      using len_v Abs_real_int_inverse inside Rep_real_int by auto
    with right have right_len':
      "right (ext v') = min (right (ext v)) (right (space ts v c))"
      by auto
    then have right_len:
      "right (ext v') = min (right (ext v')) (right (space ts v' c))"
      using "1"  hchop_def space_def by fastforce
    have 2:"len v' ( ts) c = ext v'"
      by (metis left_len' right_len' len_v len_v_v' order.asym inside''
          len_def left_len right_len)
    have 3:"  \<parallel>len v' ( ts) c\<parallel> = \<parallel>len v ( ts) c\<parallel>"
      using len_left len_right hchop_def
      by (simp add: "2" len_v_v')
    then show ?thesis using 1 2 3 by blast
  qed
qed
*)
lemma ext_eq_len_eq:
  "ext v = ext v'\<and> own v = own v' \<longrightarrow> len v ts c = len v' ts c"
  using left_space right_space sensors.len_def sensors_axioms
  by (simp add: space_def)

lemma len_stable_down:"(v=v1--v2) \<longrightarrow> len v ts c = len v1 ts c"
  using ext_eq_len_eq view.vchop_def by blast

lemma len_stable_up:"(v=v1--v2) \<longrightarrow> len v ts c = len v2 ts c"
  using ext_eq_len_eq view.vchop_def by blast

lemma len_empty_subview:"\<parallel>len v ts c\<parallel> = 0 \<and> (v' \<le> v) \<longrightarrow> \<parallel>len v' ts c\<parallel> = 0"
proof
  assume assm:"\<parallel>len v ts c\<parallel> = 0 \<and> (v' \<le> v)"
  hence "\<exists>v1 v2 v3 vl vr vu vd. (v=vl\<parallel>v1) \<and> (v1=v2\<parallel>vr) \<and> (v2=vd--v3) \<and> (v3=v'--vu)" using
      somewhere_leq   by auto
  then obtain v1 v2 v3 vl vr vu vd
    where views:"(v=vl\<parallel>v1) \<and> (v1=v2\<parallel>vr) \<and> (v2=vd--v3) \<and> (v3=v'--vu)"
    by blast
  have "\<parallel>len v1 ts c\<parallel> = 0" using views assm len_empty_on_subview2 by blast
  hence "\<parallel>len v2 ts c\<parallel> = 0" using views len_empty_on_subview1 by blast
  hence "\<parallel>len v3 ts c \<parallel> = 0" using views len_stable_up by auto
  thus "\<parallel>len v' ts c \<parallel> = 0" using views len_stable_down by auto
qed

lemma view_leq_len_leq:"(ext v \<le> ext v') \<and> (own v = own v') \<and> \<parallel>len v ts c\<parallel> > 0
                          \<longrightarrow> len v ts c \<le> len v' ts c"
  using Abs_real_int_inverse  length_def length_ge_zero less_eq_real_int_def
    sensors.len_def sensors.space_def sensors_axioms leq_intersect_leq
  by (metis len_def less_irrefl space_def)

end
end


(*  Title:      HOL/Decision_Procs/Algebra_Aux.thy
    Author:     Stefan Berghofer
*)

section \<open>Things that can be added to the Algebra library\<close>

theory Algebra_Aux
  imports "HOL-Algebra.Ring"
begin

definition of_natural :: "('a, 'm) ring_scheme \<Rightarrow> nat \<Rightarrow> 'a" ("\<guillemotleft>_\<guillemotright>\<^sub>\<nat>\<index>")
  where "\<guillemotleft>n\<guillemotright>\<^sub>\<nat>\<^bsub>R\<^esub> = ((\<oplus>\<^bsub>R\<^esub>) \<one>\<^bsub>R\<^esub> ^^ n) \<zero>\<^bsub>R\<^esub>"

definition of_integer :: "('a, 'm) ring_scheme \<Rightarrow> int \<Rightarrow> 'a" ("\<guillemotleft>_\<guillemotright>\<index>")
  where "\<guillemotleft>i\<guillemotright>\<^bsub>R\<^esub> = (if 0 \<le> i then \<guillemotleft>nat i\<guillemotright>\<^sub>\<nat>\<^bsub>R\<^esub> else \<ominus>\<^bsub>R\<^esub> \<guillemotleft>nat (- i)\<guillemotright>\<^sub>\<nat>\<^bsub>R\<^esub>)"

context ring
begin

lemma of_nat_0 [simp]: "\<guillemotleft>0\<guillemotright>\<^sub>\<nat> = \<zero>"
  by (simp add: of_natural_def)

lemma of_nat_Suc [simp]: "\<guillemotleft>Suc n\<guillemotright>\<^sub>\<nat> = \<one> \<oplus> \<guillemotleft>n\<guillemotright>\<^sub>\<nat>"
  by (simp add: of_natural_def)

lemma of_int_0 [simp]: "\<guillemotleft>0\<guillemotright> = \<zero>"
  by (simp add: of_integer_def)

lemma of_nat_closed [simp]: "\<guillemotleft>n\<guillemotright>\<^sub>\<nat> \<in> carrier R"
  by (induct n) simp_all

lemma of_int_closed [simp]: "\<guillemotleft>i\<guillemotright> \<in> carrier R"
  by (simp add: of_integer_def)

lemma of_int_minus [simp]: "\<guillemotleft>- i\<guillemotright> = \<ominus> \<guillemotleft>i\<guillemotright>"
  by (simp add: of_integer_def)

lemma of_nat_add [simp]: "\<guillemotleft>m + n\<guillemotright>\<^sub>\<nat> = \<guillemotleft>m\<guillemotright>\<^sub>\<nat> \<oplus> \<guillemotleft>n\<guillemotright>\<^sub>\<nat>"
  by (induct m) (simp_all add: a_ac)

lemma of_nat_diff [simp]: "n \<le> m \<Longrightarrow> \<guillemotleft>m - n\<guillemotright>\<^sub>\<nat> = \<guillemotleft>m\<guillemotright>\<^sub>\<nat> \<ominus> \<guillemotleft>n\<guillemotright>\<^sub>\<nat>"
proof (induct m arbitrary: n)
  case 0
  then show ?case by (simp add: minus_eq)
next
  case Suc': (Suc m)
  show ?case
  proof (cases n)
    case 0
    then show ?thesis
      by (simp add: minus_eq)
  next
    case (Suc k)
    with Suc' have "\<guillemotleft>Suc m - Suc k\<guillemotright>\<^sub>\<nat> = \<guillemotleft>m\<guillemotright>\<^sub>\<nat> \<ominus> \<guillemotleft>k\<guillemotright>\<^sub>\<nat>" by simp
    also have "\<dots> = \<one> \<oplus> \<ominus> \<one> \<oplus> (\<guillemotleft>m\<guillemotright>\<^sub>\<nat> \<ominus> \<guillemotleft>k\<guillemotright>\<^sub>\<nat>)"
      by (simp add: r_neg)
    also have "\<dots> = \<guillemotleft>Suc m\<guillemotright>\<^sub>\<nat> \<ominus> \<guillemotleft>Suc k\<guillemotright>\<^sub>\<nat>"
      by (simp add: minus_eq minus_add a_ac)
    finally show ?thesis using Suc by simp
  qed
qed

lemma of_int_add [simp]: "\<guillemotleft>i + j\<guillemotright> = \<guillemotleft>i\<guillemotright> \<oplus> \<guillemotleft>j\<guillemotright>"
proof (cases "0 \<le> i")
  case True
  show ?thesis
  proof (cases "0 \<le> j")
    case True
    with \<open>0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def nat_add_distrib)
  next
    case False
    show ?thesis
    proof (cases "0 \<le> i + j")
      case True
      then have "\<guillemotleft>i + j\<guillemotright> = \<guillemotleft>nat (i - (- j))\<guillemotright>\<^sub>\<nat>"
        by (simp add: of_integer_def)
      also from True \<open>0 \<le> i\<close> \<open>\<not> 0 \<le> j\<close>
      have "nat (i - (- j)) = nat i - nat (- j)"
        by (simp add: nat_diff_distrib)
      finally show ?thesis using True \<open>0 \<le> i\<close> \<open>\<not> 0 \<le> j\<close>
        by (simp add: minus_eq of_integer_def)
    next
      case False
      then have "\<guillemotleft>i + j\<guillemotright> = \<ominus> \<guillemotleft>nat (- j - i)\<guillemotright>\<^sub>\<nat>"
        by (simp add: of_integer_def) (simp only: diff_conv_add_uminus add_ac)
      also from False \<open>0 \<le> i\<close> \<open>\<not> 0 \<le> j\<close>
      have "nat (- j - i) = nat (- j) - nat i"
        by (simp add: nat_diff_distrib)
      finally show ?thesis using False \<open>0 \<le> i\<close> \<open>\<not> 0 \<le> j\<close>
        by (simp add: minus_eq minus_add a_ac of_integer_def)
    qed
  qed
next
  case False
  show ?thesis
  proof (cases "0 \<le> j")
    case True
    show ?thesis
    proof (cases "0 \<le> i + j")
      case True
      then have "\<guillemotleft>i + j\<guillemotright> = \<guillemotleft>nat (j - (- i))\<guillemotright>\<^sub>\<nat>"
        by (simp add: of_integer_def add_ac)
      also from True \<open>\<not> 0 \<le> i\<close> \<open>0 \<le> j\<close>
      have "nat (j - (- i)) = nat j - nat (- i)"
        by (simp add: nat_diff_distrib)
      finally show ?thesis using True \<open>\<not> 0 \<le> i\<close> \<open>0 \<le> j\<close>
        by (simp add: minus_eq minus_add a_ac of_integer_def)
    next
      case False
      then have "\<guillemotleft>i + j\<guillemotright> = \<ominus> \<guillemotleft>nat (- i - j)\<guillemotright>\<^sub>\<nat>"
        by (simp add: of_integer_def)
      also from False \<open>\<not> 0 \<le> i\<close> \<open>0 \<le> j\<close>
      have "nat (- i - j) = nat (- i) - nat j"
        by (simp add: nat_diff_distrib)
      finally show ?thesis using False \<open>\<not> 0 \<le> i\<close> \<open>0 \<le> j\<close>
        by (simp add: minus_eq minus_add of_integer_def)
    qed
  next
    case False
    with \<open>\<not> 0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def nat_add_distrib minus_add diff_conv_add_uminus
          del: add_uminus_conv_diff uminus_add_conv_diff)
  qed
qed

lemma of_int_diff [simp]: "\<guillemotleft>i - j\<guillemotright> = \<guillemotleft>i\<guillemotright> \<ominus> \<guillemotleft>j\<guillemotright>"
  by (simp only: diff_conv_add_uminus of_int_add) (simp add: minus_eq)

lemma of_nat_mult [simp]: "\<guillemotleft>i * j\<guillemotright>\<^sub>\<nat> = \<guillemotleft>i\<guillemotright>\<^sub>\<nat> \<otimes> \<guillemotleft>j\<guillemotright>\<^sub>\<nat>"
  by (induct i) (simp_all add: l_distr)

lemma of_int_mult [simp]: "\<guillemotleft>i * j\<guillemotright> = \<guillemotleft>i\<guillemotright> \<otimes> \<guillemotleft>j\<guillemotright>"
proof (cases "0 \<le> i")
  case True
  show ?thesis
  proof (cases "0 \<le> j")
    case True
    with \<open>0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def nat_mult_distrib zero_le_mult_iff)
  next
    case False
    with \<open>0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def zero_le_mult_iff
        minus_mult_right nat_mult_distrib r_minus
        del: minus_mult_right [symmetric])
  qed
next
  case False
  show ?thesis
  proof (cases "0 \<le> j")
    case True
    with \<open>\<not> 0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def zero_le_mult_iff
        minus_mult_left nat_mult_distrib l_minus
        del: minus_mult_left [symmetric])
  next
    case False
    with \<open>\<not> 0 \<le> i\<close> show ?thesis
      by (simp add: of_integer_def zero_le_mult_iff
        minus_mult_minus [of i j, symmetric] nat_mult_distrib
        l_minus r_minus
        del: minus_mult_minus
        minus_mult_left [symmetric] minus_mult_right [symmetric])
  qed
qed

lemma of_int_1 [simp]: "\<guillemotleft>1\<guillemotright> = \<one>"
  by (simp add: of_integer_def)

lemma of_int_2: "\<guillemotleft>2\<guillemotright> = \<one> \<oplus> \<one>"
  by (simp add: of_integer_def numeral_2_eq_2)

lemma minus_0_r [simp]: "x \<in> carrier R \<Longrightarrow> x \<ominus> \<zero> = x"
  by (simp add: minus_eq)

lemma minus_0_l [simp]: "x \<in> carrier R \<Longrightarrow> \<zero> \<ominus> x = \<ominus> x"
  by (simp add: minus_eq)

lemma eq_diff0:
  assumes "x \<in> carrier R" "y \<in> carrier R"
  shows "x \<ominus> y = \<zero> \<longleftrightarrow> x = y"
proof
  assume "x \<ominus> y = \<zero>"
  with assms have "x \<oplus> (\<ominus> y \<oplus> y) = y"
    by (simp add: minus_eq a_assoc [symmetric])
  with assms show "x = y" by (simp add: l_neg)
next
  assume "x = y"
  with assms show "x \<ominus> y = \<zero>" by (simp add: minus_eq r_neg)
qed

lemma power2_eq_square: "x \<in> carrier R \<Longrightarrow> x [^] (2::nat) = x \<otimes> x"
  by (simp add: numeral_eq_Suc)

lemma eq_neg_iff_add_eq_0:
  assumes "x \<in> carrier R" "y \<in> carrier R"
  shows "x = \<ominus> y \<longleftrightarrow> x \<oplus> y = \<zero>"
proof
  assume "x = \<ominus> y"
  with assms show "x \<oplus> y = \<zero>" by (simp add: l_neg)
next
  assume "x \<oplus> y = \<zero>"
  with assms have "x \<oplus> (y \<oplus> \<ominus> y) = \<zero> \<oplus> \<ominus> y"
    by (simp add: a_assoc [symmetric])
  with assms show "x = \<ominus> y"
    by (simp add: r_neg)
qed

lemma neg_equal_iff_equal:
  assumes x: "x \<in> carrier R" and y: "y \<in> carrier R"
  shows "\<ominus> x = \<ominus> y \<longleftrightarrow> x = y"
proof
  assume "\<ominus> x = \<ominus> y"
  then have "\<ominus> (\<ominus> x) = \<ominus> (\<ominus> y)" by simp
  with x y show "x = y" by simp
next
  assume "x = y"
  then show "\<ominus> x = \<ominus> y" by simp
qed

lemma neg_equal_swap:
  assumes x: "x \<in> carrier R" and y: "y \<in> carrier R"
  shows "(\<ominus> x = y) = (x = \<ominus> y)"
  using assms neg_equal_iff_equal [of x "\<ominus> y"]
  by simp

lemma mult2: "x \<in> carrier R \<Longrightarrow> x \<oplus> x = \<guillemotleft>2\<guillemotright> \<otimes> x"
  by (simp add: of_int_2 l_distr)

end

lemma (in cring) of_int_power [simp]: "\<guillemotleft>i ^ n\<guillemotright> = \<guillemotleft>i\<guillemotright> [^] n"
  by (induct n) (simp_all add: m_ac)

definition cring_class_ops :: "'a::comm_ring_1 ring"
  where "cring_class_ops \<equiv> \<lparr>carrier = UNIV, mult = (*), one = 1, zero = 0, add = (+)\<rparr>"

lemma cring_class: "cring cring_class_ops"
  apply unfold_locales
  apply (auto simp add: cring_class_ops_def ring_distribs Units_def)
  apply (rule_tac x="- x" in exI)
  apply simp
  done

lemma carrier_class: "x \<in> carrier cring_class_ops"
  by (simp add: cring_class_ops_def)

lemma zero_class: "\<zero>\<^bsub>cring_class_ops\<^esub> = 0"
  by (simp add: cring_class_ops_def)

lemma one_class: "\<one>\<^bsub>cring_class_ops\<^esub> = 1"
  by (simp add: cring_class_ops_def)

lemma plus_class: "x \<oplus>\<^bsub>cring_class_ops\<^esub> y = x + y"
  by (simp add: cring_class_ops_def)

lemma times_class: "x \<otimes>\<^bsub>cring_class_ops\<^esub> y = x * y"
  by (simp add: cring_class_ops_def)

lemma uminus_class: "\<ominus>\<^bsub>cring_class_ops\<^esub> x = - x"
  apply (simp add: a_inv_def m_inv_def cring_class_ops_def)
  apply (rule the_equality)
  apply (simp_all add: eq_neg_iff_add_eq_0)
  done

lemma minus_class: "x \<ominus>\<^bsub>cring_class_ops\<^esub> y = x - y"
  by (simp add: a_minus_def carrier_class plus_class uminus_class)

lemma power_class: "x [^]\<^bsub>cring_class_ops\<^esub> n = x ^ n"
  by (induct n) (simp_all add: one_class times_class
    monoid.nat_pow_0 [OF comm_monoid.axioms(1) [OF cring.axioms(2) [OF cring_class]]]
    monoid.nat_pow_Suc [OF comm_monoid.axioms(1) [OF cring.axioms(2) [OF cring_class]]])

lemma of_nat_class: "\<guillemotleft>n\<guillemotright>\<^sub>\<nat>\<^bsub>cring_class_ops\<^esub> = of_nat n"
  by (induct n) (simp_all add: cring_class_ops_def of_natural_def)

lemma of_int_class: "\<guillemotleft>i\<guillemotright>\<^bsub>cring_class_ops\<^esub> = of_int i"
  by (simp add: of_integer_def of_nat_class uminus_class)

lemmas class_simps = zero_class one_class plus_class minus_class uminus_class
  times_class power_class of_nat_class of_int_class carrier_class

interpretation cring_class: cring "cring_class_ops::'a::comm_ring_1 ring"
  rewrites "(\<zero>\<^bsub>cring_class_ops\<^esub>::'a) = 0"
    and "(\<one>\<^bsub>cring_class_ops\<^esub>::'a) = 1"
    and "(x::'a) \<oplus>\<^bsub>cring_class_ops\<^esub> y = x + y"
    and "(x::'a) \<otimes>\<^bsub>cring_class_ops\<^esub> y = x * y"
    and "\<ominus>\<^bsub>cring_class_ops\<^esub> (x::'a) = - x"
    and "(x::'a) \<ominus>\<^bsub>cring_class_ops\<^esub> y = x - y"
    and "(x::'a) [^]\<^bsub>cring_class_ops\<^esub> n = x ^ n"
    and "\<guillemotleft>n\<guillemotright>\<^sub>\<nat>\<^bsub>cring_class_ops\<^esub> = of_nat n"
    and "((\<guillemotleft>i\<guillemotright>\<^bsub>cring_class_ops\<^esub>)::'a) = of_int i"
    and "(Int.of_int (numeral m)::'a) = numeral m"
  by (simp_all add: cring_class class_simps)

lemma (in domain) nat_pow_eq_0_iff [simp]:
  "a \<in> carrier R \<Longrightarrow> (a [^] (n::nat) = \<zero>) = (a = \<zero> \<and> n \<noteq> 0)"
  by (induct n) (auto simp add: integral_iff)

lemma (in domain) square_eq_iff:
  assumes "x \<in> carrier R" "y \<in> carrier R"
  shows "(x \<otimes> x = y \<otimes> y) = (x = y \<or> x = \<ominus> y)"
proof
  assume "x \<otimes> x = y \<otimes> y"
  with assms have "(x \<ominus> y) \<otimes> (x \<oplus> y) = x \<otimes> y \<oplus> \<ominus> (x \<otimes> y) \<oplus> (y \<otimes> y \<oplus> \<ominus> (y \<otimes> y))"
    by (simp add: r_distr l_distr minus_eq r_minus m_comm a_ac)
  with assms show "x = y \<or> x = \<ominus> y"
    by (simp add: integral_iff eq_neg_iff_add_eq_0 eq_diff0 r_neg)
next
  assume "x = y \<or> x = \<ominus> y"
  with assms show "x \<otimes> x = y \<otimes> y"
    by (auto simp add: l_minus r_minus)
qed

definition m_div :: "('a, 'b) ring_scheme \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<oslash>\<index>" 70)
  where "x \<oslash>\<^bsub>G\<^esub> y = (if y = \<zero>\<^bsub>G\<^esub> then \<zero>\<^bsub>G\<^esub> else x \<otimes>\<^bsub>G\<^esub> inv\<^bsub>G\<^esub> y)"

context field
begin

lemma inv_closed [simp]: "x \<in> carrier R \<Longrightarrow> x \<noteq> \<zero> \<Longrightarrow> inv x \<in> carrier R"
  by (simp add: field_Units)

lemma l_inv [simp]: "x \<in> carrier R \<Longrightarrow> x \<noteq> \<zero> \<Longrightarrow> inv x \<otimes> x = \<one>"
  by (simp add: field_Units)

lemma r_inv [simp]: "x \<in> carrier R \<Longrightarrow> x \<noteq> \<zero> \<Longrightarrow> x \<otimes> inv x = \<one>"
  by (simp add: field_Units)

lemma inverse_unique:
  assumes a: "a \<in> carrier R"
    and b: "b \<in> carrier R"
    and ab: "a \<otimes> b = \<one>"
  shows "inv a = b"
proof -
  from ab b have *: "a \<noteq> \<zero>"
    by (cases "a = \<zero>") simp_all
  with a have "inv a \<otimes> (a \<otimes> b) = inv a"
    by (simp add: ab)
  with a b * show ?thesis
    by (simp add: m_assoc [symmetric])
qed

lemma nonzero_inverse_inverse_eq: "a \<in> carrier R \<Longrightarrow> a \<noteq> \<zero> \<Longrightarrow> inv (inv a) = a"
  by (rule inverse_unique) simp_all

lemma inv_1 [simp]: "inv \<one> = \<one>"
  by (rule inverse_unique) simp_all

lemma nonzero_inverse_mult_distrib:
  assumes "a \<in> carrier R" "b \<in> carrier R"
    and "a \<noteq> \<zero>" "b \<noteq> \<zero>"
  shows "inv (a \<otimes> b) = inv b \<otimes> inv a"
proof -
  from assms have "a \<otimes> (b \<otimes> inv b) \<otimes> inv a = \<one>"
    by simp
  with assms have eq: "a \<otimes> b \<otimes> (inv b \<otimes> inv a) = \<one>"
    by (simp only: m_assoc m_closed inv_closed assms)
  from assms show ?thesis
    using inverse_unique [OF _ _ eq] by simp
qed

lemma nonzero_imp_inverse_nonzero:
  assumes "a \<in> carrier R" and "a \<noteq> \<zero>"
  shows "inv a \<noteq> \<zero>"
proof
  assume *: "inv a = \<zero>"
  from assms have **: "\<one> = a \<otimes> inv a"
    by simp
  also from assms have "\<dots> = \<zero>" by (simp add: *)
  finally have "\<one> = \<zero>" .
  then show False by (simp add: eq_commute)
qed

lemma nonzero_divide_divide_eq_left:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> c \<in> carrier R \<Longrightarrow> b \<noteq> \<zero> \<Longrightarrow> c \<noteq> \<zero> \<Longrightarrow>
    a \<oslash> b \<oslash> c = a \<oslash> (b \<otimes> c)"
  by (simp add: m_div_def nonzero_inverse_mult_distrib m_ac integral_iff)

lemma nonzero_times_divide_eq:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> c \<in> carrier R \<Longrightarrow> d \<in> carrier R \<Longrightarrow>
    b \<noteq> \<zero> \<Longrightarrow> d \<noteq> \<zero> \<Longrightarrow> (a \<oslash> b) \<otimes> (c \<oslash> d) = (a \<otimes> c) \<oslash> (b \<otimes> d)"
  by (simp add: m_div_def nonzero_inverse_mult_distrib m_ac integral_iff)

lemma nonzero_divide_divide_eq:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> c \<in> carrier R \<Longrightarrow> d \<in> carrier R \<Longrightarrow>
    b \<noteq> \<zero> \<Longrightarrow> c \<noteq> \<zero> \<Longrightarrow> d \<noteq> \<zero> \<Longrightarrow> (a \<oslash> b) \<oslash> (c \<oslash> d) = (a \<otimes> d) \<oslash> (b \<otimes> c)"
  by (simp add: m_div_def nonzero_inverse_mult_distrib
    nonzero_imp_inverse_nonzero nonzero_inverse_inverse_eq m_ac integral_iff)

lemma divide_1 [simp]: "x \<in> carrier R \<Longrightarrow> x \<oslash> \<one> = x"
  by (simp add: m_div_def)

lemma add_frac_eq:
  assumes "x \<in> carrier R" "y \<in> carrier R" "z \<in> carrier R" "w \<in> carrier R"
    and "y \<noteq> \<zero>" "z \<noteq> \<zero>"
  shows "x \<oslash> y \<oplus> w \<oslash> z = (x \<otimes> z \<oplus> w \<otimes> y) \<oslash> (y \<otimes> z)"
proof -
  from assms
  have "x \<oslash> y \<oplus> w \<oslash> z = x \<otimes> inv y \<otimes> (z \<otimes> inv z) \<oplus> w \<otimes> inv z \<otimes> (y \<otimes> inv y)"
    by (simp add: m_div_def)
  also from assms have "\<dots> = (x \<otimes> z \<oplus> w \<otimes> y) \<oslash> (y \<otimes> z)"
    by (simp add: m_div_def nonzero_inverse_mult_distrib r_distr m_ac integral_iff del: r_inv)
  finally show ?thesis .
qed

lemma div_closed [simp]:
  "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> y \<noteq> \<zero> \<Longrightarrow> x \<oslash> y \<in> carrier R"
  by (simp add: m_div_def)

lemma minus_divide_left [simp]:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> b \<noteq> \<zero> \<Longrightarrow> \<ominus> (a \<oslash> b) = \<ominus> a \<oslash> b"
  by (simp add: m_div_def l_minus)

lemma diff_frac_eq:
  assumes "x \<in> carrier R" "y \<in> carrier R" "z \<in> carrier R" "w \<in> carrier R"
    and "y \<noteq> \<zero>" "z \<noteq> \<zero>"
  shows "x \<oslash> y \<ominus> w \<oslash> z = (x \<otimes> z \<ominus> w \<otimes> y) \<oslash> (y \<otimes> z)"
  using assms by (simp add: minus_eq l_minus add_frac_eq)

lemma nonzero_mult_divide_mult_cancel_left [simp]:
  assumes "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
    and "b \<noteq> \<zero>" "c \<noteq> \<zero>"
  shows "(c \<otimes> a) \<oslash> (c \<otimes> b) = a \<oslash> b"
proof -
  from assms have "(c \<otimes> a) \<oslash> (c \<otimes> b) = c \<otimes> a \<otimes> (inv b \<otimes> inv c)"
    by (simp add: m_div_def nonzero_inverse_mult_distrib integral_iff)
  also from assms have "\<dots> =  a \<otimes> inv b \<otimes> (inv c \<otimes> c)"
    by (simp add: m_ac)
  also from assms have "\<dots> =  a \<otimes> inv b"
    by simp
  finally show ?thesis
    using assms by (simp add: m_div_def)
qed

lemma times_divide_eq_left [simp]:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> c \<in> carrier R \<Longrightarrow> c \<noteq> \<zero> \<Longrightarrow>
    (b \<oslash> c) \<otimes> a = b \<otimes> a \<oslash> c"
  by (simp add: m_div_def m_ac)

lemma times_divide_eq_right [simp]:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> c \<in> carrier R \<Longrightarrow> c \<noteq> \<zero> \<Longrightarrow>
    a \<otimes> (b \<oslash> c) = a \<otimes> b \<oslash> c"
  by (simp add: m_div_def m_ac)

lemma nonzero_power_divide:
  "a \<in> carrier R \<Longrightarrow> b \<in> carrier R \<Longrightarrow> b \<noteq> \<zero> \<Longrightarrow>
    (a \<oslash> b) [^] (n::nat) = a [^] n \<oslash> b [^] n"
  by (induct n) (simp_all add: nonzero_divide_divide_eq_left)

lemma r_diff_distr:
  "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> z \<in> carrier R \<Longrightarrow>
    z \<otimes> (x \<ominus> y) = z \<otimes> x \<ominus> z \<otimes> y"
  by (simp add: minus_eq r_distr r_minus)

lemma divide_zero_left [simp]: "a \<in> carrier R \<Longrightarrow> a \<noteq> \<zero> \<Longrightarrow> \<zero> \<oslash> a = \<zero>"
  by (simp add: m_div_def)

lemma divide_self: "a \<in> carrier R \<Longrightarrow> a \<noteq> \<zero> \<Longrightarrow> a \<oslash> a = \<one>"
  by (simp add: m_div_def)

lemma divide_eq_0_iff:
  assumes "a \<in> carrier R" "b \<in> carrier R"
    and "b \<noteq> \<zero>"
  shows "a \<oslash> b = \<zero> \<longleftrightarrow> a = \<zero>"
proof
  assume "a = \<zero>"
  with assms show "a \<oslash> b = \<zero>" by simp
next
  assume "a \<oslash> b = \<zero>"
  with assms have "b \<otimes> (a \<oslash> b) = b \<otimes> \<zero>" by simp
  also from assms have "b \<otimes> (a \<oslash> b) = b \<otimes> a \<oslash> b" by simp
  also from assms have "b \<otimes> a = a \<otimes> b" by (simp add: m_comm)
  also from assms have "a \<otimes> b \<oslash> b = a \<otimes> (b \<oslash> b)" by simp
  also from assms have "b \<oslash> b = \<one>" by (simp add: divide_self)
  finally show "a = \<zero>" using assms by simp
qed

end

lemma field_class: "field (cring_class_ops::'a::field ring)"
  apply unfold_locales
    apply (simp_all add: cring_class_ops_def)
  apply (auto simp add: Units_def)
  apply (rule_tac x="1 / x" in exI)
  apply simp
  done

lemma div_class: "(x::'a::field) \<oslash>\<^bsub>cring_class_ops\<^esub> y = x / y"
  apply (simp add: m_div_def m_inv_def class_simps)
  apply (rule impI)
  apply (rule ssubst [OF the_equality, of _ "1 / y"])
    apply simp_all
  apply (drule conjunct2)
  apply (drule_tac f="\<lambda>x. x / y" in arg_cong)
  apply simp
  done

interpretation field_class: field "cring_class_ops::'a::field ring"
  rewrites "(\<zero>\<^bsub>cring_class_ops\<^esub>::'a) = 0"
    and "(\<one>\<^bsub>cring_class_ops\<^esub>::'a) = 1"
    and "(x::'a) \<oplus>\<^bsub>cring_class_ops\<^esub> y = x + y"
    and "(x::'a) \<otimes>\<^bsub>cring_class_ops\<^esub> y = x * y"
    and "\<ominus>\<^bsub>cring_class_ops\<^esub> (x::'a) = - x"
    and "(x::'a) \<ominus>\<^bsub>cring_class_ops\<^esub> y = x - y"
    and "(x::'a) [^]\<^bsub>cring_class_ops\<^esub> n = x ^ n"
    and "\<guillemotleft>n\<guillemotright>\<^sub>\<nat>\<^bsub>cring_class_ops\<^esub> = of_nat n"
    and "((\<guillemotleft>i\<guillemotright>\<^bsub>cring_class_ops\<^esub>)::'a) = of_int i"
    and "(x::'a) \<oslash>\<^bsub>cring_class_ops\<^esub> y = x / y"
    and "(Int.of_int (numeral m)::'a) = numeral m"
  by (simp_all add: field_class class_simps div_class)

end


(*  Title:      HOL/Algebra/Exponent.thy
    Author:     Florian Kammueller
    Author:     L C Paulson

exponent p s   yields the greatest power of p that divides s.
*)

theory Exponent
imports Main "HOL-Computational_Algebra.Primes"
begin

section \<open>Sylow's Theorem\<close>

text \<open>The Combinatorial Argument Underlying the First Sylow Theorem\<close>

text\<open>needed in this form to prove Sylow's theorem\<close>
corollary (in algebraic_semidom) div_combine:
  "\<lbrakk>prime_elem p; \<not> p ^ Suc r dvd n; p ^ (a + r) dvd n * k\<rbrakk> \<Longrightarrow> p ^ a dvd k"
  by (metis add_Suc_right mult.commute prime_elem_power_dvd_cases)

lemma exponent_p_a_m_k_equation:
  fixes p :: nat
  assumes "0 < m" "0 < k" "p \<noteq> 0" "k < p^a"
    shows "multiplicity p (p^a * m - k) = multiplicity p (p^a - k)"
proof (rule multiplicity_cong [OF iffI])
  fix r
  assume *: "p ^ r dvd p ^ a * m - k"
  show "p ^ r dvd p ^ a - k"
  proof -
    have "k \<le> p ^ a * m" using assms
      by (meson nat_dvd_not_less dvd_triv_left leI mult_pos_pos order.strict_trans)
    then have "r \<le> a"
      by (meson "*" \<open>0 < k\<close> \<open>k < p^a\<close> dvd_diffD1 dvd_triv_left leI less_imp_le_nat nat_dvd_not_less power_le_dvd)
    then have "p^r dvd p^a * m" by (simp add: le_imp_power_dvd)
    thus ?thesis
      by (meson \<open>k \<le> p ^ a * m\<close> \<open>r \<le> a\<close> * dvd_diffD1 dvd_diff_nat le_imp_power_dvd)
  qed
next
  fix r
  assume *: "p ^ r dvd p ^ a - k"
  with assms have "r \<le> a"
    by (metis diff_diff_cancel less_imp_le_nat nat_dvd_not_less nat_le_linear power_le_dvd zero_less_diff)
  show "p ^ r dvd p ^ a * m - k"
  proof -
    have "p^r dvd p^a*m"
      by (simp add: \<open>r \<le> a\<close> le_imp_power_dvd)
    then show ?thesis
      by (meson assms * dvd_diffD1 dvd_diff_nat le_imp_power_dvd less_imp_le_nat \<open>r \<le> a\<close>)
  qed
qed

lemma p_not_div_choose_lemma:
  fixes p :: nat
  assumes eeq: "\<And>i. Suc i < K \<Longrightarrow> multiplicity p (Suc i) = multiplicity p (Suc (j + i))"
      and "k < K" and p: "prime p"
    shows "multiplicity p (j + k choose k) = 0"
  using \<open>k < K\<close>
proof (induction k)
  case 0 then show ?case by simp
next
  case (Suc k)
  then have *: "(Suc (j+k) choose Suc k) > 0" by simp
  then have "multiplicity p ((Suc (j+k) choose Suc k) * Suc k) = multiplicity p (Suc k)"
    by (subst Suc_times_binomial_eq [symmetric], subst prime_elem_multiplicity_mult_distrib)
       (insert p Suc.prems, simp_all add: eeq [symmetric] Suc.IH)
  with p * show ?case
    by (subst (asm) prime_elem_multiplicity_mult_distrib) simp_all
qed

text\<open>The lemma above, with two changes of variables\<close>
lemma p_not_div_choose:
  assumes "k < K" and "k \<le> n"
      and eeq: "\<And>j. \<lbrakk>0<j; j<K\<rbrakk> \<Longrightarrow> multiplicity p (n - k + (K - j)) = multiplicity p (K - j)" "prime p"
    shows "multiplicity p (n choose k) = 0"
apply (rule p_not_div_choose_lemma [of K p "n-k" k, simplified assms nat_minus_add_max max_absorb1])
apply (metis add_Suc_right eeq diff_diff_cancel order_less_imp_le zero_less_Suc zero_less_diff)
apply (rule TrueI)+
done

proposition const_p_fac:
  assumes "m>0" and prime: "prime p"
  shows "multiplicity p (p^a * m choose p^a) = multiplicity p m"
proof-
  from assms have p: "0 < p ^ a" "0 < p^a * m" "p^a \<le> p^a * m"
    by (auto simp: prime_gt_0_nat)
  have *: "multiplicity p ((p^a * m - 1) choose (p^a - 1)) = 0"
    apply (rule p_not_div_choose [where K = "p^a"])
    using p exponent_p_a_m_k_equation by (auto simp: diff_le_mono prime)
  have "multiplicity p ((p ^ a * m choose p ^ a) * p ^ a) = a + multiplicity p m"
  proof -
    have "(p ^ a * m choose p ^ a) * p ^ a = p ^ a * m * (p ^ a * m - 1 choose (p ^ a - 1))"
      (is "_ = ?rhs") using prime
      by (subst times_binomial_minus1_eq [symmetric]) (auto simp: prime_gt_0_nat)
    also from p have "p ^ a - Suc 0 \<le> p ^ a * m - Suc 0" by linarith
    with prime * p have "multiplicity p ?rhs = multiplicity p (p ^ a * m)"
      by (subst prime_elem_multiplicity_mult_distrib) auto
    also have "\<dots> = a + multiplicity p m"
      using prime p by (subst prime_elem_multiplicity_mult_distrib) simp_all
    finally show ?thesis .
  qed
  then show ?thesis
    using prime p by (subst (asm) prime_elem_multiplicity_mult_distrib) simp_all
qed

end


theory prop_31
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype Nat = Z | S "Nat"
  fun min2 :: "Nat => Nat => Nat" where
  "min2 (Z) y = Z"
  | "min2 (S z) (Z) = Z"
  | "min2 (S z) (S y1) = S (min2 z y1)"
  (*hipster min2 *)

lemma lemma_a [thy_expl]: "min2 x x = x"
by (hipster_induct_schemes min2.simps)

lemma lemma_aa [thy_expl]: "min2 x Z = Z"
by (hipster_induct_schemes min2.simps)

lemma lemma_ab [thy_expl]: "min2 x (min2 x y) = min2 x y"
by (hipster_induct_schemes min2.simps)

lemma lemma_ac [thy_expl]: "min2 x (min2 y x) = min2 y x"
by (hipster_induct_schemes min2.simps)

lemma lemma_ad [thy_expl]: "min2 (min2 x y) x = min2 x y"
by (hipster_induct_schemes min2.simps)

lemma lemma_ae []: "min2 (S x) y = min2 y (S x)"
by (hipster_induct_schemes min2.simps)

lemma lemma_af [thy_expl]: "min2 x y = min2 y x"
by (hipster_induct_schemes min2.simps)

  theorem x0 :
    "(min2 (min2 a b) c) = (min2 a (min2 b c))"
    apply(induction a b arbitrary: c rule: min2.induct)
    apply(simp_all)
    apply(metis min2.simps Nat.exhaust)
    by (metis min2.simps Nat.exhaust)
    (*by (tactic {* Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1 *})*)
end


(* Author: Tobias Nipkow *)

section "Splay Tree Implementation of Maps"

theory Splay_Map
imports
  Splay_Set
  Map_by_Ordered
begin

function splay :: "'a::linorder \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
"splay x Leaf = Leaf" |
"x = fst a \<Longrightarrow> splay x (Node t1 a t2) = Node t1 a t2" |
"x = fst a \<Longrightarrow> x < fst b \<Longrightarrow> splay x (Node (Node t1 a t2) b t3) = Node t1 a (Node t2 b t3)" |
"x < fst a \<Longrightarrow> splay x (Node Leaf a t) = Node Leaf a t" |
"x < fst a \<Longrightarrow> x < fst b \<Longrightarrow> splay x (Node (Node Leaf a t1) b t2) = Node Leaf a (Node t1 b t2)" |
"x < fst a \<Longrightarrow> x < fst b \<Longrightarrow> t1 \<noteq> Leaf \<Longrightarrow>
 splay x (Node (Node t1 a t2) b t3) =
 (case splay x t1 of Node t11 y t12 \<Rightarrow> Node t11 y (Node t12 a (Node t2 b t3)))" |
"fst a < x \<Longrightarrow> x < fst b \<Longrightarrow> splay x (Node (Node t1 a Leaf) b t2) = Node t1 a (Node Leaf b t2)" |
"fst a < x \<Longrightarrow> x < fst b \<Longrightarrow> t2 \<noteq> Leaf \<Longrightarrow>
 splay x (Node (Node t1 a t2) b t3) =
 (case splay x t2 of Node t21 y t22 \<Rightarrow> Node (Node t1 a t21) y (Node t22 b t3))" |
"fst a < x \<Longrightarrow> x = fst b \<Longrightarrow> splay x (Node t1 a (Node t2 b t3)) = Node (Node t1 a t2) b t3" |
"fst a < x \<Longrightarrow> splay x (Node t a Leaf) = Node t a Leaf" |
"fst a < x \<Longrightarrow> x < fst b \<Longrightarrow>  t2 \<noteq> Leaf \<Longrightarrow>
 splay x (Node t1 a (Node t2 b t3)) =
 (case splay x t2 of Node t21 y t22 \<Rightarrow> Node (Node t1 a t21) y (Node t22 b t3))" |
"fst a < x \<Longrightarrow> x < fst b \<Longrightarrow> splay x (Node t1 a (Node Leaf b t2)) = Node (Node t1 a Leaf) b t2" |
"fst a < x \<Longrightarrow> fst b < x \<Longrightarrow> splay x (Node t1 a (Node t2 b Leaf)) = Node (Node t1 a t2) b Leaf" |
"fst a < x \<Longrightarrow> fst b < x \<Longrightarrow> t3 \<noteq> Leaf \<Longrightarrow>
 splay x (Node t1 a (Node t2 b t3)) =
 (case splay x t3 of Node t31 y t32 \<Rightarrow> Node (Node (Node t1 a t2) b t31) y t32)"
apply(atomize_elim)
apply(auto)
(* 1 subgoal *)
apply (subst (asm) neq_Leaf_iff)
apply(auto)
apply (metis tree.exhaust surj_pair less_linear)+
done

termination splay
by lexicographic_order

lemma splay_code: "splay (x::_::linorder) t = (case t of Leaf \<Rightarrow> Leaf |
  Node al a ar \<Rightarrow> (case cmp x (fst a) of
    EQ \<Rightarrow> t |
    LT \<Rightarrow> (case al of
      Leaf \<Rightarrow> t |
      Node bl b br \<Rightarrow> (case cmp x (fst b) of
        EQ \<Rightarrow> Node bl b (Node br a ar) |
        LT \<Rightarrow> if bl = Leaf then Node bl b (Node br a ar)
              else case splay x bl of
                Node bll y blr \<Rightarrow> Node bll y (Node blr b (Node br a ar)) |
        GT \<Rightarrow> if br = Leaf then Node bl b (Node br a ar)
              else case splay x br of
                Node brl y brr \<Rightarrow> Node (Node bl b brl) y (Node brr a ar))) |
    GT \<Rightarrow> (case ar of
      Leaf \<Rightarrow> t |
      Node bl b br \<Rightarrow> (case cmp x (fst b) of
        EQ \<Rightarrow> Node (Node al a bl) b br |
        LT \<Rightarrow> if bl = Leaf then Node (Node al a bl) b br
              else case splay x bl of
                Node bll y blr \<Rightarrow> Node (Node al a bll) y (Node blr b br) |
        GT \<Rightarrow> if br=Leaf then Node (Node al a bl) b br
              else case splay x br of
                Node bll y blr \<Rightarrow> Node (Node (Node al a bl) b bll) y blr))))"
by(auto cong: case_tree_cong split: tree.split)

definition lookup :: "('a*'b)tree \<Rightarrow> 'a::linorder \<Rightarrow> 'b option" where "lookup t x =
  (case splay x t of Leaf \<Rightarrow> None | Node _ (a,b) _ \<Rightarrow> if x=a then Some b else None)"

hide_const (open) insert

fun update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
"update x y t =  (if t = Leaf then Node Leaf (x,y) Leaf
  else case splay x t of
    Node l a r \<Rightarrow> if x = fst a then Node l (x,y) r
      else if x < fst a then Node l (x,y) (Node Leaf a r) else Node (Node l a Leaf) (x,y) r)"

definition delete :: "'a::linorder \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
"delete x t = (if t = Leaf then Leaf
  else case splay x t of Node l a r \<Rightarrow>
    if x = fst a
    then if l = Leaf then r else case splay_max l of Node l' m r' \<Rightarrow> Node l' m r
    else Node l a r)"

subsection "Functional Correctness Proofs"

lemma splay_Leaf_iff: "(splay x t = Leaf) = (t = Leaf)"
by(induction x t rule: splay.induct) (auto split: tree.splits)

subsubsection "Proofs for lookup"

lemma lookup_eq:
  "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
by(auto simp: lookup_def splay_Leaf_iff splay_map_of_inorder split: tree.split)

subsubsection "Proofs for update"

lemma inorder_splay: "inorder(splay x t) = inorder t"
by(induction x t rule: splay.induct)
  (auto simp: neq_Leaf_iff split: tree.split)

lemma sorted_splay:
  "sorted1(inorder t) \<Longrightarrow> splay x t = Node l a r \<Longrightarrow>
  sorted(map fst (inorder l) @ x # map fst (inorder r))"
unfolding inorder_splay[of x t, symmetric]
by(induction x t arbitrary: l a r rule: splay.induct)
  (auto simp: sorted_lems sorted_Cons_le sorted_snoc_le splay_Leaf_iff split: tree.splits)

lemma inorder_update:
  "sorted1(inorder t) \<Longrightarrow> inorder(update x y t) = upd_list x y (inorder t)"
using inorder_splay[of x t, symmetric] sorted_splay[of t x]
by(auto simp: upd_list_simps upd_list_Cons upd_list_snoc neq_Leaf_iff split: tree.split)

subsubsection "Proofs for delete"

lemma inorder_splay_maxD:
  "splay_max t = Node l a r \<Longrightarrow> sorted1(inorder t) \<Longrightarrow>
  inorder l @ [a] = inorder t \<and> r = Leaf"
by(induction t arbitrary: l a r rule: splay_max.induct)
  (auto simp: sorted_lems splay_max_Leaf_iff split: tree.splits if_splits)

lemma inorder_delete:
  "sorted1(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
using inorder_splay[of x t, symmetric] sorted_splay[of t x]
by (auto simp: del_list_simps del_list_sorted_app delete_def
  del_list_notin_Cons inorder_splay_maxD splay_Leaf_iff splay_max_Leaf_iff
  split: tree.splits)

subsubsection "Overall Correctness"

interpretation Map_by_Ordered
where empty = Leaf and lookup = lookup and update = update
and delete = delete and inorder = inorder and inv = "\<lambda>_. True"
proof (standard, goal_cases)
  case 2 thus ?case by(simp add: lookup_eq)
next
  case 3 thus ?case by(simp add: inorder_update del: update.simps)
next
  case 4 thus ?case by(simp add: inorder_delete)
qed auto

end


(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Complexity Carrier\<close>

text \<open>We define which properties a carrier of matrices must exhibit, so that it
  can be used for checking complexity proofs.\<close>

theory Complexity_Carrier
imports
  "Abstract-Rewriting.SN_Order_Carrier"
  Ring_Hom_Matrix
  Derivation_Bound
  HOL.Real
begin

class large_real_ordered_semiring_1 = large_ordered_semiring_1 + real_embedding

instance real :: large_real_ordered_semiring_1 ..
instance int :: large_real_ordered_semiring_1 ..
instance rat :: large_real_ordered_semiring_1 ..

text \<open>For complexity analysis, we need a bounding function which tells us how often
  one can strictly decrease a value. To this end, $\delta$-orderings are usually applied
  when working with the reals or rational numbers.\<close>

locale complexity_one_mono_ordered_semiring_1 = one_mono_ordered_semiring_1 default gt
  for gt :: "'a :: large_ordered_semiring_1 \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<succ>" 50) and default :: 'a +
  fixes bound :: "'a \<Rightarrow> nat"
  assumes bound_mono: "\<And> a b. a \<ge> b \<Longrightarrow> bound a \<ge> bound b"
   and bound_plus: "\<And> a b. bound (a + b) \<le> bound a + bound b"
   and bound_plus_of_nat: "\<And> a n. a \<ge> 0 \<Longrightarrow> bound (a + of_nat n) = bound a + bound (of_nat n)"
   and bound_zero[simp]: "bound 0 = 0"
   and bound_one: "bound 1 \<ge> 1"
   and bound: "\<And> a. deriv_bound {(a,b). b \<ge> 0 \<and> a \<succ> b} a (bound a)"
begin

lemma bound_linear: "\<exists> c. \<forall> n. bound (of_nat n) \<le> c * n"
proof (rule exI[of _ "bound 1"], intro allI)
  fix n
  show "bound (of_nat n) \<le> bound 1 * n"
  proof (induct n)
    case (Suc n)
    have "bound (of_nat (Suc n)) = bound (1 + of_nat n)" by simp
    also have "... \<le> bound 1 + bound (of_nat n)"
      by (rule bound_plus)
    also have "... \<le> bound 1 + bound 1 * n"
      using Suc by auto
    finally show ?case by auto
  qed simp
qed

lemma bound_of_nat_times: "bound (of_nat n * v) \<le> n * bound v"
proof (induct n)
  case (Suc n)
  have "bound (of_nat (Suc n) * v) = bound (v + of_nat n * v)" by (simp add: field_simps)
  also have "\<dots> \<le> bound v + bound (of_nat n * v)" by (rule bound_plus)
  also have "\<dots> \<le> bound v + n * bound v" using Suc by auto
  finally show ?case by simp
qed simp

lemma bound_mult_of_nat: "bound (a * of_nat n) \<le> bound a * bound (of_nat n)"
proof (induct n)
  case (Suc n)
  have "bound (a * of_nat (Suc n)) = bound (a + a * of_nat n)" by (simp add: field_simps)
  also have "... \<le> bound a + bound (a * of_nat n)"
    by (rule bound_plus)
  also have "... \<le> bound a + bound a * bound (of_nat n)" using Suc by auto
  also have "... = bound a * (1 + bound (of_nat n))" by (simp add: field_simps)
  also have "... \<le> bound a * (bound (1 + of_nat n))"
  proof (rule mult_le_mono2)
    show "1 + bound(of_nat n) \<le> bound (1 + of_nat n)" using bound_one
    using bound_plus
      unfolding bound_plus_of_nat[OF one_ge_zero] by simp
  qed
  finally show ?case by simp
qed simp

lemma bound_pow_of_nat: "bound (a * of_nat n ^ deg) \<le> bound a * of_nat n ^ deg"
proof (induct deg)
  case (Suc deg)
  have "bound (a * of_nat n ^ Suc deg) =  bound (of_nat n * (a * of_nat n ^ deg))"
    by (simp add: field_simps)
  also have "\<dots> \<le> n * bound (a * of_nat n ^ deg)"
    by (rule bound_of_nat_times)
  also have "\<dots> \<le> n * (bound a * of_nat n ^ deg)"
    using Suc by auto
  finally show ?case by (simp add: field_simps)
qed simp
end

end


theory T165
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end