(*
  Authors: J. Divasón, R. Thiemann, A. Yamada
*)
section \<open>Connecting HMA-matrices with JNF-matrices\<close>

text \<open>The following theories provide a connection between the type-based representation of vectors
  and matrices in HOL multivariate-analysis (HMA) with the set-based representation of vectors and matrices
  with integer indices in the Jordan-normal-form (JNF) development.\<close>

subsection \<open>Bijections between index types of HMA and natural numbers\<close>

text \<open>At the core of HMA-connect, there has to be a translation between indices
  of vectors and matrices, which are via index-types on the one hand, and natural
  numbers on the other hand.

  We some unspecified bijection in our application, and not the conversions
  to-nat and from-nat in theory
  Rank-Nullity-Theorem/Mod-Type, since our definitions
  below do not enforce any further type constraints.\<close>

theory Bij_Nat
imports
  "HOL-Library.Cardinality"
  "HOL-Library.Numeral_Type"
begin

lemma finite_set_to_list: "\<exists> xs :: 'a :: finite list. distinct xs \<and> set xs = Y"
proof -
  have "finite Y" by simp
  thus ?thesis
  proof (induct Y rule: finite_induct)
    case (insert y Y)
    then obtain xs where xs: "distinct xs" "set xs = Y" by auto
    show ?case
      by (rule exI[of _ "y # xs"], insert xs insert(2), auto)
  qed simp
qed

definition univ_list :: "'a :: finite list" where
  "univ_list = (SOME xs. distinct xs \<and> set xs = UNIV)"

lemma univ_list: "distinct (univ_list :: 'a list)" "set univ_list = (UNIV :: 'a :: finite set)"
proof -
  let ?xs = "univ_list :: 'a list"
  have "distinct ?xs \<and> set ?xs = UNIV"
    unfolding univ_list_def
    by (rule someI_ex, rule finite_set_to_list)
  thus "distinct ?xs" "set ?xs = UNIV" by auto
qed

definition to_nat :: "'a :: finite \<Rightarrow> nat" where
  "to_nat a = (SOME i. univ_list ! i = a \<and> i < length (univ_list :: 'a list))"

definition from_nat :: "nat \<Rightarrow> 'a :: finite" where
  "from_nat i = univ_list ! i"

lemma length_univ_list_card: "length (univ_list :: 'a :: finite list) = CARD('a)"
  using distinct_card[of "univ_list :: 'a list", symmetric]
  by (auto simp: univ_list)

lemma to_nat_ex: "\<exists>! i. univ_list ! i = (a :: 'a :: finite) \<and> i < length (univ_list :: 'a list)"
proof -
  let ?ul = "univ_list :: 'a list"
  have a_in_set: "a \<in> set ?ul" unfolding univ_list by auto
  from this [unfolded set_conv_nth]
  obtain i where i1: "?ul ! i = a \<and> i < length ?ul" by auto
  show ?thesis
  proof (rule ex1I, rule i1)
    fix j
    assume "?ul ! j = a \<and> j < length ?ul"
    moreover have "distinct ?ul" by (simp add: univ_list)
    ultimately show "j = i" using i1 nth_eq_iff_index_eq by blast
  qed
qed

lemma to_nat_less_card: "to_nat (a :: 'a :: finite) < CARD('a)"
proof -
  let ?ul = "univ_list :: 'a list"
  from to_nat_ex[of a] obtain i where
  i1: "univ_list ! i = a \<and> i<length (univ_list::'a list)" by auto
  show ?thesis unfolding to_nat_def
  proof (rule someI2, rule i1)
   fix x
   assume x: "?ul ! x = a \<and> x < length ?ul"
   thus "x < CARD ('a)" using x by (simp add: univ_list length_univ_list_card)
  qed
qed

lemma to_nat_from_nat_id:
  assumes i: "i < CARD('a :: finite)"
  shows "to_nat (from_nat i :: 'a) = i"
  unfolding to_nat_def from_nat_def
proof (rule some_equality, simp)
  have l: "length (univ_list::'a list) = card (set (univ_list::'a list))"
    by (rule distinct_card[symmetric], simp add: univ_list)
  thus i2: "i < length (univ_list::'a list)"
    using i unfolding univ_list by simp
   fix n
   assume n: "(univ_list::'a list) ! n = (univ_list::'a list) ! i \<and> n < length (univ_list::'a list)"
   have d: "distinct (univ_list::'a list)" using univ_list by simp
   show "n = i" using nth_eq_iff_index_eq[OF d _ i2] n by auto
qed

lemma from_nat_inj: assumes i: "i < CARD('a :: finite)"
  and j: "j < CARD('a :: finite)"
  and id: "(from_nat i :: 'a) = from_nat j"
  shows "i = j"
proof -
  from arg_cong[OF id, of to_nat]
  show ?thesis using i j by (simp add: to_nat_from_nat_id)
qed

lemma from_nat_to_nat_id[simp]:
  "(from_nat (to_nat a)) = (a::'a :: finite)"
proof -
  have a_in_set: "a \<in> set (univ_list)" unfolding univ_list by auto
  from this [unfolded set_conv_nth]
  obtain i where i1: "univ_list ! i = a \<and> i<length (univ_list::'a list)" by auto
  show ?thesis
  unfolding to_nat_def from_nat_def
  by (rule someI2, rule i1, simp)
qed

lemma to_nat_inj[simp]: assumes "to_nat a = to_nat b"
  shows "a = b"
proof -
  from to_nat_ex[of a] to_nat_ex[of b]
  show "a = b" unfolding to_nat_def by (metis assms from_nat_to_nat_id)
qed

lemma range_to_nat: "range (to_nat :: 'a :: finite \<Rightarrow> nat) = {0 ..< CARD('a)}" (is "?l = ?r")
proof -
  {
    fix i
    assume "i \<in> ?l"
    hence "i \<in> ?r" using to_nat_less_card[where 'a = 'a] by auto
  }
  moreover
  {
    fix i
    assume "i \<in> ?r"
    hence "i < CARD('a)" by auto
    from to_nat_from_nat_id[OF this]
    have "i \<in> ?l" by (metis range_eqI)
  }
  ultimately show ?thesis by auto
qed

lemma inj_to_nat: "inj to_nat" by (simp add: inj_on_def)

lemma bij_to_nat: "bij_betw to_nat (UNIV :: 'a :: finite set) {0 ..< CARD('a)}"
  unfolding bij_betw_def by (auto simp: range_to_nat inj_to_nat)

lemma numeral_nat: "(numeral m1 :: nat) * numeral n1 \<equiv> numeral (m1 * n1)"
  "(numeral m1 :: nat) + numeral n1 \<equiv> numeral (m1 + n1)" by simp_all

lemmas card_num_simps =
  card_num1 card_bit0 card_bit1
  mult_num_simps
  add_num_simps
  eq_num_simps
  mult_Suc_right mult_0_right One_nat_def add.right_neutral
  numeral_nat Suc_numeral

end


(*  Title:       Executable Transitive Closures of Finite Relations
    Author:      Christian Sternagel <c.sternagel@gmail.com>
                 René Thiemann       <rene.thiemann@uibk.ac.at>
    Maintainer:  Christian Sternagel and René Thiemann
    License:     LGPL
*)

section \<open>A Generic Work-List Algorithm\<close>

theory Transitive_Closure_Impl
imports Main
begin

text \<open>
  Let @{term R} be some finite relation. We start to present a standard work-list algorithm to
  compute all elements that are reachable from some initial set by at most @{term n} @{term
  R}-steps. Then, we obtain algorithms for the (reflexive) transitive closure from a given starting
  set by exploiting the fact that for finite relations we have to iterate at most @{term "card R"}
  times. The presented algorithms are generic in the sense that the underlying data structure can
  freely be chosen, you just have to provide certain operations like union, membership, etc.
\<close>

subsection \<open>Bounded Reachability\<close>

text \<open>
  We provide an algorithm \<open>relpow_impl\<close> that computes all states that are reachable from an
  initial set of states @{term new} by at most @{term n} steps. The algorithm also stores a set of
  states that have already been visited @{term have}, and then show, do not have to be expanded a
  second time. The algorithm is parametric in the underlying data structure, it just requires
  operations for union and membership as well as a function to compute the successors of a list.
\<close>
fun
  relpow_impl ::
    "('a list \<Rightarrow> 'a list) \<Rightarrow>
      ('a list \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> 'b"
where
  "relpow_impl succ un memb new have 0 = un new have" |
  "relpow_impl succ un memb new have (Suc m) =
    (if new = [] then have
    else
      let
        maybe = succ new;
        have' = un new have;
        new' = filter (\<lambda> n. \<not> memb n have') maybe
      in relpow_impl succ un memb new' have' m)"

text \<open>
  We need to know that the provided operations behave correctly.
\<close>

locale set_access =
  fixes un :: "'a list \<Rightarrow> 'b \<Rightarrow> 'b"
    and set_of :: "'b \<Rightarrow> 'a set"
    and memb :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
    and empty :: 'b
  assumes un: "set_of (un as bs) = set as \<union> set_of bs"
    and memb: "memb a bs \<longleftrightarrow> (a \<in> set_of bs)"
    and empty: "set_of empty = {}"

locale set_access_succ = set_access un
  for un :: "'a list \<Rightarrow> 'b \<Rightarrow> 'b" +
  fixes succ :: "'a list \<Rightarrow> 'a list"
   and  rel :: "('a \<times> 'a) set"
  assumes succ: "set (succ as) = {b. \<exists> a \<in> set as. (a, b) \<in> rel}"
begin

abbreviation "relpow_i \<equiv> relpow_impl succ un memb"

text \<open>
  What follows is the main technical result of the @{const relpow_impl} algorithm: what it computes
  for arbitrary values of @{term new} and @{term have}.
\<close>

lemma relpow_impl_main:
  "set_of (relpow_i new have n) =
    {b | a b m. a \<in> set new \<and> m \<le> n \<and> (a, b) \<in> (rel \<inter> {(a, b). b \<notin> set_of have}) ^^ m} \<union>
    set_of have"
  (is "?l new have n = ?r new have n")
proof (induction n arbitrary: "have" new)
  case (Suc n hhave nnew)
  show ?case
  proof (cases "nnew = []")
    case True
    then show ?thesis by auto
  next
    case False
    let ?have = "set_of hhave"
    let ?new = "set nnew"
    obtain "have" new where hav: "have = ?have" and new: "new = ?new" by auto
    let ?reln = "\<lambda> m. (rel \<inter> {(a, b). b \<notin> new \<and> b \<notin> have}) ^^  m"
    let ?rel = "\<lambda> m. (rel \<inter> {(a, b). b \<notin> have}) ^^  m"
    have idl: "?l nnew hhave (Suc n) =
      {uu. \<exists>a. (\<exists>aa\<in> new. (aa,a) \<in> rel) \<and> a \<notin> new \<and> a \<notin> have \<and> (\<exists>m \<le> n. (a, uu) \<in> ?reln m)} \<union>
      (new \<union> have)"
      (is "_ = ?l1 \<union> (?l2 \<union> ?l3)")
      by (simp add: hav new False Let_def Suc, simp add: memb un succ)
    let ?l = "?l1 \<union> (?l2 \<union> ?l3)"
    have idr: "?r nnew hhave (Suc n) = {b. \<exists> a m. a \<in> new \<and> m \<le> Suc n \<and> (a, b) \<in> ?rel m} \<union> have"
      (is "_ = (?r1 \<union> ?r2)") by (simp add: hav new)
    let ?r = "?r1 \<union> ?r2"
    {
      fix b
      assume b: "b \<in> ?l"
      have "b \<in> ?r"
      proof (cases "b \<in> new \<or> b \<in> have")
        case True then show ?thesis
        proof
          assume "b \<in> have" then show ?thesis by auto
        next
          assume b: "b \<in> new"
          have "b \<in> ?r1"
            by (intro CollectI, rule exI, rule exI [of _ 0], intro conjI, rule b, auto)
          then show ?thesis by auto
        qed
      next
        case False
        with b have "b \<in> ?l1" by auto
        then obtain a2 a1 m where a2n: "a2 \<notin> new" and a2h: "a2 \<notin> have" and a1: "a1 \<in> new"
          and a1a2: "(a1,a2) \<in> rel" and m: "m \<le> n" and a2b: "(a2,b) \<in> ?reln m" by auto
        have "b \<in> ?r1"
          by (rule CollectI, rule exI, rule exI [of _ "Suc m"], intro conjI, rule a1, simp add: m, rule relpow_Suc_I2, rule, rule a1a2, simp add: a2h, insert a2b, induct m arbitrary: a2 b, auto)
        then show ?thesis by auto
      qed
    }
    moreover
    {
      fix b
      assume b: "b \<in> ?r"
      then have "b \<in> ?l"
      proof (cases "b \<in> have")
        case True then show ?thesis by auto
      next
        case False
        with b have "b \<in> ?r1" by auto
        then obtain a m where a: "a \<in> new" and m: "m \<le> Suc n" and ab: "(a, b) \<in> ?rel m" by auto
        have seq: "\<exists> a \<in> new. (a, b) \<in> ?rel m"
          using a  ab by auto
        obtain l where l: "l = (LEAST m. (\<exists> a \<in> new. (a, b) \<in> ?rel m))" by auto
        have least: "(\<exists> a \<in> new. (a, b) \<in> ?rel l)"
          by (unfold l, rule LeastI, rule seq)
        have lm: "l \<le> m" unfolding l
          by (rule Least_le, rule seq)
        with m have ln: "l \<le> Suc n" by auto
        from least obtain a where a: "a \<in> new"
          and ab: "(a, b) \<in> ?rel l" by auto
        from ab [unfolded relpow_fun_conv]
        obtain f where fa: "f 0 = a" and fb: "b = f l"
          and steps: "\<And> i. i < l \<Longrightarrow> (f i, f (Suc i)) \<in> ?rel 1" by auto
        {
          fix i
          assume i: "i < l"
          have main: "f (Suc i) \<notin> new"
          proof
            assume new: "f (Suc i) \<in> new"
            let ?f = "\<lambda> j. f (Suc i + j)"
            have seq: "(f (Suc i), b) \<in> ?rel (l - Suc i)"
              unfolding relpow_fun_conv
            proof (rule exI[of _ ?f], intro conjI allI impI)
              from i show "f (Suc i + (l - Suc i)) = b"
                unfolding fb by auto
            next
              fix j
              assume "j < l - Suc i"
              then have small: "Suc i + j < l" by auto
              show "(?f j, ?f (Suc j)) \<in> rel \<inter> {(a, b). b \<notin> have}" using steps [OF small] by auto
            qed simp
            from i have small: "l - Suc i < l" by auto
            from seq new have "\<exists> a \<in> new. (a, b) \<in> ?rel (l - Suc i)"  by auto
            with not_less_Least [OF small [unfolded l]]
            show False unfolding l by auto
          qed
          then have "(f i, f (Suc i)) \<in> ?reln 1"
            using steps [OF i] by auto
        } note steps = this
        have ab: "(a, b) \<in> ?reln l" unfolding relpow_fun_conv
          by (intro exI conjI, insert fa fb steps, auto)
        have "b \<in> ?l1 \<union> ?l2"
        proof (cases l)
          case 0
          with ab a show ?thesis by auto
        next
          case (Suc ll)
          from relpow_Suc_D2 [OF ab [unfolded Suc]] a ln Suc
          show ?thesis by auto
        qed
        then show ?thesis by auto
      qed
    }
    ultimately show ?thesis
      unfolding idl idr by blast
  qed
qed (simp add: un)

text \<open>
  From the previous lemma we can directly derive that @{const relpow_impl} works correctly if @{term
  have} is initially set to \<open>empty\<close>
\<close>
lemma relpow_impl:
  "set_of (relpow_i new empty n) = {b | a b m. a \<in> set new \<and> m \<le> n \<and> (a, b) \<in> rel ^^ m}"
proof -
  have id: "rel \<inter> {(a ,b). True} = rel" by auto
  show ?thesis unfolding relpow_impl_main empty by (simp add: id)
qed

end

subsection \<open>Reflexive Transitive Closure and Transitive closure\<close>

text \<open>
  Using @{const relpow_impl} it is now easy to obtain algorithms for the reflexive transitive
  closure and the transitive closure by restricting the number of steps to the size of the finite
  relation. Note that @{const relpow_impl} will abort the computation as soon as no new states are
  detected. Hence, there is no penalty in using this large bound.
\<close>

definition
  rtrancl_impl ::
    "(('a \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'a list) \<Rightarrow>
      ('a list \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'b"
where
  "rtrancl_impl gen_succ un memb emp rel =
    (let
      succ = gen_succ rel;
      n = length rel
    in (\<lambda> as. relpow_impl succ un memb as emp n))"

definition
  trancl_impl ::
    "(('a \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'a list) \<Rightarrow>
      ('a list \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'b"
where
  "trancl_impl gen_succ un memb emp rel =
    (let
      succ = gen_succ rel;
      n = length rel
    in (\<lambda> as. relpow_impl succ un memb (succ as) emp n))"

text \<open>
  The soundness of both @{const rtrancl_impl} and @{const trancl_impl} follows from the soundness of
  @{const relpow_impl} and the fact that for finite relations, we can limit the number of steps to
  explore all elements in the reflexive transitive closure.
\<close>

lemma rtrancl_finite_relpow:
  "(a, b) \<in> (set rel)\<^sup>* \<longleftrightarrow> (\<exists> n \<le> length rel. (a, b) \<in> set rel ^^ n)" (is "?l = ?r")
proof
  assume ?r
  then show ?l
    unfolding rtrancl_power by auto
next
  assume ?l
  from this [unfolded rtrancl_power]
    obtain n where ab: "(a,b) \<in> set rel ^^ n" ..
  obtain l where l: "l = (LEAST n. (a,b) \<in> set rel ^^ n)" by auto
  have ab: "(a, b) \<in> set rel ^^ l" unfolding l
    by (intro LeastI, rule ab)
  from this [unfolded relpow_fun_conv]
  obtain f where a: "f 0 = a" and b: "f l = b"
    and steps: "\<And> i. i < l \<Longrightarrow> (f i, f (Suc i)) \<in> set rel" by auto
  let ?hits = "map (\<lambda> i. f (Suc i)) [0 ..< l]"
  from steps have subset: "set ?hits \<subseteq> snd ` set rel" by force
  have "l \<le> length rel"
  proof (cases "distinct ?hits")
    case True
    have "l = length ?hits" by simp
    also have "... = card (set ?hits)" unfolding distinct_card [OF True] ..
    also have "... \<le> card (snd ` set rel)" by (rule card_mono [OF _ subset], auto)
    also have "... = card (set (map snd rel))" by auto
    also have "... \<le> length (map snd rel)" by (rule card_length)
    finally  show ?thesis by simp
  next
    case False
    from this [unfolded distinct_conv_nth]
    obtain i j where i: "i < l" and j: "j < l" and ij: "i \<noteq> j" and fij: "f (Suc i) = f (Suc j)" by auto
    let ?i = "min i j"
    let ?j = "max i j"
    have i: "?i < l" and j: "?j < l" and fij: "f (Suc ?i) = f (Suc ?j)"
      and ij: "?i < ?j"
      using i j ij fij unfolding min_def max_def by (cases "i \<le> j", auto)
    from i j fij ij obtain i j where i: "i < l" and j: "j < l" and ij: "i < j" and fij: "f (Suc i) = f (Suc j)" by blast
    let ?g = "\<lambda> n. if n \<le> i then f n else f (n + (j - i))"
    let ?l = "l - (j - i)"
    have abl: "(a,b) \<in> set rel ^^ ?l"
      unfolding relpow_fun_conv
    proof (rule exI [of _ ?g], intro conjI impI allI)
      show "?g ?l = b" unfolding b [symmetric] using j ij by auto
    next
      fix k
      assume k: "k < ?l"
      show "(?g k, ?g (Suc k)) \<in> set rel"
      proof (cases "k < i")
        case True
        with i have "k < l" by auto
        from steps [OF this] show ?thesis using True by simp
      next
        case False
        then have ik: "i \<le> k" by auto
        show ?thesis
        proof (cases "k = i")
          case True
          then show ?thesis using ij fij steps [OF i] by simp
        next
          case False
          with ik have ik: "i < k" by auto
          then have small: "k + (j - i) < l" using k by auto
          show ?thesis using steps[OF small] ik by auto
        qed
      qed
    qed (simp add: a)
    from ij i have ll: "?l < l" by auto
    have "l \<le> ?l" unfolding l
      by (rule Least_le, rule abl [unfolded l])
    with ll have False by simp
    then show ?thesis by simp
  qed
  with ab show ?r by auto
qed

locale set_access_gen = set_access un
  for un :: "'a list \<Rightarrow> 'b \<Rightarrow> 'b" +
  fixes gen_succ :: "('a \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'a list"
  assumes gen_succ: "set (gen_succ rel as) = {b. \<exists> a \<in> set as. (a, b) \<in> set rel}"
begin

abbreviation "rtrancl_i \<equiv> rtrancl_impl gen_succ un memb empty"
abbreviation "trancl_i \<equiv> trancl_impl gen_succ un memb empty"

lemma rtrancl_impl:
  "set_of (rtrancl_i rel as) = {b. (\<exists> a \<in> set as. (a, b) \<in> (set rel)\<^sup>*)}"
proof -
  interpret set_access_succ set_of memb empty un "gen_succ rel" "set rel"
    by (unfold_locales, insert gen_succ, auto)
  show ?thesis unfolding rtrancl_impl_def Let_def relpow_impl
    by (auto simp: rtrancl_finite_relpow)
qed

lemma trancl_impl:
  "set_of (trancl_i rel as) = {b. (\<exists> a \<in> set as. (a, b) \<in> (set rel)\<^sup>+)}"
proof -
  interpret set_access_succ set_of memb empty un "gen_succ rel" "set rel"
    by (unfold_locales, insert gen_succ, auto)
  show ?thesis
    unfolding trancl_impl_def Let_def relpow_impl trancl_unfold_left relcomp_unfold rtrancl_finite_relpow succ by auto
qed

end

end


theory Excercise
imports Main
begin
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"
primrec mirror :: "'a tree \<Rightarrow> 'a tree"
  where
  "mirror Tip = Tip" |
  "mirror (Node l x r) = Node (mirror r) x (mirror l)"
lemma mirror_mirror: "mirror (mirror t) = t"
  apply (induct_tac)
  apply auto
  done

primrec flatten :: "'a tree \<Rightarrow> 'a list"
  where
  "flatten Tip = []" |
  "flatten (Node l x r) = (flatten l) @ (x # (flatten r))"

lemma flatten_mirror: "flatten(mirror t) = rev (flatten t)"
  apply (induct_tac t)
  apply auto
  done

lemma "(case xs of [] \<Rightarrow> [] | y#ys \<Rightarrow> xs) = xs"
  apply (case_tac xs)
  apply auto
  done

datatype boolex = Const bool | Var nat | Neg boolex |  And boolex boolex
primrec "value" :: "boolex \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> bool"  where
  "value (Const b) env = b" |
  "value (Var x) env   = env x" |
  "value (Neg b) env   = (\<not> value b env)" |
  "value (And b c) env = (value b env \<and> value c env)"

datatype ifex = CIF bool | VIF nat | IF ifex ifex ifex
primrec valif :: "ifex \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> bool" where
  "valif (CIF b)    env = b" |
  "valif (VIF x)    env = env x" |
  "valif (IF b t e) env = (if valif b env then valif t env
                                          else valif e env)"

primrec bool2if :: "boolex \<Rightarrow> ifex" where
  "bool2if (Const b) = CIF b" |
  "bool2if (Var x)   = VIF x" |
  "bool2if (Neg b)   = IF (bool2if b) (CIF False) (CIF True)" |
  "bool2if (And b c) = IF (bool2if b) (bool2if c) (CIF False)"

lemma "valif (bool2if b) env = value b env"
  apply (induct_tac b)
  apply auto
  done

primrec normif :: "ifex \<Rightarrow> ifex \<Rightarrow> ifex \<Rightarrow> ifex" where
  "normif (CIF b) t e    = IF (CIF b) t e" |
  "normif (VIF x) t e    = IF (VIF x) t e" |
  "normif (IF b t e) u f = normif b (normif t u f) (normif e u f)"

primrec norm :: "ifex \<Rightarrow> ifex" where
  "norm (CIF b)    = CIF b" |
  "norm (VIF x)    = VIF x" |
  "norm (IF b t e) = normif b (norm t) (norm e)"

theorem "valif (norm b) env = valif b env"
  apply (induct_tac b)
  apply auto
  done

primrec normal :: "ifex \<Rightarrow> bool" where
  "normal (CIF b) = True" |
  "normal (VIF x) = True" |
  "normal (IF b t e) = (normal t \<and> normal e \<and>
                       (case b of CIF b \<Rightarrow> True
                                | VIF x \<Rightarrow> True
                                | IF x y z \<Rightarrow> False))"

lemma [simp]: "\<forall> t e. normal (normif b t e) = (normal t \<and> normal e)"
  apply (induct_tac b)
  apply auto
  done

primrec normif_s :: "ifex \<Rightarrow> ifex \<Rightarrow> ifex \<Rightarrow> ifex" where
  "normif_s (CIF b) t e    = (if b then t else e)" |
  "normif_s (VIF x) t e    = IF (VIF x) t e" |
  "normif_s (IF b t e) u f = normif_s b (normif_s t u f) (normif_s e u f)"

primrec norm_s :: "ifex \<Rightarrow> ifex" where
  "norm_s (CIF b)    = CIF b" |
  "norm_s (VIF x)    = VIF x" |
  "norm_s (IF b t e) = normif_s b (norm_s t) (norm_s e)"

lemma [simp]: "\<forall> t e. valif (normif_s b t e) env = valif (IF b t e) env"
  apply (induct_tac b)
  apply auto
  done

theorem "valif (norm b) env = valif b env"
  apply (induct_tac b)
  apply auto
  done

primrec normal_s :: "ifex \<Rightarrow> bool" where
  "normal_s (CIF b) = True" |
  "normal_s (VIF x) = True" |
  "normal_s (IF b t e) = (normal_s t \<and> normal_s e \<and>
                       (case b of CIF b \<Rightarrow> False
                                | VIF x \<Rightarrow> True
                                | IF x y z \<Rightarrow> False))"

lemma [simp]: "\<forall> t e. normal_s (normif_s b t e) \<longrightarrow> (normal_s t \<and> normal_s e)"
  apply (induct_tac b)
  apply auto
  done

end


(* Author:     Johannes Hoelzl <hoelzl@in.tum.de> 2009 *)

theory Approximation_Ex
imports Complex_Main "../Approximation"
begin

text \<open>

Here are some examples how to use the approximation method.

The approximation method has the following syntax:

approximate "prec" (splitting: "x" = "depth" and "y" = "depth" ...)? (taylor: "z" = "derivates")?

Here "prec" specifies the precision used in all computations, it is specified as
number of bits to calculate. In the proposition to prove an arbitrary amount of
variables can be used, but each one need to be bounded by an upper and lower
bound.

To specify the bounds either @{term "l\<^sub>1 \<le> x \<and> x \<le> u\<^sub>1"},
@{term "x \<in> { l\<^sub>1 .. u\<^sub>1 }"} or @{term "x = bnd"} can be used. Where the
bound specification are again arithmetic formulas containing variables. They can
be connected using either meta level or HOL equivalence.

To use interval splitting add for each variable whos interval should be splitted
to the "splitting:" parameter. The parameter specifies how often each interval
should be divided, e.g. when x = 16 is specified, there will be @{term "65536 = 2^16"}
intervals to be calculated.

To use taylor series expansion specify the variable to derive. You need to
specify the amount of derivations to compute. When using taylor series expansion
only one variable can be used.

\<close>

section "Compute some transcendental values"

lemma "\<bar> ln 2 - 544531980202654583340825686620847 / 785593587443817081832229725798400 \<bar> < (inverse (2^51) :: real)"
  by (approximation 60)

lemma "\<bar> exp 1.626 - 5.083499996273 \<bar> < (inverse 10 ^ 10 :: real)"
  by (approximation 40)

lemma "\<bar> sqrt 2 - 1.4142135623730951 \<bar> < inverse 10 ^ 16"
  by (approximation 60)

lemma "\<bar> pi - 3.1415926535897932385 \<bar> < inverse 10 ^ 18"
  by (approximation 70)

lemma "\<bar> sin 100 + 0.50636564110975879 \<bar> < (inverse 10 ^ 17 :: real)"
  by (approximation 70)

section "Use variable ranges"

lemma "0.5 \<le> x \<and> x \<le> 4.5 \<Longrightarrow> \<bar> arctan x - 0.91 \<bar> < 0.455"
  by (approximation 10)

lemma "x \<in> {0.5 .. 4.5} \<longrightarrow> \<bar> arctan x - 0.91 \<bar> < 0.455"
  by (approximation 10)

lemma "0.49 \<le> x \<and> x \<le> 4.49 \<Longrightarrow> \<bar> arctan x - 0.91 \<bar> < 0.455"
  by (approximation 20)

lemma "1 / 2^1 \<le> x \<and> x \<le> 9 / 2^1 \<Longrightarrow> \<bar> arctan x - 0.91 \<bar> < 0.455"
  by (approximation 10)

lemma "3.2 \<le> (x::real) \<and> x \<le> 6.2 \<Longrightarrow> sin x \<le> 0"
  by (approximation 10)

lemma "3.2 \<le> (x::real) \<and> x \<le> 3.9 \<Longrightarrow> real_of_int (ceiling x) \<in> {4 .. 4}"
  by (approximation 10)

lemma
  defines "g \<equiv> 9.80665" and "v \<equiv> 128.61" and "d \<equiv> pi / 180"
  shows "g / v * tan (35 * d) \<in> { 3 * d .. 3.1 * d }"
  using assms by (approximation 20)

lemma "x \<in> { 0 .. 1 :: real } \<longrightarrow> x\<^sup>2 \<le> x"
  by (approximation 30 splitting: x=1 taylor: x = 3)

lemma "(n::real) \<in> {32 .. 62} \<Longrightarrow> \<lceil>log 2 (2 * (\<lfloor>n\<rfloor> div 2) + 1)\<rceil> = \<lceil>log 2 (\<lfloor>n\<rfloor> + 1)\<rceil>"
  unfolding eq_iff
  by (approximation 20)

approximate 10

end


section \<open>Number theory problems\<close>

subsection \<open>IMO 2018 SL - N5\<close>

theory IMO_2018_SL_N5
imports Main
begin

definition perfect_square :: "int \<Rightarrow> bool" where
  "perfect_square s \<longleftrightarrow> (\<exists> r. s = r * r)"
(*
lemma perfect_square_root_pos:
  assumes "perfect_square s"
  shows "\<exists> r. r \<ge> 0 \<and> s = r * r"
  sorry

lemma not_perfect_square_15:
  fixes q::int
  shows "q^2 \<noteq> 15"
  sorry

lemma not_perfect_square_12:
  fixes q::int
  shows "q^2 \<noteq> 12"
  sorry

lemma not_perfect_square_8:
  fixes q::int
  shows "q^2 \<noteq> 8"
  sorry

lemma not_perfect_square_7:
  fixes q::int
  shows "q^2 \<noteq> 7"
  sorry

lemma not_perfect_square_5:
  fixes q::int
  shows "q^2 \<noteq> 5"
  sorry

lemma not_perfect_square_3:
  fixes q::int
  shows "q^2 \<noteq> 3"
  sorry
*)
lemma IMO2018SL_N5_lemma:
  fixes s a b c d :: int
  assumes "s^2 = a^2 + b^2" "s^2 = c^2 + d^2" "2*s = a^2 - c^2"
  assumes  "s > 0" "a \<ge> 0" "d \<ge> 0" "b \<ge> 0" "c \<ge> 0" "b > 0 \<or> c > 0" "b \<ge> c"
  shows False
  sorry

theorem IMO2018SL_N5:
  fixes x y z t :: int
  assumes pos: "x > 0" "y > 0" "z > 0" "t > 0"
  assumes eq: "x*y - z*t = x + y" "x + y = z + t"
  shows " \<not> (perfect_square (x*y) \<and> perfect_square (z*t))"
  sorry

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

header "Machine Word Setup"

theory WordSetup
imports WordEnum DistinctProp

begin

text {* This theory defines the standard platform-specific word size
and alignment. *}

definition
  word_bits :: nat where
  "word_bits \<equiv> len_of TYPE(32)"

definition
  word_size :: "'a :: numeral" where
  "word_size \<equiv> 4"

lemma word_bits_conv:
  "word_bits = 32" unfolding word_bits_def by simp

lemma word_bits_word_size_conv:
  "word_bits = word_size * 8"
  unfolding word_bits_def word_size_def by simp

definition
  is_aligned :: "'a :: len word \<Rightarrow> nat \<Rightarrow> bool" where
  "is_aligned ptr n \<equiv> 2^n dvd unat ptr"

definition
  ptr_add :: "word32 \<Rightarrow> nat \<Rightarrow> word32" where
  "ptr_add ptr n \<equiv> ptr + of_nat n"

definition
  complement :: "('a :: len) word \<Rightarrow> 'a word"  where
 "complement x \<equiv> x xor -1"

definition
  alignUp :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word" where
 "alignUp x n \<equiv> x + 2 ^ n - 1 && complement (2 ^ n - 1)"

end


theory ex4_02 imports Main begin

inductive palindrome :: "'a list \<Rightarrow> bool" where
"palindrome []" |
"palindrome [x]" |
"palindrome xs \<Longrightarrow> palindrome (a#xs@[a])"

theorem "palindrome xs \<Longrightarrow> rev xs = xs"
apply(induction xs rule: "palindrome.induct")
apply auto
done

end


(* Author: Gerwin Klein, Tobias Nipkow *)

theory Big_Step_7_9 imports Com_7_9 begin

subsection "Big-Step Semantics of Commands"

text {*
The big-step semantics is a straight-forward inductive definition
with concrete syntax. Note that the first paramenter is a tuple,
so the syntax becomes @{text "(c,s) \<Rightarrow> s'"}.
*}

text_raw{*\snip{BigStepdef}{0}{1}{% *}
inductive
  big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where
Skip: "(SKIP,s) \<Rightarrow> s" |
Assign: "(x ::= a,s) \<Rightarrow> s(x := aval a s)" |
Seq: "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
IfTrue: "\<lbrakk> bval b s;  (c\<^sub>1,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
IfFalse: "\<lbrakk> \<not>bval b s;  (c\<^sub>2,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> s" |
WhileTrue:
"\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
\<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
RepeatTrue: "\<lbrakk> bval b t;  (c, s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (REPEAT c UNTIL b, s) \<Rightarrow> t" |
RepeatFalse:
"\<lbrakk> \<not>bval b s\<^sub>2;  (c, s\<^sub>1) \<Rightarrow> s\<^sub>2;  (REPEAT c UNTIL b, s\<^sub>2) \<Rightarrow> s\<^sub>3  \<rbrakk>
\<Longrightarrow> (REPEAT c UNTIL b, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
Or1: "(c\<^sub>1, s) \<Rightarrow> t \<Longrightarrow> (c\<^sub>1 OR c\<^sub>2, s) \<Rightarrow> t" |
Or2: "(c\<^sub>2, s) \<Rightarrow> t \<Longrightarrow> (c\<^sub>1 OR c\<^sub>2, s) \<Rightarrow> t"

text_raw{*}%endsnip*}

text_raw{*\snip{BigStepEx}{1}{2}{% *}
schematic_lemma ex: "(''x'' ::= N 5;; ''y'' ::= V ''x'', s) \<Rightarrow> ?t"
apply(rule Seq)
apply(rule Assign)
apply simp
apply(rule Assign)
done
text_raw{*}%endsnip*}

thm ex[simplified]

text{* We want to execute the big-step rules: *}

code_pred big_step .

text{* For inductive definitions we need command
       \texttt{values} instead of \texttt{value}. *}

values "{t. (SKIP, \<lambda>_. 0) \<Rightarrow> t}"

text{* We need to translate the result state into a list
to display it. *}

values "{map t [''x'', ''y''] |t. (SKIP OR (''x'' ::= N 2 ;; ''x'' ::= N 3), <''x'' := 42>) \<Rightarrow> t}"

values "{map t [''x''] |t. (''x'' ::= N 2, <''x'' := 42>) \<Rightarrow> t}"

values "{map t [''x'',''y''] |t.
  (WHILE Less (V ''x'') (V ''y'') DO (''x'' ::= Plus (V ''x'') (N 5)),
   <''x'' := 0, ''y'' := 13>) \<Rightarrow> t}"

values "{map t [''x'',''y''] |t.
  (REPEAT (''x'' ::= Plus (V ''x'') (N 5)) UNTIL Less  (V ''y'') (V ''x''),
   <''x'' := 0, ''y'' := 13>) \<Rightarrow> t}"

text{* Proof automation: *}

text {* The introduction rules are good for automatically
construction small program executions. The recursive cases
may require backtracking, so we declare the set as unsafe
intro rules. *}
declare big_step.intros [intro]

text{* The standard induction rule
@{thm [display] big_step.induct [no_vars]} *}

thm big_step.induct

text{*
This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the @{text c}, @{text s},
and @{text s'} that we are likely to encounter. Splitting
the tuple parameter fixes this:
*}
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct
text {*
@{thm [display] big_step_induct [no_vars]}
*}

subsection "Rule inversion"

text{* What can we deduce from @{prop "(SKIP,s) \<Rightarrow> t"} ?
That @{prop "s = t"}. This is how we can automatically prove it: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<Rightarrow> t"
thm SkipE

text{* This is an \emph{elimination rule}. The [elim] attribute tells auto,
blast and friends (but not simp!) to use it automatically; [elim!] means that
it is applied eagerly.

Similarly for the other commands: *}

inductive_cases AssignE[elim!]: "(x ::= a,s) \<Rightarrow> t"
thm AssignE
inductive_cases SeqE[elim!]: "(c1;;c2,s1) \<Rightarrow> s3"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> t"
thm IfE

inductive_cases WhileE[elim]: "(WHILE b DO c,s) \<Rightarrow> t"
thm WhileE
text{* Only [elim]: [elim!] would not terminate. *}

inductive_cases RepeatE[elim]: "(REPEAT c UNTIL b,s) \<Rightarrow> t"
thm RepeatE

inductive_cases OrE[elim!]: "(c1 OR c2, s) \<Rightarrow> t"
thm OrE

text{* An automatic example: *}

text{* Rule inversion by hand via the ``cases'' method: *}

lemma assumes "(IF b THEN SKIP ELSE SKIP, s) \<Rightarrow> t"
shows "t = s"
proof-
  from assms show ?thesis
  proof cases  --"inverting assms"
    case IfTrue thm IfTrue
    thus ?thesis by blast
  next
    case IfFalse thus ?thesis by blast
  qed
qed

(* Using rule inversion to prove simplification rules: *)
lemma assign_simp:
  "(x ::= a,s) \<Rightarrow> s' \<longleftrightarrow> (s' = s(x := aval a s))"
  by auto

text {* An example combining rule inversion and derivations *}
lemma Seq_assoc:
  "(c1;; c2;; c3, s) \<Rightarrow> s' \<longleftrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> s'"
proof
  assume "(c1;; c2;; c3, s) \<Rightarrow> s'"
  then obtain s1 s2 where
    c1: "(c1, s) \<Rightarrow> s1" and
    c2: "(c2, s1) \<Rightarrow> s2" and
    c3: "(c3, s2) \<Rightarrow> s'" by auto
  from c2 c3
  have "(c2;; c3, s1) \<Rightarrow> s'" by (rule Seq)
  with c1
  show "(c1;; (c2;; c3), s) \<Rightarrow> s'" by (rule Seq)
next
  -- "The other direction is analogous"
  assume "(c1;; (c2;; c3), s) \<Rightarrow> s'"
  thus "(c1;; c2;; c3, s) \<Rightarrow> s'" by auto
qed

subsection "Command Equivalence"

text {*
  We call two statements @{text c} and @{text c'} equivalent wrt.\ the
  big-step semantics when \emph{@{text c} started in @{text s} terminates
  in @{text s'} iff @{text c'} started in the same @{text s} also terminates
  in the same @{text s'}}. Formally:
*}
text_raw{*\snip{BigStepEquiv}{0}{1}{% *}
abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c,s) \<Rightarrow> t  =  (c',s) \<Rightarrow> t)"
text_raw{*}%endsnip*}

text {*
Warning: @{text"\<sim>"} is the symbol written \verb!\ < s i m >! (without spaces).

  As an example, we show that loop unfolding is an equivalence
  transformation on programs:
*}
lemma unfold_while:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w \<sim> ?iw")
proof -
  -- "to show the equivalence, we look at the derivation tree for"
  -- "each side and from that construct a derivation tree for the other side"
  { fix s t assume "(?w, s) \<Rightarrow> t"
    -- "as a first thing we note that, if @{text b} is @{text False} in state @{text s},"
    -- "then both statements do nothing:"
    { assume "\<not>bval b s"
      hence "t = s" using `(?w,s) \<Rightarrow> t` by blast
      hence "(?iw, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then only the @{text WhileTrue} rule can have been used to derive @{text "(?w, s) \<Rightarrow> t"} *}
    { assume "bval b s"
      with `(?w, s) \<Rightarrow> t` obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "now we can build a derivation tree for the @{text IF}"
      -- "first, the body of the True-branch:"
      hence "(c;; ?w, s) \<Rightarrow> t" by (rule Seq)
      -- "then the whole @{text IF}"
      with `bval b s` have "(?iw, s) \<Rightarrow> t" by (rule IfTrue)
    }
    ultimately
    -- "both cases together give us what we want:"
    have "(?iw, s) \<Rightarrow> t" by blast
  }
  moreover
  -- "now the other direction:"
  { fix s t assume "(?iw, s) \<Rightarrow> t"
    -- "again, if @{text b} is @{text False} in state @{text s}, then the False-branch"
    -- "of the @{text IF} is executed, and both statements do nothing:"
    { assume "\<not>bval b s"
      hence "s = t" using `(?iw, s) \<Rightarrow> t` by blast
      hence "(?w, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then this time only the @{text IfTrue} rule can have be used *}
    { assume "bval b s"
      with `(?iw, s) \<Rightarrow> t` have "(c;; ?w, s) \<Rightarrow> t" by auto
      -- "and for this, only the Seq-rule is applicable:"
      then obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "with this information, we can build a derivation tree for the @{text WHILE}"
      with `bval b s`
      have "(?w, s) \<Rightarrow> t" by (rule WhileTrue)
    }
    ultimately
    -- "both cases together again give us what we want:"
    have "(?w, s) \<Rightarrow> t" by blast
  }
  ultimately
  show ?thesis by blast
qed

text {* Luckily, such lengthy proofs are seldom necessary.  Isabelle can
prove many such facts automatically.  *}

lemma while_unfold:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)"
by blast

lemma triv_if:
  "(IF b THEN c ELSE c) \<sim> c"
by blast

lemma commute_if:
  "(IF b1 THEN (IF b2 THEN c11 ELSE c12) ELSE c2)
   \<sim>
   (IF b2 THEN (IF b1 THEN c11 ELSE c2) ELSE (IF b1 THEN c12 ELSE c2))"
by blast

lemma sim_while_cong_aux:
  "(WHILE b DO c,s) \<Rightarrow> t  \<Longrightarrow> c \<sim> c' \<Longrightarrow>  (WHILE b DO c',s) \<Rightarrow> t"
apply(induction "WHILE b DO c" s t arbitrary: b c rule: big_step_induct)
 apply blast
apply blast
done

lemma sim_while_cong: "c \<sim> c' \<Longrightarrow> WHILE b DO c \<sim> WHILE b DO c'"
by (metis sim_while_cong_aux)

text {* Command equivalence is an equivalence relation, i.e.\ it is
reflexive, symmetric, and transitive. Because we used an abbreviation
above, Isabelle derives this automatically. *}

lemma sim_refl:  "c \<sim> c" by simp
lemma sim_sym:   "(c \<sim> c') = (c' \<sim> c)" by auto
lemma sim_trans: "c \<sim> c' \<Longrightarrow> c' \<sim> c'' \<Longrightarrow> c \<sim> c''" by auto

lemma or_comm: "(c1 OR c2) \<sim> (c2 OR c1)"
 by blast

end


theory Shortest_Path_Tree
  imports Tree
begin

locale shortest_path_tree = rooted_spanning_tree G T root for G T root +
  fixes f :: "'a cost_fun"
  assumes cost_non_negative: "\<And>e. e \<in> edges G \<Longrightarrow> 0 \<le> f e"
  assumes "v \<in> vertices T \<Longrightarrow> shortest_walk_cost T f root v = shortest_walk_cost G f root v"

lemmas (in shortest_path_tree) spanning = spanning

lemma (in shortest_path_tree) shortest_path:
  shows "shortest_walk_cost T f root v = shortest_walk_cost G f root v"
proof (cases)
  assume v_in_vertices: "v \<in> vertices T"
  have "shortest_path_tree_axioms G T root f"
    using shortest_path_tree_axioms
    by (rule shortest_path_tree.axioms(2))
  thus ?thesis
    using v_in_vertices
    by (simp add: shortest_path_tree_axioms_def)
next
  assume v_not_in_vertices_T: "v \<notin> vertices T"
  hence v_not_in_vertices_G: "v \<notin> vertices G"
    by (simp add: spanning)

  have "shortest_walk_cost T f root v = \<infinity>"
    using v_not_in_vertices_T
    by (rule subgraph.shortest_walk_cost_infinite_if_not_in_vertices)
  moreover have "shortest_walk_cost G f root v = \<infinity>"
    using v_not_in_vertices_G
    by (rule supergraph.shortest_walk_cost_infinite_if_not_in_vertices)
  ultimately show ?thesis
    by simp
qed

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
theory TIP_prop_64
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun last :: "Nat list => Nat" where
  "last (nil2) = Z"
| "last (cons2 z (nil2)) = z"
| "last (cons2 z (cons2 x2 x3)) = last (cons2 x2 x3)"

theorem property0 :
  "((last (x xs (cons2 y (nil2)))) = y)"
  find_proof DInd
  apply (induct xs rule: TIP_prop_64.last.induct)
    apply auto
  done

end


(*  Title:      regular/Regular_Sensors.thy
    Author:     Sven Linker

Instantiation of the sensor function to model "regular sensors". That is,
each car can perceive its the physical size and the concrete
braking distance, but can only perceive the physical size of all other cars.
*)

section \<open>Regular Sensors\<close>
text\<open>
This section contains an instantiations of the sensor function for
"regular sensors". That is, each car can perceive its own physical
size and braking distance. However, it can only perceive
the physical size of other cars, and does not know about
their braking distance.
\<close>

theory Regular_Sensors
  imports  "../Length"
begin

definition regular::"cars \<Rightarrow> traffic \<Rightarrow> cars \<Rightarrow> real"
  where "regular e ts c \<equiv>
    if (e = c) then traffic.physical_size ts c + traffic.braking_distance ts c
               else traffic.physical_size ts c "

locale regular_sensors = traffic + view
begin

interpretation regular_sensors: sensors "regular :: cars \<Rightarrow> traffic \<Rightarrow> cars \<Rightarrow> real "
proof unfold_locales
  fix e ts c
  show " 0 < regular e ts c"
    by (metis (no_types, hide_lams) less_add_same_cancel2 less_trans regular_def
        traffic.psGeZero traffic.sdGeZero)
qed

notation regular_sensors.space ("space")
notation regular_sensors.len ("len")

text\<open>
Similar to the situation with perfect sensors, we can show that the perceived length of a car
is independent of the spatial transitions between traffic snapshots. The
length may only change during evolutions, in particular if the car changes its dynamical
behaviour.
\<close>

lemma create_reservation_length_stable:
  "(ts\<^bold>\<midarrow>r(d)\<^bold>\<rightarrow>ts') \<longrightarrow> len v ts c = len v ts' c"
proof
  assume assm:"(ts\<^bold>\<midarrow>r(d)\<^bold>\<rightarrow>ts')"
  hence eq:"space ts v c = space ts' v c"
    using traffic.create_reservation_def sensors.space_def regular_def
    by (simp add: regular_sensors.sensors_axioms)
  show "len v ( ts) c = len v ( ts') c"
  proof (cases "left ((space ts v) c) > right (ext v)")
    assume outside_right:"left ((space ts v) c) > right (ext v)"
    hence outside_right':"left ((space ts' v) c) > right (ext v)" using eq by simp
    from outside_right and outside_right' show ?thesis
      by (simp add: regular_sensors.len_def eq)
  next
    assume inside_right:"\<not> left ((space ts v) c) > right (ext v)"
    hence inside_right':"\<not> left ((space ts' v) c) > right (ext v)" using eq by simp
    show "len v ( ts) c = len v ( ts') c"
    proof (cases " left (ext v) > right ((space ts v) c) ")
      assume outside_left:" left (ext v) > right ((space ts v) c) "
      hence outside_left':" left (ext v) > right ((space ts' v) c) "using eq by simp
      from outside_left and outside_left' show ?thesis
        by (simp add: regular_sensors.len_def eq)
    next
      assume inside_left:"\<not> left (ext v) > right ((space ts v) c) "
      hence inside_left':"\<not> left (ext v) > right ((space ts' v) c) " using eq by simp
      from inside_left inside_right inside_left' inside_right' eq
      show ?thesis by (simp add: regular_sensors.len_def)
    qed
  qed
qed

lemma create_claim_length_stable:
  "(ts\<^bold>\<midarrow>c(d,n)\<^bold>\<rightarrow>ts') \<longrightarrow> len v ts c = len v ts' c"
proof
  assume assm:"(ts\<^bold>\<midarrow>c(d,n)\<^bold>\<rightarrow>ts')"
  hence eq:"space ts v c = space ts' v c"
    using traffic.create_claim_def sensors.space_def regular_def
    by (simp add: regular_sensors.sensors_axioms)
  show "len v ( ts) c = len v ( ts') c"
  proof (cases "left ((space ts v) c) > right (ext v)")
    assume outside_right:"left ((space ts v) c) > right (ext v)"
    hence outside_right':"left ((space ts' v) c) > right (ext v)" using eq by simp
    from outside_right and outside_right' show ?thesis
      by (simp add: regular_sensors.len_def eq)
  next
    assume inside_right:"\<not> left ((space ts v) c) > right (ext v)"
    hence inside_right':"\<not> left ((space ts' v) c) > right (ext v)" using eq by simp
    show "len v ( ts) c = len v ( ts') c"
    proof (cases " left (ext v) > right ((space ts v) c) ")
      assume outside_left:" left (ext v) > right ((space ts v) c) "
      hence outside_left':" left (ext v) > right ((space ts' v) c) "using eq by simp
      from outside_left and outside_left' show ?thesis
        by (simp add: regular_sensors.len_def eq)
    next
      assume inside_left:"\<not> left (ext v) > right ((space ts v) c) "
      hence inside_left':"\<not> left (ext v) > right ((space ts' v) c) " using eq by simp
      from inside_left inside_right inside_left' inside_right' eq
      show ?thesis by (simp add: regular_sensors.len_def)
    qed
  qed
qed

lemma withdraw_reservation_length_stable:
  "(ts\<^bold>\<midarrow>wdr(d,n)\<^bold>\<rightarrow>ts') \<longrightarrow> len v ts c = len v ts' c"
proof
  assume assm:"(ts\<^bold>\<midarrow>wdr(d,n)\<^bold>\<rightarrow>ts')"
  hence eq:"space ts v c = space ts' v c"
    using traffic.withdraw_reservation_def sensors.space_def regular_def
    by (simp add: regular_sensors.sensors_axioms)
  show "len v ( ts) c = len v ( ts') c"
  proof (cases "left ((space ts v) c) > right (ext v)")
    assume outside_right:"left ((space ts v) c) > right (ext v)"
    hence outside_right':"left ((space ts' v) c) > right (ext v)" using eq by simp
    from outside_right and outside_right' show ?thesis
      by (simp add: regular_sensors.len_def eq)
  next
    assume inside_right:"\<not> left ((space ts v) c) > right (ext v)"
    hence inside_right':"\<not> left ((space ts' v) c) > right (ext v)" using eq by simp
    show "len v ( ts) c = len v ( ts') c"
    proof (cases " left (ext v) > right ((space ts v) c) ")
      assume outside_left:" left (ext v) > right ((space ts v) c) "
      hence outside_left':" left (ext v) > right ((space ts' v) c) "using eq by simp
      from outside_left and outside_left' show ?thesis
        by (simp add: regular_sensors.len_def eq)
    next
      assume inside_left:"\<not> left (ext v) > right ((space ts v) c) "
      hence inside_left':"\<not> left (ext v) > right ((space ts' v) c) " using eq by simp
      from inside_left inside_right inside_left' inside_right' eq
      show ?thesis by (simp add: regular_sensors.len_def)
    qed
  qed
qed

lemma withdraw_claim_length_stable:
  "(ts\<^bold>\<midarrow>wdc(d)\<^bold>\<rightarrow>ts') \<longrightarrow> len v ts c = len v ts' c"
proof
  assume assm:"(ts\<^bold>\<midarrow>wdc(d)\<^bold>\<rightarrow>ts')"
  hence eq:"space ts v c = space ts' v c"
    using traffic.withdraw_claim_def sensors.space_def regular_def
    by (simp add: regular_sensors.sensors_axioms)
  show "len v ( ts) c = len v ( ts') c"
  proof (cases "left ((space ts v) c) > right (ext v)")
    assume outside_right:"left ((space ts v) c) > right (ext v)"
    hence outside_right':"left ((space ts' v) c) > right (ext v)" using eq by simp
    from outside_right and outside_right' show ?thesis
      by (simp add: regular_sensors.len_def eq)
  next
    assume inside_right:"\<not> left ((space ts v) c) > right (ext v)"
    hence inside_right':"\<not> left ((space ts' v) c) > right (ext v)" using eq by simp
    show "len v ( ts) c = len v ( ts') c"
    proof (cases " left (ext v) > right ((space ts v) c) ")
      assume outside_left:" left (ext v) > right ((space ts v) c) "
      hence outside_left':" left (ext v) > right ((space ts' v) c) "using eq by simp
      from outside_left and outside_left' show ?thesis
        by (simp add: regular_sensors.len_def eq)
    next
      assume inside_left:"\<not> left (ext v) > right ((space ts v) c) "
      hence inside_left':"\<not> left (ext v) > right ((space ts' v) c) " using eq by simp
      from inside_left inside_right inside_left' inside_right' eq
      show ?thesis by (simp add: regular_sensors.len_def)
    qed
  qed
qed

text\<open>
Since the perceived length of cars depends on the owner of the view,
we can now prove how this perception changes if we change the
perspective of a view.
\<close>

lemma sensors_le:"e \<noteq> c \<longrightarrow> regular e ts c < regular c ts c"
  using  traffic.sdGeZero by (simp add: regular_def)

lemma sensors_leq:" regular e ts c \<le> regular c ts c"
  by (metis less_eq_real_def regular_sensors.sensors_le)

lemma space_eq: "own v = own v' \<longrightarrow> space ts v c = space ts v' c"
  using regular_sensors.space_def sensors_def by auto

lemma switch_space_le:"(own v) \<noteq> c \<and> (v=c>v') \<longrightarrow> space ts v c < space ts v' c"
proof
  assume assm:"(own v) \<noteq> c \<and> (v=c>v')"
  hence sens:"regular (own v) ts c < regular (own v') ts c"
    using sensors_le view.switch_def  by auto
  then have le:"pos ts c + regular (own v) ts c < pos ts c + regular (own v') ts c"
    by auto
  have left_eq:"left (space ts v c) = left (space ts v' c)"
    using regular_sensors.left_space by auto
  have r1:"right (space ts v c ) = pos ts c + regular (own v) ts c"
    using regular_sensors.right_space  by auto
  have r2:"right (space ts v' c ) = pos ts c + regular (own v') ts c"
    using regular_sensors.right_space  by auto
  then have "right (space ts v c) < right( space ts v' c)"
    using r1 r2 le by auto
  then have "left (space ts v' c) \<ge> left (space ts v c)
              \<and> (right (space ts v c) \<le> right( space ts v' c))
              \<and>  \<not>(left (space ts v c) \<ge> left (space ts v' c)
                    \<and> right (space ts v' c) \<le> right (space ts v c))"
    using regular_sensors.left_space left_eq by auto
  then show "space ts v c < space ts v' c"
    using less_real_int_def left_eq by auto
qed

lemma switch_space_leq:"(v=c>v') \<longrightarrow> space ts v c \<le> space ts v' c"
  by (metis less_imp_le order_refl switch_space_le view.switch_refl view.switch_unique)
end
end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_sort_NStoogeSortCount
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

(*fun did not finish the proof*)
function third :: "int => int" where
  "third y =
   (if (y = 2) then 0 else
      (if (y = 1) then 0 else
         (if (y = 0) then 0 else 1 + (third (y - 3)))))"
  by pat_completeness auto

fun take :: "int => 'a list => 'a list" where
  "take y z =
   (if y <= 0 then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => cons2 z2 (take (y - 1) xs)))"

fun sort2 :: "int => int => int list" where
  "sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun reverse :: "'a list => 'a list" where
  "reverse (nil2) = nil2"
| "reverse (cons2 z xs) = x (reverse xs) (cons2 z (nil2))"

fun length :: "'a list => int" where
  "length (nil2) = 0"
| "length (cons2 z l) = 1 + (length l)"

fun drop :: "int => 'a list => 'a list" where
  "drop y z =
   (if y <= 0 then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => drop (y - 1) xs1))"

fun splitAt :: "int => 'a list =>
                (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function nstooge1sort2 :: "int list => int list"
  and nstoogesort :: "int list => int list"
  and nstooge1sort1 :: "int list => int list" where
  "nstooge1sort2 y =
   (case splitAt (third (length y)) (reverse y) of
      pair2 ys2 zs2 => x (nstoogesort zs2) (reverse ys2))"
| "nstoogesort (nil2) = nil2"
| "nstoogesort (cons2 z (nil2)) = cons2 z (nil2)"
| "nstoogesort (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "nstoogesort (cons2 z (cons2 y2 (cons2 x3 x4))) =
     nstooge1sort2
       (nstooge1sort1 (nstooge1sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "nstooge1sort1 y =
     (case splitAt (third (length y)) y of
        pair2 ys2 zs1 => x ys2 (nstoogesort zs1))"
  by pat_completeness auto

fun count :: "'a => 'a list => int" where
  "count y (nil2) = 0"
| "count y (cons2 z2 ys) =
     (if (y = z2) then 1 + (count y ys) else count y ys)"

theorem property0 :
  "((count y (nstoogesort xs)) = (count y xs))"
  oops

end