(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2007-2023  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

section \<open>Inductive sequences\<close>

theory InductiveSeq_ZF imports Nat_ZF_IML FiniteSeq_ZF FinOrd_ZF

begin

text\<open>In this theory we discuss sequences defined by conditions of the form
  $a_0 = x,\  a_{n+1} = f(a_n)$ and similar.\<close>

subsection\<open>Sequences defined by induction\<close>

text\<open>One way of defining a sequence (that is a function $a:\mathbb{N}\rightarrow X$)
  is to provide the first element of the sequence and a function to find the next
  value when we have the current one. This is usually called "defining a sequence
  by induction". In this section we set up the notion of
  a sequence defined by induction and prove the theorems needed to use it.\<close>

text\<open>First we define a helper notion of the sequence defined inductively up to a
  given natural number $n$.\<close>

definition
  "InductiveSequenceN(x,f,n) \<equiv>
  THE a. a: succ(n) \<rightarrow> domain(f) \<and> a`(0) = x \<and> (\<forall>k\<in>n. a`(succ(k)) = f`(a`(k)))"

text\<open>From that we define the inductive sequence on the
  whole set of natural numbers. Recall that in Isabelle/ZF the set of natural numbers
  is denoted \<open>nat\<close>.\<close>

definition
  "InductiveSequence(x,f) \<equiv> \<Union>n\<in>nat. InductiveSequenceN(x,f,n)"

text\<open>First we will consider the question of existence and uniqueness
  of finite inductive sequences. The proof
  is by induction and the next lemma is the $P(0)$ step. To understand the notation
  recall that for natural numbers in set theory we have $n = \{0,1,..,n-1\}$ and
  \<open>succ(n)\<close>$ = \{0,1,..,n\}$.\<close>

lemma indseq_exun0: assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X"
  shows
  "\<exists>! a. a: succ(0) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>0. a`(succ(k)) = f`(a`(k)) )"
proof
  fix a b
  assume A3:
    "a: succ(0) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>0. a`(succ(k)) = f`(a`(k)) )"
    "b: succ(0) \<rightarrow> X \<and> b`(0) = x \<and> ( \<forall>k\<in>0. b`(succ(k)) = f`(b`(k)) )"
  moreover have "succ(0) = {0}" by auto
  ultimately have "a: {0} \<rightarrow> X"  "b: {0} \<rightarrow> X" by auto
  then have "a = {\<langle>0, a`(0)\<rangle>}"   "b = {\<langle>0, b`(0)\<rangle>}" using func_singleton_pair
    by auto
  with A3 show "a=b" by simp
next
  let ?a = "{\<langle>0,x\<rangle>}"
  have "?a : {0} \<rightarrow> {x}" using singleton_fun by simp
  moreover from A1 A2 have "{x} \<subseteq> X" by simp
  ultimately have "?a : {0} \<rightarrow> X"
    using func1_1_L1B by blast
  moreover have "{0} = succ(0)" by auto
  ultimately have "?a : succ(0) \<rightarrow> X" by simp
  with A1 show
    "\<exists> a. a: succ(0) \<rightarrow> X \<and> a`(0) = x \<and> (\<forall>k\<in>0. a`(succ(k)) = f`(a`(k)))"
    using singleton_apply by auto
qed

text\<open>A lemma about restricting finite sequences needed for the proof of
  the inductive step of the existence and uniqueness of finite inductive seqences.\<close>

lemma indseq_restrict:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat" and
  A4: "a: succ(succ(n))\<rightarrow> X \<and> a`(0) = x \<and> (\<forall>k\<in>succ(n). a`(succ(k)) = f`(a`(k)))"
  and A5: "a\<^sub>r = restrict(a,succ(n))"
  shows
  "a\<^sub>r: succ(n) \<rightarrow> X \<and> a\<^sub>r`(0) = x \<and> ( \<forall>k\<in>n. a\<^sub>r`(succ(k)) = f`(a\<^sub>r`(k)) )"
proof -
  from A3 have "succ(n) \<subseteq> succ(succ(n))" by auto
  with A4 A5 have "a\<^sub>r: succ(n) \<rightarrow> X" using restrict_type2 by auto
  moreover
  from A3 have "0 \<in> succ(n)" using empty_in_every_succ by simp
  with A4 A5 have "a\<^sub>r`(0) = x" using restrict_if by simp
  moreover from A3 A4 A5 have "\<forall>k\<in>n. a\<^sub>r`(succ(k)) = f`(a\<^sub>r`(k))"
    using succ_ineq restrict_if by auto
  ultimately show ?thesis by simp
qed

text\<open>Existence and uniqueness of finite inductive sequences. The proof
  is by induction and the next lemma is the inductive step.\<close>

lemma indseq_exun_ind:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat" and
  A4: "\<exists>! a. a: succ(n) \<rightarrow> X \<and> a`(0) = x \<and> (\<forall>k\<in>n. a`(succ(k)) = f`(a`(k)))"
  shows
  "\<exists>! a. a: succ(succ(n)) \<rightarrow> X \<and> a`(0) = x \<and>
  ( \<forall>k\<in>succ(n). a`(succ(k)) = f`(a`(k)) )"
proof
  fix a b assume
    A5: "a: succ(succ(n)) \<rightarrow> X \<and> a`(0) = x \<and>
    ( \<forall>k\<in>succ(n). a`(succ(k)) = f`(a`(k)) )" and
    A6: "b: succ(succ(n)) \<rightarrow> X \<and> b`(0) = x \<and>
    ( \<forall>k\<in>succ(n). b`(succ(k)) = f`(b`(k)) )"
  show "a = b"
  proof -
    let ?a\<^sub>r = "restrict(a,succ(n))"
    let ?b\<^sub>r = "restrict(b,succ(n))"
    note A1 A2 A3 A5
    moreover have "?a\<^sub>r = restrict(a,succ(n))" by simp
    ultimately have I:
      "?a\<^sub>r: succ(n) \<rightarrow> X \<and> ?a\<^sub>r`(0) = x \<and> ( \<forall>k\<in>n. ?a\<^sub>r`(succ(k)) = f`(?a\<^sub>r`(k)) )"
      by (rule indseq_restrict)
    note A1 A2 A3 A6
    moreover have "?b\<^sub>r = restrict(b,succ(n))" by simp
    ultimately have
      "?b\<^sub>r: succ(n) \<rightarrow> X \<and> ?b\<^sub>r`(0) = x \<and> ( \<forall>k\<in>n. ?b\<^sub>r`(succ(k)) = f`(?b\<^sub>r`(k)) )"
      by (rule indseq_restrict)
    with A4 I have II: "?a\<^sub>r = ?b\<^sub>r" by blast
    from A3 have "succ(n) \<in> nat" by simp
    moreover from A5 A6 have
      "a: succ(succ(n)) \<rightarrow> X" and "b: succ(succ(n)) \<rightarrow> X"
      by auto
    moreover note II
    moreover
    have T: "n \<in> succ(n)" by simp
    then have "?a\<^sub>r`(n) = a`(n)" and "?b\<^sub>r`(n) = b`(n)" using restrict
      by auto
    with A5 A6 II T have "a`(succ(n)) = b`(succ(n))" by simp
    ultimately show "a = b" by (rule finseq_restr_eq)
  qed
next show
    "\<exists> a. a: succ(succ(n)) \<rightarrow> X \<and> a`(0) = x \<and>
    ( \<forall>k\<in>succ(n). a`(succ(k)) = f`(a`(k)) )"
  proof -
    from A4 obtain a where III: "a: succ(n) \<rightarrow> X" and IV: "a`(0) = x"
      and V: "\<forall>k\<in>n. a`(succ(k)) = f`(a`(k))" by auto
    let ?b = "a \<union> {\<langle>succ(n), f`(a`(n))\<rangle>}"
    from A1 III have
      VI: "?b : succ(succ(n)) \<rightarrow> X" and
      VII: "\<forall>k \<in> succ(n). ?b`(k) = a`(k)" and
      VIII: "?b`(succ(n)) = f`(a`(n))"
      using apply_funtype finseq_extend by auto
    from A3 have "0 \<in> succ(n)" using empty_in_every_succ by simp
    with IV VII have IX: "?b`(0) = x" by auto
    { fix k assume "k \<in> succ(n)"
      then have "k\<in>n \<or> k = n" by auto
      moreover
      { assume A7: "k \<in> n"
	with A3 VII have "?b`(succ(k)) = a`(succ(k))"
	  using succ_ineq by auto
	also from A7 V VII have "a`(succ(k)) = f`(?b`(k))" by simp
	finally have "?b`(succ(k)) =  f`(?b`(k))" by simp }
      moreover
      { assume A8: "k = n"
	with VIII have "?b`(succ(k)) =  f`(a`(k))" by simp
	with A8 VII VIII have "?b`(succ(k)) =  f`(?b`(k))" by simp }
      ultimately have "?b`(succ(k)) =  f`(?b`(k))" by auto
    } then have "\<forall>k \<in> succ(n). ?b`(succ(k)) =  f`(?b`(k))" by simp
    with VI IX show ?thesis by auto
  qed
qed

text\<open>The next lemma combines \<open>indseq_exun0\<close> and \<open>indseq_exun_ind\<close>
  to show the existence and uniqueness of finite sequences defined by induction.\<close>

lemma indseq_exun:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat"
  shows
  "\<exists>! a. a: succ(n) \<rightarrow> X \<and> a`(0) = x \<and> (\<forall>k\<in>n. a`(succ(k)) = f`(a`(k)))"
proof -
  note A3
  moreover from A1 A2 have
    "\<exists>! a. a: succ(0) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>0. a`(succ(k)) = f`(a`(k)) )"
    using indseq_exun0 by simp
  moreover from A1 A2 have "\<forall>k \<in> nat.
    ( \<exists>! a. a: succ(k) \<rightarrow> X \<and> a`(0) = x \<and>
    ( \<forall>i\<in>k. a`(succ(i)) = f`(a`(i)) )) \<longrightarrow>
    ( \<exists>! a. a: succ(succ(k)) \<rightarrow> X \<and> a`(0) = x \<and>
    ( \<forall>i\<in>succ(k). a`(succ(i)) = f`(a`(i)) ) )"
    using indseq_exun_ind by simp
  ultimately show
    "\<exists>! a. a: succ(n) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>n. a`(succ(k)) = f`(a`(k)) )"
    by (rule ind_on_nat)
qed

text\<open>We are now ready to prove the main theorem about finite inductive sequences.\<close>

theorem fin_indseq_props:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat" and
  A4: "a = InductiveSequenceN(x,f,n)"
  shows
  "a: succ(n) \<rightarrow> X"
  "a`(0) = x"
  "\<forall>k\<in>n. a`(succ(k)) = f`(a`(k))"
proof -
  let ?i = "THE a. a: succ(n) \<rightarrow> X \<and> a`(0) = x \<and>
    ( \<forall>k\<in>n. a`(succ(k)) = f`(a`(k)) )"
  from A1 A2 A3 have
    "\<exists>! a. a: succ(n) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>n. a`(succ(k)) = f`(a`(k)) )"
    using indseq_exun by simp
  then have
    "?i: succ(n) \<rightarrow> X \<and> ?i`(0) = x \<and> ( \<forall>k\<in>n. ?i`(succ(k)) = f`(?i`(k)) )"
    by (rule theI)
  moreover from A1 A4 have "a = ?i"
    using InductiveSequenceN_def func1_1_L1 by simp
  ultimately show
    "a: succ(n) \<rightarrow> X"   "a`(0) = x"   "\<forall>k\<in>n. a`(succ(k)) = f`(a`(k))"
    by auto
qed

text\<open>Since we have uniqueness we can show the inverse of \<open>fin_indseq_props\<close>:
  a sequence that satisfies the inductive sequence properties listed there
  is the inductively defined sequence. \<close>

lemma is_fin_indseq:
  assumes "n \<in> nat" "f: X\<rightarrow>X" "x\<in>X" and
  "a: succ(n) \<rightarrow> X" "a`(0) = x" "\<forall>k\<in>n. a`(succ(k)) = f`(a`(k))"
  shows "a = InductiveSequenceN(x,f,n)"
proof -
  let ?b = "InductiveSequenceN(x,f,n)"
  from assms(1,2,3) have
    "?b: succ(n) \<rightarrow> X" "?b`(0) = x" "\<forall>k\<in>n. ?b`(succ(k)) = f`(?b`(k))"
    using fin_indseq_props by simp_all
  with assms show ?thesis using indseq_exun by blast
qed

text\<open>A corollary about the domain of a finite inductive sequence.\<close>

corollary fin_indseq_domain:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat"
  shows "domain(InductiveSequenceN(x,f,n)) = succ(n)"
proof -
  from assms have "InductiveSequenceN(x,f,n) : succ(n) \<rightarrow> X"
    using fin_indseq_props by simp
  then show ?thesis using func1_1_L1 by simp
qed

text\<open>The collection of finite sequences defined by induction is consistent
  in the sense that the restriction of the sequence defined on a larger
  set to the smaller set is the same as the sequence defined on the smaller set.\<close>

lemma indseq_consistent: assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and
  A3: "i \<in> nat"  "j \<in> nat" and A4: "i \<subseteq> j"
  shows
  "restrict(InductiveSequenceN(x,f,j),succ(i)) = InductiveSequenceN(x,f,i)"
proof -
  let ?a = "InductiveSequenceN(x,f,j)"
  let ?b = "restrict(InductiveSequenceN(x,f,j),succ(i))"
  let ?c = "InductiveSequenceN(x,f,i)"
  from A1 A2 A3 have
    "?a: succ(j) \<rightarrow> X"  "?a`(0) = x"   "\<forall>k\<in>j. ?a`(succ(k)) = f`(?a`(k))"
    using fin_indseq_props by auto
  with A3 A4 have
    "?b: succ(i) \<rightarrow> X \<and> ?b`(0) = x \<and> ( \<forall>k\<in>i. ?b`(succ(k)) = f`(?b`(k)))"
    using succ_subset restrict_type2 empty_in_every_succ restrict succ_ineq
    by auto
  moreover from A1 A2 A3 have
    "?c: succ(i) \<rightarrow> X \<and> ?c`(0) = x \<and> ( \<forall>k\<in>i. ?c`(succ(k)) = f`(?c`(k)))"
    using fin_indseq_props by simp
  moreover from A1 A2 A3 have
    "\<exists>! a. a: succ(i) \<rightarrow> X \<and> a`(0) = x \<and> ( \<forall>k\<in>i. a`(succ(k)) = f`(a`(k)) )"
    using indseq_exun by simp
  ultimately show "?b = ?c" by blast
qed

text\<open>For any two natural numbers one of the corresponding inductive sequences
  is contained in the other.\<close>

lemma indseq_subsets: assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and
  A3: "i \<in> nat"  "j \<in> nat" and
  A4: "a = InductiveSequenceN(x,f,i)"  "b = InductiveSequenceN(x,f,j)"
  shows "a \<subseteq> b \<or> b \<subseteq> a"
proof -
  from A3 have "i\<subseteq>j \<or> j\<subseteq>i" using nat_incl_total by simp
  moreover
  { assume "i\<subseteq>j"
    with A1 A2 A3 A4 have "restrict(b,succ(i)) = a"
      using indseq_consistent by simp
    moreover have "restrict(b,succ(i)) \<subseteq> b"
      using restrict_subset by simp
    ultimately have "a \<subseteq> b \<or> b \<subseteq> a" by simp }
  moreover
  { assume "j\<subseteq>i"
    with A1 A2 A3 A4 have "restrict(a,succ(j)) = b"
      using indseq_consistent by simp
    moreover have "restrict(a,succ(j)) \<subseteq> a"
      using restrict_subset by simp
    ultimately have "a \<subseteq> b \<or> b \<subseteq> a" by simp }
  ultimately show  "a \<subseteq> b \<or> b \<subseteq> a" by auto
qed

text\<open>The inductive sequence generated by applying a function 0 times is just
  the singleton list containing the starting point.\<close>

lemma indseq_empty: assumes "f: X\<rightarrow>X" "x\<in>X"
  shows
    "InductiveSequenceN(x,f,0):{0}\<rightarrow>X"
    "InductiveSequenceN(x,f,0) = {\<langle>0,x\<rangle>}"
proof -
  let ?a = "InductiveSequenceN(x,f,0)"
  from assms have "?a:succ(0)\<rightarrow>X" and "?a`(0) = x"
    using fin_indseq_props(1,2) by simp_all
  moreover have "succ(0) = {0}" by auto
  ultimately show "?a:{0}\<rightarrow>X" by auto
  then have "?a = {\<langle>0,?a`(0)\<rangle>}" using func_singleton_pair
    by simp
  with\<open>?a`(0) = x\<close> show "?a = {\<langle>0,x\<rangle>}" by simp
qed

text\<open>The tail of an inductive sequence generated by $f$ and started from $x$
  is the same as the inductive sequence started from $f(x)$.\<close>

lemma indseq_tail: assumes "n \<in> nat" "f: X\<rightarrow>X" "x\<in>X"
  shows "Tail(InductiveSequenceN(x,f,succ(n))) = InductiveSequenceN(f`(x),f,n)"
proof -
  let ?a = "Tail(InductiveSequenceN(x,f,succ(n)))"
  from assms(2,3) have "f`(x)\<in>X" using apply_funtype by simp
  have  "?a: succ(n) \<rightarrow> X" "?a`(0) = f`(x)" and
        "\<forall>k\<in>n. ?a`(succ(k)) = f`(?a`(k))"
  proof -
    let ?b = "InductiveSequenceN(x,f,succ(n))"
    from assms have I: "succ(n)\<in>nat" "?b: succ(succ(n)) \<rightarrow> X"
      using fin_indseq_props(1) by simp_all
    then show "Tail(?b):succ(n)\<rightarrow>X" using tail_props by simp
    from assms(1) I have II: "Tail(?b)`(0) = ?b`(succ(0))"
      using tail_props empty_in_every_succ by blast
    from assms \<open>succ(n)\<in>nat\<close> have "?b`(succ(0)) = f`(?b`(0))"
      using fin_indseq_props(3) empty_in_every_succ by blast
    moreover from assms(2,3) \<open>succ(n)\<in>nat\<close> have "?b`(0) = x"
      using fin_indseq_props(2) by simp
    ultimately have "?b`(succ(0)) = f`(x)" by simp
    with II show "?a`(0) = f`(x)" by simp
    { fix k assume "k\<in>n"
      from I have III: "\<forall>k\<in>succ(n). ?a`(k) = ?b`(succ(k))"
        using tail_props by blast
      with assms(1) \<open>k\<in>n\<close> have "?a`(succ(k)) = ?b`(succ(succ(k)))"
        using succ_ineq by blast
      with assms \<open>k\<in>n\<close> III have "?a`(succ(k)) = f`(?a`(k))"
        using succ_ineq fin_indseq_props(3) by simp
    } then show "\<forall>k\<in>n. ?a`(succ(k)) = f`(?a`(k))"
      by simp
  qed
  with assms(1,2) \<open>f`(x)\<in>X\<close> show ?thesis by (rule is_fin_indseq)
qed

text\<open>The first theorem about properties of infinite inductive sequences:
  inductive sequence is a indeed a sequence (i.e. a function on the set of
  natural numbers.\<close>

theorem indseq_seq: assumes  A1: "f: X\<rightarrow>X" and A2: "x\<in>X"
  shows "InductiveSequence(x,f) : nat \<rightarrow> X"
proof -
  let ?S = "{InductiveSequenceN(x,f,n). n \<in> nat}"
  { fix a assume "a\<in>?S"
    then obtain n where "n \<in> nat" and "a =  InductiveSequenceN(x,f,n)"
      by auto
    with A1 A2 have "a : succ(n)\<rightarrow>X" using fin_indseq_props
      by simp
    then have "\<exists>A B. a:A\<rightarrow>B" by auto
  } then have "\<forall>a \<in> ?S. \<exists>A B. a:A\<rightarrow>B" by auto
  moreover
  { fix a b assume "a\<in>?S"   "b\<in>?S"
    then obtain i j where "i\<in>nat"  "j\<in>nat" and
      "a = InductiveSequenceN(x,f,i)"   "b = InductiveSequenceN(x,f,j)"
      by auto
    with A1 A2 have "a\<subseteq>b \<or> b\<subseteq>a" using indseq_subsets by simp
  } then have "\<forall>a\<in>?S. \<forall>b\<in>?S. a\<subseteq>b \<or> b\<subseteq>a" by auto
  ultimately have "\<Union>?S : domain(\<Union>?S) \<rightarrow> range(\<Union>?S)"
    using fun_Union by simp
  with A1 A2 have I: "\<Union>?S : nat \<rightarrow> range(\<Union>?S)"
    using domain_UN fin_indseq_domain nat_union_succ by simp
  moreover
  { fix k assume A3: "k \<in> nat"
    let ?y = "(\<Union>?S)`(k)"
    note I A3
    moreover have "?y = (\<Union>?S)`(k)" by simp
    ultimately have "\<langle>k,?y\<rangle> \<in> (\<Union>?S)" by (rule func1_1_L5A)
    then obtain n where "n \<in> nat" and II: "\<langle>k,?y\<rangle> \<in> InductiveSequenceN(x,f,n)"
      by auto
    with A1 A2 have "InductiveSequenceN(x,f,n): succ(n) \<rightarrow> X"
      using fin_indseq_props by simp
    with II have "?y \<in> X" using func1_1_L5 by blast
  } then have "\<forall>k \<in> nat.  (\<Union>?S)`(k) \<in> X" by simp
  ultimately have "\<Union>?S : nat \<rightarrow> X" using func1_1_L1A
    by blast
  then show "InductiveSequence(x,f) : nat \<rightarrow> X"
    using InductiveSequence_def by simp
qed

text\<open>Restriction of an inductive sequence to a finite domain
  is the corresponding finite inductive sequence.\<close>

lemma indseq_restr_eq:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X" and A3: "n \<in> nat"
  shows
  "restrict(InductiveSequence(x,f),succ(n)) = InductiveSequenceN(x,f,n)"
proof -
  let ?a = "InductiveSequence(x,f)"
  let ?b = "InductiveSequenceN(x,f,n)"
  let ?S = "{InductiveSequenceN(x,f,n). n \<in> nat}"
  from A1 A2 A3 have
    I: "?a : nat \<rightarrow> X"  and "succ(n) \<subseteq> nat"
    using indseq_seq succnat_subset_nat by auto
  then have "restrict(?a,succ(n)) : succ(n) \<rightarrow> X"
    using restrict_type2 by simp
  moreover from A1 A2 A3 have "?b : succ(n) \<rightarrow> X"
    using fin_indseq_props by simp
  moreover
  { fix k assume A4: "k \<in> succ(n)"
    from A1 A2 A3 I have
      "\<Union>?S : nat \<rightarrow> X"   "?b \<in> ?S"  "?b : succ(n) \<rightarrow> X"
      using InductiveSequence_def fin_indseq_props by auto
    with A4 have "restrict(?a,succ(n))`(k) = ?b`(k)"
      using fun_Union_apply InductiveSequence_def restrict_if
      by simp
  } then have "\<forall>k \<in> succ(n). restrict(?a,succ(n))`(k) = ?b`(k)"
    by simp
  ultimately show ?thesis by (rule func_eq)
qed

text\<open>The first element of the inductive sequence starting at $x$ and generated by $f$
  is indeed $x$.\<close>

theorem indseq_valat0: assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X"
  shows "InductiveSequence(x,f)`(0) = x"
proof -
  let ?a = "InductiveSequence(x,f)"
  let ?b = "InductiveSequenceN(x,f,0)"
  have T: "0\<in>nat"  "0 \<in> succ(0)" by auto
  with A1 A2 have "?b`(0) = x"
    using fin_indseq_props by simp
  moreover from T have "restrict(?a,succ(0))`(0) = ?a`(0)"
    using restrict_if by simp
  moreover from A1 A2 T have
    "restrict(?a,succ(0)) = ?b"
    using indseq_restr_eq by simp
  ultimately show "?a`(0) = x" by simp
qed

text\<open>An infinite inductive sequence satisfies the
  inductive relation that defines it.\<close>

theorem indseq_vals:
  assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X"  and A3: "n \<in> nat"
  shows
  "InductiveSequence(x,f)`(succ(n)) = f`(InductiveSequence(x,f)`(n))"
proof -
  let ?a = "InductiveSequence(x,f)"
  let ?b = "InductiveSequenceN(x,f,succ(n))"
  from A3 have T:
    "succ(n) \<in> succ(succ(n))"
    "succ(succ(n)) \<in> nat"
    "n \<in> succ(succ(n))"
    by auto
  then have "?a`(succ(n)) = restrict(?a,succ(succ(n)))`(succ(n))"
    using restrict_if by simp
  also from A1 A2 T have "\<dots> = f`(restrict(?a,succ(succ(n)))`(n))"
    using indseq_restr_eq fin_indseq_props by simp
  also from T have "\<dots> = f`(?a`(n))" using restrict_if by simp
  finally show "?a`(succ(n)) = f`(?a`(n))" by simp
qed

subsection\<open>Images of inductive sequences\<close>

text\<open>In this section we consider the properties of sets that are
  images of inductive sequences, that is are of the form
  $\{f^{(n)} (x) : n \in N\}$ for some $x$ in the domain of $f$,
  where $f^{(n)}$ denotes the $n$'th
  iteration of the function $f$. For a function $f:X\rightarrow X$ and
  a point $x\in X$ such set is set is sometimes called
  the orbit of $x$ generated by $f$.\<close>

text\<open>The basic properties of orbits.\<close>

theorem ind_seq_image: assumes A1: "f: X\<rightarrow>X" and A2: "x\<in>X"  and
  A3: "A = InductiveSequence(x,f)``(nat)"
  shows "x\<in>A" and "\<forall>y\<in>A. f`(y) \<in> A"
proof -
  let ?a = "InductiveSequence(x,f)"
  from A1 A2 have "?a : nat \<rightarrow> X" using indseq_seq
    by simp
  with A3 have I: "A = {?a`(n). n \<in> nat}" using func_imagedef
    by auto hence "?a`(0) \<in> A" by auto
  with A1 A2 show "x\<in>A" using indseq_valat0 by simp
  { fix y assume "y\<in>A"
    with I obtain n where II: "n \<in> nat" and III: "y = ?a`(n)"
      by auto
    with A1 A2 have "?a`(succ(n)) = f`(y)"
      using indseq_vals by simp
    moreover from I II have "?a`(succ(n)) \<in> A" by auto
    ultimately have "f`(y) \<in> A" by simp
  } then show "\<forall>y\<in>A. f`(y) \<in> A" by simp
qed

subsection\<open>Subsets generated by a binary operation\<close>

text\<open>In algebra we often talk about sets "generated" by an element,
  that is sets of the form (in multiplicative notation) $\{a^n | n\in Z\}$.
  This is a related to a general notion of "power"
  (as in $a^n = a\cdot a \cdot .. \cdot a$ ) or multiplicity $n\cdot a = a+a+..+a$.
  The intuitive meaning of such notions is obvious, but we need to do some
  work to be able to use it in the formalized setting. This sections is devoted
  to sequences that are created by repeatedly applying a binary operation with the
  second argument fixed to some constant.\<close>

text\<open>Basic propertes of sets generated by binary operations.\<close>

theorem binop_gen_set:
  assumes A1: "f: X\<times>Y \<rightarrow> X" and A2: "x\<in>X"  "y\<in>Y" and
  A3: "a = InductiveSequence(x,Fix2ndVar(f,y))"
  shows
  "a : nat \<rightarrow> X"
  "a``(nat) \<in> Pow(X)"
  "x \<in> a``(nat)"
  "\<forall>z \<in> a``(nat). Fix2ndVar(f,y)`(z) \<in> a``(nat)"
proof -
  let ?g = "Fix2ndVar(f,y)"
  from A1 A2 have I: "?g : X\<rightarrow>X"
    using fix_2nd_var_fun by simp
  with A2 A3 show "a : nat \<rightarrow> X"
    using indseq_seq by simp
  then show "a``(nat) \<in> Pow(X)" using func1_1_L6 by simp
  from A2 A3 I show "x \<in> a``(nat)" using ind_seq_image by blast
  from A2 A3 I have
    "?g : X\<rightarrow>X"  "x\<in>X"  "a``(nat) = InductiveSequence(x,?g)``(nat)"
    by auto
  then show "\<forall>z \<in> a``(nat). Fix2ndVar(f,y)`(z) \<in> a``(nat)"
    by (rule ind_seq_image)
qed

text\<open>A simple corollary to the theorem \<open>binop_gen_set\<close>: a set
  that contains all iterations of the application of a binary operation
  exists.\<close>

lemma binop_gen_set_ex: assumes A1: "f: X\<times>Y \<rightarrow> X" and A2: "x\<in>X"  "y\<in>Y"
  shows "{A \<in> Pow(X). x\<in>A \<and> (\<forall>z \<in> A. f`\<langle>z,y\<rangle> \<in> A) } \<noteq> 0"
proof -
  let ?a = "InductiveSequence(x,Fix2ndVar(f,y))"
  let ?A = "?a``(nat)"
  from A1 A2 have I: "?A \<in> Pow(X)" and "x \<in> ?A" using binop_gen_set
    by auto
  moreover
  { fix z assume T: "z\<in>?A"
    with A1 A2 have "Fix2ndVar(f,y)`(z) \<in> ?A"
      using binop_gen_set by simp
    moreover
    from I T have "z \<in> X" by auto
    with A1 A2 have "Fix2ndVar(f,y)`(z) = f`\<langle>z,y\<rangle>"
      using fix_var_val by simp
    ultimately have "f`\<langle>z,y\<rangle> \<in> ?A" by simp
  } then have "\<forall>z \<in> ?A. f`\<langle>z,y\<rangle> \<in> ?A" by simp
  ultimately show ?thesis by auto
qed

text\<open>A more general version of \<open> binop_gen_set\<close> where the generating
  binary operation acts on a larger set.\<close>

theorem binop_gen_set1: assumes A1: "f: X\<times>Y \<rightarrow> X" and
  A2: "X\<^sub>1 \<subseteq> X" and A3: "x\<in>X\<^sub>1"  "y\<in>Y" and
  A4: "\<forall>t\<in>X\<^sub>1. f`\<langle>t,y\<rangle> \<in> X\<^sub>1" and
  A5: "a = InductiveSequence(x,Fix2ndVar(restrict(f,X\<^sub>1\<times>Y),y))"
shows
  "a : nat \<rightarrow> X\<^sub>1"
  "a``(nat) \<in> Pow(X\<^sub>1)"
  "x \<in> a``(nat)"
  "\<forall>z \<in> a``(nat). Fix2ndVar(f,y)`(z) \<in> a``(nat)"
  "\<forall>z \<in> a``(nat). f`\<langle>z,y\<rangle> \<in> a``(nat)"
proof -
  let ?h = "restrict(f,X\<^sub>1\<times>Y)"
  let ?g = "Fix2ndVar(?h,y)"
  from A2 have "X\<^sub>1\<times>Y \<subseteq> X\<times>Y" by auto
  with A1 have I: "?h : X\<^sub>1\<times>Y \<rightarrow> X"
    using restrict_type2 by simp
  with A3 have II: "?g: X\<^sub>1 \<rightarrow> X" using fix_2nd_var_fun by simp
  from A3 A4 I have "\<forall>t\<in>X\<^sub>1. ?g`(t) \<in> X\<^sub>1"
    using restrict fix_var_val by simp
  with II have III: "?g : X\<^sub>1 \<rightarrow> X\<^sub>1" using func1_1_L1A by blast
  with A3 A5 show "a : nat \<rightarrow> X\<^sub>1" using indseq_seq by simp
  then show IV: "a``(nat) \<in> Pow(X\<^sub>1)" using func1_1_L6 by simp
  from A3 A5 III show "x \<in> a``(nat)" using ind_seq_image by blast
  from A3 A5 III have
    "?g : X\<^sub>1 \<rightarrow> X\<^sub>1"   "x\<in>X\<^sub>1"  "a``(nat) =  InductiveSequence(x,?g)``(nat)"
    by auto
  then have "\<forall>z \<in> a``(nat). Fix2ndVar(?h,y)`(z) \<in> a``(nat)"
    by (rule ind_seq_image)
  moreover
  { fix z assume "z \<in> a``(nat)"
    with IV have "z \<in> X\<^sub>1" by auto
    with A1 A2 A3 have "?g`(z) = Fix2ndVar(f,y)`(z)"
      using fix_2nd_var_restr_comm restrict by simp
  } then have "\<forall>z \<in> a``(nat). ?g`(z) = Fix2ndVar(f,y)`(z)" by simp
  ultimately show "\<forall>z \<in> a``(nat). Fix2ndVar(f,y)`(z) \<in> a``(nat)" by simp
  moreover
  { fix z assume "z \<in> a``(nat)"
    with A2 IV have "z\<in>X" by auto
    with A1 A3 have "Fix2ndVar(f,y)`(z) = f`\<langle>z,y\<rangle>"
      using fix_var_val by simp
  } then have "\<forall>z \<in> a``(nat). Fix2ndVar(f,y)`(z) = f`\<langle>z,y\<rangle>"
    by simp
  ultimately show "\<forall>z \<in> a``(nat). f`\<langle>z,y\<rangle> \<in> a``(nat)"
    by simp
qed

text\<open>A generalization of \<open> binop_gen_set_ex\<close> that applies when the binary
  operation acts on a larger set. This is used in our Metamath translation
  to prove the existence of the set of real natural numbers.
  Metamath defines the real natural numbers as the smallest set that cantains
  $1$ and is closed with respect to operation of adding $1$.\<close>

lemma binop_gen_set_ex1: assumes A1: "f: X\<times>Y \<rightarrow> X" and
  A2: "X\<^sub>1 \<subseteq> X" and A3: "x\<in>X\<^sub>1"  "y\<in>Y" and
  A4: "\<forall>t\<in>X\<^sub>1. f`\<langle>t,y\<rangle> \<in> X\<^sub>1"
  shows "{A \<in> Pow(X\<^sub>1). x\<in>A \<and> (\<forall>z \<in> A. f`\<langle>z,y\<rangle> \<in> A) } \<noteq> 0"
proof -
  let ?a = "InductiveSequence(x,Fix2ndVar(restrict(f,X\<^sub>1\<times>Y),y))"
  let ?A = "?a``(nat)"
  from A1 A2 A3 A4 have
    "?A \<in> Pow(X\<^sub>1)"   "x \<in> ?A"   "\<forall>z \<in> ?A. f`\<langle>z,y\<rangle> \<in> ?A"
    using binop_gen_set1 by auto
  thus ?thesis by auto
qed

subsection\<open>Inductive sequences with changing generating function\<close>

text\<open>A seemingly more general form of a sequence defined by induction
  is a sequence generated by the difference equation $x_{n+1} = f_{n} (x_n)$
  where $n\mapsto f_n$ is a given sequence of functions such
  that each maps $X$ into inself.
  For example when
  $f_n (x) := x + x_n$ then the equation $S_{n+1} = f_{n} (S_n)$ describes
  the sequence $n \mapsto S_n = s_0 +\sum_{i=0}^n x_n$, i.e. the sequence of
  partial sums of the sequence $\{s_0, x_0, x_1, x_3,..\}$.
\<close>

text\<open>The situation where the function that we iterate changes with $n$ can be
  derived from the simpler case if we define the generating function appropriately.
  Namely, we replace the generating function in the definitions of
  \<open>InductiveSequenceN\<close> by the function $f: X\times n \rightarrow X\times n$,
  $f\langle x,k\rangle = \langle f_k(x), k+1 \rangle$ if $k < n$,
  $\langle f_k(x), k \rangle$ otherwise. The first notion defines the expression
  we will use to define the generating function.
  To understand the notation recall that in standard Isabelle/ZF
  for a pair $s=\langle x,n \rangle$ we have \<open>fst\<close>$(s)=x$ and
  \<open>snd\<close>$(s)=n$.\<close>

definition
  "StateTransfFunNMeta(F,n,s) \<equiv>
  if (snd(s) \<in> n) then \<langle>F`(snd(s))`(fst(s)), succ(snd(s))\<rangle> else s"

text\<open>Then we define the actual generating function on sets of pairs
  from $X\times \{0,1, .. ,n\}$.\<close>

definition
  "StateTransfFunN(X,F,n) \<equiv> {\<langle>s, StateTransfFunNMeta(F,n,s)\<rangle>. s \<in> X\<times>succ(n)}"

text\<open>Having the generating function we can define the expression
  that we cen use to define the inductive sequence generates.\<close>

definition
  "StatesSeq(x,X,F,n) \<equiv>
  InductiveSequenceN(\<langle>x,0\<rangle>, StateTransfFunN(X,F,n),n)"

text\<open>Finally we can define the sequence given by a initial point $x$,
  and a sequence $F$ of $n$ functions.\<close>

definition
  "InductiveSeqVarFN(x,X,F,n) \<equiv> {\<langle>k,fst(StatesSeq(x,X,F,n)`(k))\<rangle>. k \<in> succ(n)}"

text\<open>The state transformation function (\<open>StateTransfFunN\<close> is
  a function that transforms $X\times n$ into itself.\<close>

lemma state_trans_fun: assumes A1: "n \<in> nat" and A2: "F: n \<rightarrow> (X\<rightarrow>X)"
  shows "StateTransfFunN(X,F,n): X\<times>succ(n) \<rightarrow> X\<times>succ(n)"
proof -
  { fix s assume A3: "s \<in> X\<times>succ(n)"
    let ?x = "fst(s)"
    let ?k = "snd(s)"
    let ?S = "StateTransfFunNMeta(F,n,s)"
    from A3 have T: "?x \<in> X"  "?k \<in> succ(n)" and "\<langle>?x,?k\<rangle> = s" by auto
    { assume A4: "?k \<in> n"
      with A1 have "succ(?k) \<in> succ(n)" using succ_ineq by simp
      with A2 T A4 have "?S \<in> X\<times>succ(n)"
	using apply_funtype StateTransfFunNMeta_def by simp }
    with A2 A3 T have "?S \<in> X\<times>succ(n)"
      using apply_funtype StateTransfFunNMeta_def by auto
  } then have "\<forall>s \<in> X\<times>succ(n). StateTransfFunNMeta(F,n,s) \<in> X\<times>succ(n)"
    by simp
  then have
    "{\<langle>s, StateTransfFunNMeta(F,n,s)\<rangle>. s \<in> X\<times>succ(n)} : X\<times>succ(n) \<rightarrow> X\<times>succ(n)"
    by (rule ZF_fun_from_total)
  then show "StateTransfFunN(X,F,n): X\<times>succ(n) \<rightarrow> X\<times>succ(n)"
    using StateTransfFunN_def by simp
qed

text\<open>We can apply \<open>fin_indseq_props\<close> to the sequence used in the
  definition of \<open>InductiveSeqVarFN\<close> to get the properties of the sequence
  of states generated by the \<open>StateTransfFunN\<close>.\<close>

lemma states_seq_props:
  assumes A1: "n \<in> nat" and A2: "F: n \<rightarrow> (X\<rightarrow>X)" and A3: "x\<in>X" and
  A4: "b = StatesSeq(x,X,F,n)"
  shows
  "b : succ(n) \<rightarrow> X\<times>succ(n)"
  "b`(0) = \<langle>x,0\<rangle>"
  "\<forall>k \<in> succ(n). snd(b`(k)) = k"
  "\<forall>k\<in>n. b`(succ(k)) = \<langle>F`(k)`(fst(b`(k))), succ(k)\<rangle>"
proof -
  let ?f = "StateTransfFunN(X,F,n)"
  from A1 A2 have I: "?f : X\<times>succ(n) \<rightarrow> X\<times>succ(n)"
    using state_trans_fun by simp
  moreover from A1 A3 have II: "\<langle>x,0\<rangle> \<in> X\<times>succ(n)"
    using empty_in_every_succ by simp
  moreover note A1
  moreover from A4 have III: "b = InductiveSequenceN(\<langle>x,0\<rangle>,?f,n)"
    using StatesSeq_def by simp
  ultimately show IV: "b : succ(n) \<rightarrow> X\<times>succ(n)"
    by (rule fin_indseq_props)
  from I II A1 III show V: "b`(0) = \<langle>x,0\<rangle>"
    by (rule fin_indseq_props)
  from I II A1 III have VI: "\<forall>k\<in>n. b`(succ(k)) = ?f`(b`(k))"
    by (rule fin_indseq_props)
  { fix k
    note I
    moreover
    assume A5: "k \<in> n" hence "k \<in> succ(n)" by auto
    with IV have "b`(k) \<in>  X\<times>succ(n)" using apply_funtype by simp
    moreover have "?f = {\<langle>s, StateTransfFunNMeta(F,n,s)\<rangle>. s \<in> X\<times>succ(n)}"
      using StateTransfFunN_def by simp
    ultimately have "?f`(b`(k)) =  StateTransfFunNMeta(F,n,b`(k))"
      by (rule ZF_fun_from_tot_val)
  } then have VII: "\<forall>k \<in> n. ?f`(b`(k)) =  StateTransfFunNMeta(F,n,b`(k))"
    by simp
  { fix k assume A5: "k \<in> succ(n)"
    note A1 A5
    moreover from V have " snd(b`(0)) = 0" by simp
    moreover from VI VII have
      "\<forall>j\<in>n. snd(b`(j)) = j \<longrightarrow> snd(b`(succ(j))) = succ(j)"
      using StateTransfFunNMeta_def by auto
    ultimately have "snd(b`(k)) = k" by (rule fin_nat_ind)
  } then show "\<forall>k \<in> succ(n). snd(b`(k)) = k" by simp
  with VI VII show "\<forall>k\<in>n. b`(succ(k)) = \<langle>F`(k)`(fst(b`(k))), succ(k)\<rangle>"
    using StateTransfFunNMeta_def by auto
qed

text\<open>Basic properties of sequences defined by equation $x_{n+1}=f_n (x_n)$.\<close>

theorem fin_indseq_var_f_props:
  assumes A1: "n \<in> nat" and A2: "x\<in>X" and A3: "F: n \<rightarrow> (X\<rightarrow>X)" and
  A4: "a = InductiveSeqVarFN(x,X,F,n)"
  shows
  "a: succ(n) \<rightarrow> X"
  "a`(0) = x"
  "\<forall>k\<in>n. a`(succ(k)) = F`(k)`(a`(k))"
proof -
  let ?f = "StateTransfFunN(X,F,n)"
  let ?b = "StatesSeq(x,X,F,n)"
  from A1 A2 A3 have "?b : succ(n) \<rightarrow> X\<times>succ(n)"
    using states_seq_props by simp
  then have "\<forall>k \<in> succ(n). ?b`(k) \<in> X\<times>succ(n)"
    using apply_funtype by simp
  hence "\<forall>k \<in> succ(n). fst(?b`(k)) \<in> X" by auto
  then have I: "{\<langle>k,fst(?b`(k))\<rangle>. k \<in> succ(n)} : succ(n) \<rightarrow> X"
    by (rule ZF_fun_from_total)
  with A4 show II: "a: succ(n) \<rightarrow> X" using InductiveSeqVarFN_def
    by simp
  moreover from A1 have "0 \<in> succ(n)" using empty_in_every_succ
    by simp
  moreover from A4 have III:
    "a = {\<langle>k,fst(StatesSeq(x,X,F,n)`(k))\<rangle>. k \<in> succ(n)}"
    using InductiveSeqVarFN_def by simp
  ultimately have "a`(0) = fst(?b`(0))"
    by (rule ZF_fun_from_tot_val)
  with A1 A2 A3 show "a`(0) = x" using states_seq_props by auto
  { fix k
    assume A5: "k \<in> n"
    with A1 have T1: "succ(k) \<in> succ(n)" and T2: "k \<in> succ(n)"
      using succ_ineq by auto
    from II T1 III have "a`(succ(k)) = fst(?b`(succ(k)))"
      by (rule ZF_fun_from_tot_val)
    with A1 A2 A3 A5 have "a`(succ(k)) = F`(k)`(fst(?b`(k)))"
      using states_seq_props by simp
    moreover from II T2 III have "a`(k) = fst(?b`(k))"
      by (rule ZF_fun_from_tot_val)
    ultimately have "a`(succ(k)) =  F`(k)`(a`(k))"
      by simp
  } then show "\<forall>k\<in>n. a`(succ(k)) = F`(k)`(a`(k))"
    by simp
qed

text\<open>Uniqueness lemma for sequences generated by equation $x_{n+1}=f_n (x_n)$:\<close>

lemma fin_indseq_var_f_uniq: assumes "n\<in>nat" "x\<in>X" "F: n \<rightarrow> (X\<rightarrow>X)"
  and "a: succ(n) \<rightarrow> X" "a`(0) = x" "\<forall>k\<in>n. a`(succ(k)) = (F`(k))`(a`(k))"
  and "b: succ(n) \<rightarrow> X" "b`(0) = x" "\<forall>k\<in>n. b`(succ(k)) = (F`(k))`(b`(k))"
  shows "a=b"
proof -
  have "\<forall>k\<in>succ(n). a`(k) = b`(k)"
  proof -
    let ?A = "{i\<in>succ(succ(n)). \<forall>k\<in>i.  a`(k) = b`(k)}"
    let ?m = "Maximum(Le,?A)"
    from assms(1) have I: "succ(succ(n)) \<in> nat" "?A\<subseteq>succ(succ(n))" by auto
    moreover
    from assms(1,5,8) have "succ(0) \<in> ?A" using empty_in_every_succ succ_ineq
      by simp
    hence II: "?A\<noteq>0" by auto
    ultimately have "?m\<in>?A" by (rule nat_max_props)
    moreover have "?m = succ(n)"
    proof -
      { assume "?m \<noteq> succ(n)"
        from I II have III: "\<forall>k\<in>?A. k \<le> ?m" by (rule nat_max_props)
        have "succ(?m) \<in> ?A"
        proof -
          from \<open>?m \<noteq> succ(n)\<close> \<open>?m\<in>?A\<close> have "?m\<in>succ(n)"
            using mem_succ_not_eq by blast
          from I II have "?m \<in> nat" by (rule nat_max_props)
          from \<open>succ(0) \<in> ?A\<close> III have "succ(0) \<le> ?m" by blast
          hence "?m \<noteq> 0" by auto
          with \<open>?m \<in> nat\<close> obtain k where "k\<in>nat" "?m = succ(k)"
            using Nat_ZF_1_L3 by auto
          with assms(1) \<open>?m\<in>succ(n)\<close> have "k\<in>n" using succ_mem by simp
          with assms(6,9) \<open>?m = succ(k)\<close> \<open>?m\<in>?A\<close>
          have "a`(?m) = b`(?m)" using succ_explained by simp
          with assms(1) \<open>?m\<in>?A\<close> \<open>?m\<in>succ(n)\<close> show "succ(?m) \<in> ?A"
            using succ_explained succ_ineq by blast
        qed
        with III have "succ(?m) \<le> ?m" by (rule property_holds)
        hence False by auto
      } thus ?thesis by auto
    qed
    ultimately show ?thesis by simp
  qed
  with assms(4,7) show "a=b" by (rule func_eq)
qed

text\<open>A sequence that has the properties of sequences generated by equation $x_{n+1}=f_n (x_n)$
  must be the one generated by this equation.\<close>

theorem is_fin_indseq_var_f:  assumes "n\<in>nat" "x\<in>X" "F: n \<rightarrow> (X\<rightarrow>X)"
  and "a: succ(n) \<rightarrow> X" "a`(0) = x" "\<forall>k\<in>n. a`(succ(k)) = (F`(k))`(a`(k))"
shows "a = InductiveSeqVarFN(x,X,F,n)"
proof -
  let ?b = "InductiveSeqVarFN(x,X,F,n)"
  from assms(1,2,3) have "?b: succ(n) \<rightarrow> X"  "?b`(0) = x"
    and "\<forall>k\<in>n. ?b`(succ(k)) = F`(k)`(?b`(k))"
    using fin_indseq_var_f_props by simp_all
  with assms show ?thesis by (rule fin_indseq_var_f_uniq)
qed

text\<open>A consistency condition: if we make the sequence of
  generating functions shorter, then we get a shorter inductive
  sequence with the same values as in the original sequence.\<close>

lemma fin_indseq_var_f_restrict: assumes
  A1: "n \<in> nat"  "i \<in> nat"  "x\<in>X"  "F: n \<rightarrow> (X\<rightarrow>X)"   "G: i \<rightarrow> (X\<rightarrow>X)"
  and A2: "i \<subseteq> n" and  A3: "\<forall>j\<in>i. G`(j) = F`(j)" and A4: "k \<in> succ(i)"
  shows "InductiveSeqVarFN(x,X,G,i)`(k) = InductiveSeqVarFN(x,X,F,n)`(k)"
proof -
  let ?a = "InductiveSeqVarFN(x,X,F,n)"
  let ?b = "InductiveSeqVarFN(x,X,G,i)"
  from A1 A4 have "i \<in> nat"  "k \<in> succ(i)" by auto
  moreover from A1 have "?b`(0) = ?a`(0)"
    using fin_indseq_var_f_props by simp
  moreover from A1 A2 A3 have
    "\<forall>j\<in>i. ?b`(j) = ?a`(j) \<longrightarrow> ?b`(succ(j)) = ?a`(succ(j))"
    using fin_indseq_var_f_props by auto
  ultimately show "?b`(k) = ?a`(k)"
    by (rule fin_nat_ind)
qed

subsection\<open>The Pascal's triangle\<close>

text\<open>One possible application of the inductive sequences is to define the Pascal's triangle.
  The Pascal's triangle can be defined directly as $P_{n,k} = {n\choose k}= \frac{n!}{k!(n-k)!}$
  for $n\geq k \geq 0$. Formalizing this definition (or explaining to a 10-years old)
  is quite difficult as it depends on the definition of factorial and
  some facts about factorizing natural numbers needed to show
  that the quotient in $\frac{n!}{k!(n-k)!}$ is always a natural number. Another approach uses
  induction and the property that each number in the array is the sum of the two numbers directly
  above it.\<close>

text\<open>To shorten the definition of the function generating the Pascal's trangle we first
  define expression for the k'th element in the row following given row $r$.
  The rows are represented as lists, i.e. functions $r:n\rightarrow \mathbb{N}$ (recall that
  for natural numbers we have $n=\{ 0,1,2,...,n-1\})$.
  The value of the next row is 1 at the beginning and equals $r(k-1)+r(k)$
  otherwise. A careful reader might wonder why we do not require the values to be 1
  on the right boundary of the Pascal's triangle. We are able to show this as a theorem
  (see \<open>binom_right_boundary\<close> below) using the fact that in Isabelle/ZF the value of a function
  on an argument that is outside of the domain is the empty set, which is the same as zero of
  natural numbers. \<close>

definition
  "BinomElem(r,k) \<equiv> if k=0 then 1 else r`(pred(k)) #+ r`(k)"

text\<open>Next we define a function that takes a row in a Pascal's triangle and returns the next row. \<close>

definition
  "GenBinom \<equiv> {\<langle>r,{\<langle>k,BinomElem(r,k)\<rangle>. k\<in>succ(domain(r))}\<rangle>. r\<in>NELists(nat)}"

text\<open>The function generating rows of the Pascal's triangle is indeed a function that maps
  nonempty lists of natural numbers into nonempty lists of natural numbers. \<close>

lemma gen_binom_fun: shows "GenBinom: NELists(nat) \<rightarrow> NELists(nat)"
proof -
  { fix r assume "r \<in> NELists(nat)"
    then obtain n where "n\<in>nat" and "r:succ(n)\<rightarrow>nat"
      unfolding NELists_def by auto
    then have "domain(r) = succ(n)" using func1_1_L1 by simp
    let ?r\<^sub>1 = "{\<langle>k,BinomElem(r,k)\<rangle>. k\<in>succ(domain(r))}"
    have "\<forall>k\<in>succ(domain(r)). BinomElem(r,k) \<in> nat"
      unfolding BinomElem_def by simp
    then have "?r\<^sub>1: succ(domain(r))\<rightarrow>nat"
      by (rule ZF_fun_from_total)
    with \<open>n\<in>nat\<close> \<open>domain(r) = succ(n)\<close> have "?r\<^sub>1\<in>NELists(nat)"
      unfolding NELists_def by auto
  } then show ?thesis using ZF_fun_from_total unfolding GenBinom_def
    by simp
qed

text\<open>The value of the function \<open>GenBinom\<close> at a nonempty list $r$ is a list of length
  one greater than the length of $r$.\<close>

lemma gen_binom_fun_val: assumes "n\<in>nat" "r:succ(n)\<rightarrow>nat"
  shows "GenBinom`(r):succ(succ(n)) \<rightarrow> nat"
proof -
  let ?B = "{\<langle>r,{\<langle>k,BinomElem(r,k)\<rangle>. k\<in>succ(domain(r))}\<rangle>. r\<in>NELists(nat)}"
  let ?r\<^sub>1 = "{\<langle>k,BinomElem(r,k)\<rangle>. k\<in>succ(domain(r))}"
  from assms have "r\<in>NELists(nat)" unfolding NELists_def by blast
  then have "?B`(r) = ?r\<^sub>1" using ZF_fun_from_tot_val1 by simp
  have "\<forall>k\<in>succ(domain(r)). BinomElem(r,k) \<in> nat"
    unfolding BinomElem_def by simp
  then have "?r\<^sub>1: succ(domain(r))\<rightarrow>nat"
    by (rule ZF_fun_from_total)
  with assms(2) \<open>?B`(r) = ?r\<^sub>1\<close> show ?thesis
    using func1_1_L1 unfolding GenBinom_def by simp
qed

text\<open>Now we are ready to define the Pascal's triangle as the inductive sequence that
  starts from a singleton list $0\mapsto 1$ and is generated by iterations of the
  \<open>GenBinom\<close> function. \<close>

definition
  "PascalTriangle \<equiv> InductiveSequence({\<langle>0,1\<rangle>},GenBinom)"

text\<open>The singleton list containing 1 (i.e. the starting point of the inductive sequence
  that defines the \<open>PascalTriangle\<close>) is a finite list and
  the \<open>PascalTriangle\<close> is a sequence (an infinite list) of nonempty lists of natural numbers.\<close>

lemma pascal_sequence:
  shows "{\<langle>0,1\<rangle>} \<in> NELists(nat)" and "PascalTriangle: nat \<rightarrow> NELists(nat)"
  using list_len1_singleton(2) gen_binom_fun indseq_seq
  unfolding PascalTriangle_def
  by auto

text\<open>The \<open>GenBinom\<close> function creates the next row of the Pascal's triangle
  from the previous one. \<close>

lemma binom_gen: assumes "n\<in>nat"
  shows "PascalTriangle`(succ(n)) = GenBinom`(PascalTriangle`(n))"
  using assms pascal_sequence gen_binom_fun indseq_vals
  unfolding PascalTriangle_def by simp

text\<open>The $n$'th row of the Pascal's triangle is a list of $n+1$ natural numbers. \<close>

lemma pascal_row_list:
  assumes "n\<in>nat" shows "PascalTriangle`(n):succ(n)\<rightarrow>nat"
proof -
  from assms(1) have "n\<in>nat" and "PascalTriangle`(0):succ(0)\<rightarrow>nat"
    using gen_binom_fun pascal_sequence(1) indseq_valat0 list_len1_singleton(1)
    unfolding PascalTriangle_def by auto
  moreover have
    "\<forall>k\<in>nat. PascalTriangle`(k):succ(k)\<rightarrow>nat \<longrightarrow>
      PascalTriangle`(succ(k)):succ(succ(k))\<rightarrow>nat"
  proof -
    { fix k assume "k\<in>nat" and "PascalTriangle`(k):succ(k)\<rightarrow>nat"
      then have "PascalTriangle`(succ(k)):succ(succ(k))\<rightarrow>nat"
        using gen_binom_fun_val gen_binom_fun pascal_sequence(1) indseq_vals
        unfolding NELists_def PascalTriangle_def
        by auto
    } thus ?thesis by simp
  qed
  ultimately show ?thesis by (rule ind_on_nat)
qed

text\<open>In our approach the Pascal's triangle is a list of lists. The value
  at index $n\in \mathbb{N}$ is a list of length $n+1$ (see \<open>pascal_row_list\<close> above).
  Hence, the largest index in the domain of this list is $n$. However,
  we can still show that the value of that list at index $n+1$ is 0, because in Isabelle/ZF
  (as well as in Metamath) the value of a function at a point outside of the domain is the empty
  set, which happens to be the same as the natural number 0. \<close>

lemma pascal_val_beyond: assumes "n\<in>nat"
  shows "(PascalTriangle`(n))`(succ(n)) = 0"
proof -
  from assms have "domain(PascalTriangle`(n)) = succ(n)"
    using pascal_row_list func1_1_L1 by blast
  then show ?thesis using mem_self apply_0
    by simp
qed

text\<open>For $n>0$ the Pascal's triangle values at $(n,k)$ are given by the \<open>BinomElem\<close> expression. \<close>

lemma pascal_row_val: assumes "n\<in>nat" "k\<in>succ(succ(n))"
  shows "(PascalTriangle`(succ(n)))`(k) = BinomElem(PascalTriangle`(n),k)"
proof -
  let ?B = "{\<langle>r,{\<langle>k,BinomElem(r,k)\<rangle>. k\<in>succ(domain(r))}\<rangle>. r\<in>NELists(nat)}"
  let ?r = "PascalTriangle`(n)"
  let ?B\<^sub>r = "{\<langle>k,BinomElem(?r,k)\<rangle>. k\<in>succ(succ(n))}"
  from assms(1) have "?r \<in> NELists(nat)" and "?r : succ(n)\<rightarrow>nat"
    using pascal_sequence(2) apply_funtype pascal_row_list
    by auto
  then have "?B`(?r) = ?B\<^sub>r" using func1_1_L1 ZF_fun_from_tot_val1
    by simp
  moreover from assms(1) have "?B`(?r) = PascalTriangle`(succ(n))"
    using binom_gen unfolding GenBinom_def by simp
  moreover from assms(2) have "?B\<^sub>r`(k) = BinomElem(?r,k)"
    by (rule ZF_fun_from_tot_val1)
  ultimately show ?thesis by simp
qed

text\<open>The notion that will actually be used is the binomial coefficient ${n\choose k}$
  which we define as the value at the right place of the Pascal's triangle. \<close>

definition
  "Binom(n,k) \<equiv> (PascalTriangle`(n))`(k)"

text\<open>The top of the Pascal's triangle is equal to 1 (i.e. ${0\choose 0}=1$).
  This is an easy fact that it is useful to have handy as it  is at the start of a
  couple of inductive arguments. \<close>

lemma binom_zero_zero: shows "Binom(0,0) = 1"
  using gen_binom_fun pascal_sequence(1) indseq_valat0 pair_val
    unfolding Binom_def PascalTriangle_def by auto

text\<open>The binomial coefficient are 1 on the left boundary of the Pascal's triangle.\<close>

theorem binom_left_boundary: assumes "n\<in>nat" shows "Binom(n,0) = 1"
proof -
  { assume "n\<noteq>0"
    with assms obtain k where "k\<in>nat" and "n = succ(k)"
      using Nat_ZF_1_L3 by blast
    then have "Binom(n,0) = 1" using empty_in_every_succ pascal_row_val
      unfolding BinomElem_def Binom_def by simp
  }
  then show ?thesis using binom_zero_zero by blast
qed

text\<open>The main recursive property of binomial coefficients:
  each number in the ${n\choose k}$, $n>0, 0\neq k\leq n$ array
  (i.e. the Pascal's triangle except the top)
  is the sum of the two numbers directly  above it. The statement looks like it has an
  off-by-one error in the assumptions, but it's ok and needed later. \<close>

theorem binom_prop: assumes "n\<in>nat" "k \<le> n #+ 1" "k\<noteq>0"
  shows "Binom(n #+ 1,k) = Binom(n,k #- 1) #+ Binom(n,k)"
proof -
  let ?P = "PascalTriangle"
  from assms(1,2) have "k\<in>nat" and "k \<in> succ(succ(n))"
    using le_in_nat nat_mem_lt(2) by auto
  with assms(1) have "Binom(n #+ 1,k) = BinomElem(?P`(n),k)"
    unfolding Binom_def using pascal_row_val by simp
  also from assms(3) \<open>k\<in>nat\<close> have
    "BinomElem(?P`(n),k) = (?P`(n))`(k #- 1) #+ (?P`(n))`(k)"
    unfolding BinomElem_def using pred_minus_one by simp
  also have "(?P`(n))`(k #- 1) #+ (?P`(n))`(k) =  Binom(n,k #- 1) #+ Binom(n,k)"
    unfolding Binom_def by simp
  finally show ?thesis by simp
qed

text\<open>A special case of \<open>binom_prop\<close> when $n=k+1$ that helps
  with the induction step in the proof that the binomial coefficient
  are 1 on the right boundary of the Pascal's triangle.\<close>

lemma binom_prop1: assumes "n\<in>nat"
  shows "Binom(n #+ 1,n #+ 1) = Binom(n,n)"
proof -
  let ?B = "Binom"
  from assms have "?B(n,n) \<in> nat"
    using pascal_row_list apply_funtype
    unfolding Binom_def by blast
  from assms have "(PascalTriangle`(n))`(succ(n)) = 0"
    using pascal_val_beyond by simp
  moreover from assms have "succ(n) = n #+ 1"
    using succ_add_one(1) by simp
  ultimately have "?B(n,n #+ 1) = 0"
    unfolding Binom_def by simp
  with assms \<open>?B(n,n) \<in> nat\<close> show ?thesis
    using succ_add_one(2) binom_prop add_subctract add_0 add_commute
    by simp
qed

text\<open>The binomial coefficients are 1 on the right boundary of the Pascal's triangle.\<close>

theorem binom_right_boundary: assumes "n\<in>nat" shows "Binom(n,n) = 1"
proof -
  from assms have "n\<in>nat" and "Binom(0,0) = 1"
    using binom_zero_zero by auto
  moreover have
    "\<forall>k\<in>nat. Binom(k,k) = 1 \<longrightarrow> Binom(succ(k),succ(k)) = 1"
    using binom_prop1 by simp
  ultimately show ?thesis by (rule ind_on_nat)
qed

end


(*  Title:      HOL/Predicate_Compile.thy
    Author:     Stefan Berghofer, Lukas Bulwahn, Florian Haftmann, TU Muenchen
*)

section {* A compiler for predicates defined by introduction rules *}

theory Predicate_Compile
imports Random_Sequence Quickcheck_Exhaustive
keywords "code_pred" :: thy_goal and "values" :: diag
begin

ML_file "Tools/Predicate_Compile/predicate_compile_aux.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_compilations.ML"
ML_file "Tools/Predicate_Compile/core_data.ML"
ML_file "Tools/Predicate_Compile/mode_inference.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_proof.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_core.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_data.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_fun.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_pred.ML"
ML_file "Tools/Predicate_Compile/predicate_compile_specialisation.ML"
ML_file "Tools/Predicate_Compile/predicate_compile.ML"

subsection {* Set membership as a generator predicate *}

text {*
  Introduce a new constant for membership to allow
  fine-grained control in code equations.
*}

definition contains :: "'a set => 'a => bool"
where "contains A x \<longleftrightarrow> x : A"

definition contains_pred :: "'a set => 'a => unit Predicate.pred"
where "contains_pred A x = (if x : A then Predicate.single () else bot)"

lemma pred_of_setE:
  assumes "Predicate.eval (pred_of_set A) x"
  obtains "contains A x"
using assms by(simp add: contains_def)

lemma pred_of_setI: "contains A x ==> Predicate.eval (pred_of_set A) x"
by(simp add: contains_def)

lemma pred_of_set_eq: "pred_of_set \<equiv> \<lambda>A. Predicate.Pred (contains A)"
by(simp add: contains_def[abs_def] pred_of_set_def o_def)

lemma containsI: "x \<in> A ==> contains A x"
by(simp add: contains_def)

lemma containsE: assumes "contains A x"
  obtains A' x' where "A = A'" "x = x'" "x : A"
using assms by(simp add: contains_def)

lemma contains_predI: "contains A x ==> Predicate.eval (contains_pred A x) ()"
by(simp add: contains_pred_def contains_def)

lemma contains_predE:
  assumes "Predicate.eval (contains_pred A x) y"
  obtains "contains A x"
using assms by(simp add: contains_pred_def contains_def split: split_if_asm)

lemma contains_pred_eq: "contains_pred \<equiv> \<lambda>A x. Predicate.Pred (\<lambda>y. contains A x)"
by(rule eq_reflection)(auto simp add: contains_pred_def fun_eq_iff contains_def intro: pred_eqI)

lemma contains_pred_notI:
   "\<not> contains A x ==> Predicate.eval (Predicate.not_pred (contains_pred A x)) ()"
by(simp add: contains_pred_def contains_def not_pred_eq)

setup {*
let
  val Fun = Predicate_Compile_Aux.Fun
  val Input = Predicate_Compile_Aux.Input
  val Output = Predicate_Compile_Aux.Output
  val Bool = Predicate_Compile_Aux.Bool
  val io = Fun (Input, Fun (Output, Bool))
  val ii = Fun (Input, Fun (Input, Bool))
in
  Core_Data.PredData.map (Graph.new_node
    (@{const_name contains},
     Core_Data.PredData {
       pos = Position.thread_data (),
       intros = [(NONE, @{thm containsI})],
       elim = SOME @{thm containsE},
       preprocessed = true,
       function_names = [(Predicate_Compile_Aux.Pred,
         [(io, @{const_name pred_of_set}), (ii, @{const_name contains_pred})])],
       predfun_data = [
         (io, Core_Data.PredfunData {
            elim = @{thm pred_of_setE}, intro = @{thm pred_of_setI},
            neg_intro = NONE, definition = @{thm pred_of_set_eq}
          }),
         (ii, Core_Data.PredfunData {
            elim = @{thm contains_predE}, intro = @{thm contains_predI},
            neg_intro = SOME @{thm contains_pred_notI}, definition = @{thm contains_pred_eq}
          })],
       needs_random = []}))
end
*}

hide_const (open) contains contains_pred
hide_fact (open) pred_of_setE pred_of_setI pred_of_set_eq
  containsI containsE contains_predI contains_predE contains_pred_eq contains_pred_notI

end


theory UteProof
imports UteDefs "../Majorities" "../Reduction"
begin

context ute_parameters
begin

subsection {* Preliminary Lemmas *}

text {* Processes can make a vote only at first round of each phase. *}

lemma vote_step:
  assumes  nxt: "nextState Ute_M r p (rho r p) \<mu> (rho (Suc r) p)"
  and "vote (rho (Suc r) p) \<noteq> None"
  shows "step r = 0"
proof (rule ccontr)
  assume "step r \<noteq> 0"
  with assms have "vote (rho (Suc r) p) = None"
    by (auto simp:Ute_SHOMachine_def nextState_def Ute_nextState_def next1_def)
  with assms show False by auto
qed

text {* Processes can make a new decision only at second round of each phase. *}

lemma decide_step:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and d1: "decide (rho r p) \<noteq> Some v"
  and d2: "decide (rho (Suc r) p) = Some v"
  shows "step r \<noteq> 0"
proof
  assume sr:"step r = 0"
  from run obtain \<mu> where "Ute_nextState r p (rho r p) \<mu> (rho (Suc r) p)"
    unfolding Ute_SHOMachine_def nextState_def SHORun_eq SHOnextConfig_eq
    by force
  with sr have "next0 r p (rho r p) \<mu> (rho (Suc r) p)"
    unfolding Ute_nextState_def by auto
  hence "decide (rho r p) = decide (rho (Suc r) p)"
    by (auto simp:next0_def)
  with d1 d2 show False by auto
qed

lemma unique_majority_E:
  assumes majv: "card {qq::Proc. F qq = Some m} > E"
  and majw: "card {qq::Proc. F qq = Some m'} > E"
  shows "m = m'"
proof -
  from majv majw majE
  have "card {qq::Proc. F qq = Some m} > N div 2"
    and "card {qq::Proc. F qq = Some m'} > N div 2"
    by auto
  then obtain qq
    where "qq \<in> {qq::Proc. F qq = Some m}"
      and "qq \<in> {qq::Proc. F qq = Some m'}"
    by (rule majoritiesE')
  thus ?thesis by auto
qed

lemma unique_majority_E_\<alpha>:
  assumes majv: "card {qq::Proc. F qq = m} > E - \<alpha>"
  and majw: "card {qq::Proc. F qq = m'} > E - \<alpha>"
  shows "m = m'"
proof -
  from majE alpha_lt_N majv majw
  have "card {qq::Proc. F qq = m} > N div 2"
    and "card {qq::Proc. F qq = m'} > N div 2"
    by auto
  then obtain qq
    where "qq \<in> {qq::Proc. F qq = m}"
      and "qq \<in> {qq::Proc. F qq = m'}"
    by (rule majoritiesE')
  thus ?thesis by auto
qed

lemma unique_majority_T:
  assumes majv: "card {qq::Proc. F qq = Some m} > T"
  and majw: "card {qq::Proc. F qq = Some m'} > T"
  shows "m = m'"
proof -
  from majT majv majw
  have "card {qq::Proc. F qq = Some m} > N div 2"
    and "card {qq::Proc. F qq = Some m'} > N div 2"
    by auto
  then obtain qq
    where "qq \<in> {qq::Proc. F qq = Some m}"
      and "qq \<in> {qq::Proc. F qq = Some m'}"
    by (rule majoritiesE')
  thus ?thesis by auto
qed

text {* No two processes may vote for different values in the same round. *}

lemma common_vote:
  assumes usafe: "SHOcommPerRd Ute_M HO SHO"
  and nxtp: "nextState Ute_M r p (rho r p)  \<mu>p (rho (Suc r) p)"
  and mup: "\<mu>p \<in> SHOmsgVectors Ute_M r p (rho r) (HO p) (SHO p)"
  and nxtq: "nextState Ute_M r q (rho r q)  \<mu>q (rho (Suc r) q)"
  and muq: "\<mu>q \<in> SHOmsgVectors Ute_M r q (rho r) (HO q) (SHO q)"
  and vp: "vote (rho (Suc r) p) = Some vp"
  and vq: "vote (rho (Suc r) q) = Some vq"
  shows "vp = vq"
using assms proof -
  have gtn: "card {qq. sendMsg Ute_M r qq p (rho r qq) = Val vp}
           + card {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq} > N"
  proof -
    have "card {qq. sendMsg Ute_M r qq p (rho r qq) = Val vp} > T - \<alpha>
        \<and> card {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq} > T - \<alpha>"
      (is "card ?vsentp > _ \<and> card ?vsentq > _")
    proof -
      from nxtp vp have stp:"step r = 0" by (auto simp: vote_step)
      from mup
      have "{qq. \<mu>p qq = Some (Val vp)} - (HO p - SHO p)
             \<subseteq> {qq. sendMsg Ute_M r qq p (rho r qq) = Val vp}"
             (is "?vrcvdp - ?ahop \<subseteq> ?vsentp")
         by (auto simp: SHOmsgVectors_def)
      hence "card (?vrcvdp - ?ahop) \<le> card ?vsentp"
        and "card (?vrcvdp - ?ahop) \<ge> card ?vrcvdp - card ?ahop"
        by (auto simp: card_mono diff_card_le_card_Diff)
      hence "card ?vsentp \<ge> card ?vrcvdp - card ?ahop" by auto
      moreover
      from nxtp stp have "next0 r p (rho r p) \<mu>p (rho (Suc r) p)"
        by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
      with vp have "card ?vrcvdp > T"
        unfolding next0_def by auto
      moreover
      from muq
      have "{qq. \<mu>q qq = Some (Val vq)} - (HO q - SHO q)
             \<subseteq> {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq}"
             (is "?vrcvdq - ?ahoq \<subseteq> ?vsentq")
        by (auto simp: SHOmsgVectors_def)
      hence "card (?vrcvdq - ?ahoq) \<le> card ?vsentq"
        and "card (?vrcvdq - ?ahoq) \<ge> card ?vrcvdq - card ?ahoq"
        by (auto simp: card_mono diff_card_le_card_Diff)
      hence "card ?vsentq \<ge> card ?vrcvdq - card ?ahoq" by auto
      moreover
      from nxtq stp have "next0 r q (rho r q) \<mu>q (rho (Suc r) q)"
        by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
      with vq have "card {qq. \<mu>q qq = Some (Val vq)} > T"
        by (unfold next0_def, auto)
      moreover
      from usafe have "card ?ahop \<le> \<alpha>" and "card ?ahoq \<le> \<alpha>"
        by (auto simp: Ute_SHOMachine_def Ute_commPerRd_def)
      ultimately
      show ?thesis using alpha_lt_T by auto
    qed
    thus ?thesis using majT by auto
  qed

  show ?thesis
  proof (rule ccontr)
    assume vpq:"vp \<noteq> vq"
    have "\<forall>qq. sendMsg Ute_M r qq p (rho r qq)
               = sendMsg Ute_M r qq q (rho r qq)"
      by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def
                     step_def send0_def send1_def)
    with vpq
    have "{qq. sendMsg Ute_M r qq p (rho r qq) = Val vp}
           \<inter> {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq} = {}"
      by auto
    with gtn
    have "card ({qq. sendMsg Ute_M r qq p (rho r qq) = Val vp}
                  \<union> {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq}) > N"
      by (auto simp: card_Un_Int)
    moreover
    have "card ({qq. sendMsg Ute_M r qq p (rho r qq) = Val vp}
                  \<union> {qq. sendMsg Ute_M r qq q (rho r qq) = Val vq}) \<le> N"
      by (auto simp: card_mono)
    ultimately
    show "False" by auto
  qed
qed

text {*
  No decision may be taken by a process unless it received enough messages
  holding the same value.
*}
(*
  The proof mainly relies on lemma @{text decide_step}
  and the @{text Ute_commPerRound} predicate.
*)

lemma decide_with_threshold_E:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and usafe: "SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and d1: "decide (rho r p) \<noteq> Some v"
  and d2: "decide (rho (Suc r) p) = Some v"
  shows "card {q. sendMsg Ute_M r q p (rho r q) = Vote (Some v)}
           > E - \<alpha>"
proof -
  from run obtain \<mu>p
    where nxt:"nextState Ute_M r p (rho r p) \<mu>p (rho (Suc r) p)"
      and "\<forall>qq. qq \<in> HOs r p \<longleftrightarrow> \<mu>p qq \<noteq> None"
      and "\<forall>qq. qq \<in> SHOs r p \<inter> HOs r p
                \<longrightarrow> \<mu>p qq = Some (sendMsg Ute_M r qq p (rho r qq))"
    unfolding Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq SHOmsgVectors_def
    by blast
  hence "{qq. \<mu>p qq = Some (Vote (Some v))} - (HOs r p - SHOs r p)
          \<subseteq> {qq. sendMsg Ute_M r qq p (rho r qq) = Vote (Some v)}"
         (is "?vrcvdp - ?ahop \<subseteq> ?vsentp") by auto
  hence "card (?vrcvdp - ?ahop) \<le> card ?vsentp"
    and "card (?vrcvdp - ?ahop) \<ge> card ?vrcvdp - card ?ahop"
    by (auto simp: card_mono diff_card_le_card_Diff)
  hence "card ?vsentp \<ge> card ?vrcvdp - card ?ahop" by auto
  moreover
  from usafe have "card (HOs r p - SHOs r p) \<le> \<alpha>"
    by (auto simp: Ute_SHOMachine_def Ute_commPerRd_def)
  moreover
  from run d1 d2 have "step r \<noteq> 0" by (rule decide_step)
  with nxt have "next1 r p (rho r p) \<mu>p (rho (Suc r) p)"
    by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
  with run d1 d2 have "card {qq. \<mu>p qq = Some (Vote (Some v))} > E"
    unfolding next1_def by auto
  ultimately
  show ?thesis using alpha_lt_E by auto
qed

subsection {* Proof of Agreement and Validity *}

text {*
  If more than @{text "E - \<alpha>"} messages holding @{text v} are sent to
  some process @{text p} at round @{text r}, then every process @{text pp}
  correctly receives more than @{text "\<alpha>"} such messages.
*}
(*
  The proof mainly relies on the @{text Ute_commPerRound} predicate.
*)

lemma common_x_argument_1:
  assumes usafe:"SHOcommPerRd Ute_M (HOs (Suc r)) (SHOs (Suc r))"
  and threshold: "card {q. sendMsg Ute_M (Suc r) q p (rho (Suc r) q)
                            = Vote (Some v)} > E - \<alpha>"
                 (is "card (?msgs p v) > _")
  shows "card (?msgs pp v \<inter> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp)) > \<alpha>"
proof -
  have "card (?msgs pp v) + card (SHOs (Suc r) pp \<inter> HOs (Suc r) pp) > N + \<alpha>"
  proof -
    have "\<forall>q. sendMsg Ute_M (Suc r) q p (rho (Suc r) q)
                = sendMsg Ute_M (Suc r) q pp (rho (Suc r) q)"
      by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def
                     step_def send0_def send1_def)
    moreover
    from usafe
    have "card (SHOs (Suc r) pp \<inter> HOs (Suc r) pp) > N + 2*\<alpha> - E - 1"
      by (auto simp: Ute_SHOMachine_def step_def Ute_commPerRd_def)
    ultimately
    show ?thesis using threshold by auto
  qed
  moreover
  have "card (?msgs pp v) + card (SHOs (Suc r) pp \<inter> HOs (Suc r) pp)
        = card (?msgs pp v \<union> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp))
          + card (?msgs pp v \<inter> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp))"
    by (auto intro: card_Un_Int)
  moreover
  have "card (?msgs pp v \<union> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp)) \<le> N"
    by (auto simp: card_mono)
  ultimately
  show ?thesis by auto
qed

text {*
  If more than @{text "E - \<alpha>"} messages holding @{text v} are sent to @{text p}
  at some round @{text r}, then any process @{text pp} will set its @{text x} to
  value @{text v} in @{text r}.
*}
(*
  The proof relies on previous lemmas @{text common_x_argument_1}
  and @{text common_vote} and the @{text Ute_commPerRound} predicate.
*)

lemma common_x_argument_2:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and usafe: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and nxtpp: "nextState Ute_M (Suc r) pp (rho (Suc r) pp)
                        \<mu>pp (rho (Suc (Suc r)) pp)"
  and mupp: "\<mu>pp \<in> SHOmsgVectors Ute_M (Suc r) pp (rho (Suc r))
                                 (HOs (Suc r) pp) (SHOs (Suc r) pp)"
  and threshold: "card {q. sendMsg Ute_M (Suc r) q p (rho (Suc r) q)
                             = Vote (Some v)} > E - \<alpha>"
                 (is "card (?sent p v) > _")
  shows "x (rho (Suc (Suc r)) pp) = v"
proof -
  have stp:"step (Suc r) \<noteq> 0"
  proof
    assume sr: "step (Suc r) = 0"
    hence "\<forall>q. sendMsg Ute_M (Suc r) q p (rho (Suc r) q)
                 = Val (x (rho (Suc r) q))"
      by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def send0_def)
    moreover
    from threshold obtain qq where
      "sendMsg Ute_M (Suc r) qq p (rho (Suc r) qq) = Vote (Some v)"
      by force
    ultimately
    show False by simp
  qed

  have va: "card {qq. \<mu>pp qq = Some (Vote (Some v))} > \<alpha>"
       (is "card (?msgs v) > \<alpha>")
  proof -
    from mupp
    have "SHOs (Suc r) pp \<inter> HOs (Suc r) pp
          \<subseteq> {qq. \<mu>pp qq = Some (sendMsg Ute_M (Suc r) qq pp (rho (Suc r) qq))}"
      unfolding SHOmsgVectors_def by auto
    moreover
    hence "(?msgs v) \<supseteq> (?sent pp v) \<inter> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp)"
      by auto
    hence "card (?msgs v)
             \<ge> card ((?sent pp v) \<inter> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp))"
      by (auto intro: card_mono)
    moreover
    from usafe threshold
    have alph:"card ((?sent pp v) \<inter> (SHOs (Suc r) pp \<inter> HOs (Suc r) pp)) > \<alpha>"
      by (blast dest: common_x_argument_1)
    ultimately
    show ?thesis by auto
  qed
  moreover
  from nxtpp stp
  have "next1 (Suc r) pp (rho (Suc r) pp)  \<mu>pp (rho (Suc (Suc r)) pp)"
    by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
  ultimately
  obtain w where wa:"card (?msgs w) > \<alpha>" and xw:"x (rho (Suc (Suc r)) pp) = w"
    unfolding next1_def by auto

  have "v = w"
  proof -
    note usafe
    moreover
    obtain qv where "qv \<in> SHOs (Suc r) pp" and "\<mu>pp qv = Some (Vote (Some v))"
    proof -
      have "\<not> (?msgs v \<subseteq> HOs (Suc r) pp - SHOs (Suc r) pp)"
      proof
        assume "?msgs v \<subseteq> HOs (Suc r) pp - SHOs (Suc r) pp"
        hence "card (?msgs v) \<le> card ((HOs (Suc r) pp) - (SHOs (Suc r) pp))"
          by (auto simp: card_mono)
        moreover
        from usafe
        have "card (HOs (Suc r) pp - SHOs (Suc r) pp) \<le> \<alpha>"
          by (auto simp: Ute_SHOMachine_def Ute_commPerRd_def)
        moreover
        note va
        ultimately
        show False by auto
      qed
      then obtain qv
        where "qv \<notin> HOs (Suc r) pp - SHOs (Suc r) pp"
          and qsv:"\<mu>pp qv = Some (Vote (Some v))"
        by auto
      with mupp have "qv \<in> SHOs (Suc r) pp"
        unfolding SHOmsgVectors_def by auto
      with qsv that show ?thesis by auto
    qed
    with stp mupp have "vote (rho (Suc r) qv) = Some v"
      by (auto simp: Ute_SHOMachine_def SHOmsgVectors_def
                     Ute_sendMsg_def send1_def)
    moreover
    obtain qw where
      "qw \<in> SHOs (Suc r) pp" and "\<mu>pp qw = Some (Vote (Some w))"
    proof -
      have "\<not> (?msgs w \<subseteq> HOs (Suc r) pp - SHOs (Suc r) pp)"
      proof
        assume "?msgs w \<subseteq> HOs (Suc r) pp - SHOs (Suc r) pp"
        hence "card (?msgs w) \<le> card ((HOs (Suc r) pp) - (SHOs (Suc r) pp))"
          by (auto simp: card_mono)
        moreover
        from usafe
        have "card (HOs (Suc r) pp - SHOs (Suc r) pp) \<le> \<alpha>"
          by (auto simp: Ute_SHOMachine_def Ute_commPerRd_def)
        moreover
        note wa
        ultimately
        show False by auto
      qed
      then obtain qw
        where "qw \<notin> HOs (Suc r) pp - SHOs (Suc r) pp"
          and qsw: "\<mu>pp qw = Some (Vote (Some w))"
        by auto
      with mupp have "qw \<in> SHOs (Suc r) pp"
        unfolding SHOmsgVectors_def by auto
      with qsw that show ?thesis by auto
    qed
    with stp mupp have "vote (rho (Suc r) qw) = Some w"
      by (auto simp: Ute_SHOMachine_def SHOmsgVectors_def
                     Ute_sendMsg_def send1_def)
    moreover
    from run obtain \<mu>qv \<mu>qw
      where "nextState Ute_M r qv ((rho r) qv)  \<mu>qv (rho (Suc r) qv)"
        and "\<mu>qv \<in> SHOmsgVectors Ute_M r qv (rho r) (HOs r qv) (SHOs r qv)"
        and "nextState Ute_M r qw ((rho r) qw)  \<mu>qw (rho (Suc r) qw)"
        and "\<mu>qw \<in> SHOmsgVectors Ute_M r qw (rho r) (HOs r qw) (SHOs r qw)"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq) blast
    ultimately
    show ?thesis using usafe by (auto dest: common_vote)
  qed
  with xw show "x (rho (Suc (Suc r)) pp) = v" by auto
qed

text {*
  Inductive argument for the agreement and validity theorems.
*}
(*
  The proof relies on previous lemmas @{text common_x_argument_2}
  and @{text unique_majority_T} and the @{text Ute_commPerRound} predicate.
*)

lemma safety_inductive_argument:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and ih: "E - \<alpha> < card {q. sendMsg Ute_M r' q p (rho r' q) = Vote (Some v)}"
  and stp1: "step r' = Suc 0"
  shows "E - \<alpha> <
         card {q. sendMsg Ute_M (Suc (Suc r')) q p (rho (Suc (Suc r')) q)
                     = Vote (Some v)}"
proof -
  from stp1 have "r' > 0" by (auto simp: step_def)
  with stp1 obtain r where rr':"r' = Suc r" and stpr:"step (Suc r) = Suc 0"
    by (auto dest: gr0_implies_Suc)

  have "\<forall>pp. x (rho (Suc (Suc r)) pp) = v"
  proof
    fix pp
    from run obtain \<mu>pp
      where "\<mu>pp \<in> SHOmsgVectors Ute_M r' pp (rho r') (HOs r' pp) (SHOs r' pp)"
        and "nextState Ute_M r' pp (rho r' pp)  \<mu>pp (rho (Suc r') pp)"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)
    with run comm ih rr' show "x (rho (Suc (Suc r)) pp) = v"
      by (auto dest: common_x_argument_2)
  qed
  with run stpr
  have "\<forall>pp p. sendMsg Ute_M (Suc (Suc r)) pp p (rho (Suc (Suc r)) pp) = Val v"
    by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq
                   Ute_sendMsg_def send0_def mod_Suc step_def)
  with rr'
  have "\<And>p \<mu>p'. \<mu>p' \<in> SHOmsgVectors Ute_M (Suc r') p (rho (Suc r'))
                                     (HOs (Suc r') p) (SHOs (Suc r') p)
             \<Longrightarrow> SHOs (Suc r') p \<inter> HOs (Suc r') p
                   \<subseteq> {q. \<mu>p' q = Some (Val v)}"
    by (auto simp: SHOmsgVectors_def)
  hence "\<And>p \<mu>p'. \<mu>p' \<in> SHOmsgVectors Ute_M (Suc r') p (rho (Suc r'))
                                       (HOs (Suc r') p) (SHOs (Suc r') p)
             \<Longrightarrow> card (SHOs (Suc r') p \<inter> HOs (Suc r') p)
                   \<le> card {q. \<mu>p' q = Some (Val v)}"
    by (auto simp: card_mono)
  moreover
  from comm have "\<And>p. T < card (SHOs (Suc r') p \<inter> HOs (Suc r') p)"
    by (auto simp: Ute_SHOMachine_def Ute_commPerRd_def)
  ultimately
  have vT:"\<And>p \<mu>p'. \<mu>p' \<in> SHOmsgVectors Ute_M (Suc r') p (rho (Suc r'))
                                         (HOs (Suc r') p) (SHOs (Suc r') p)
                \<Longrightarrow> T < card {q. \<mu>p' q = Some (Val v)}"
    by (auto dest: less_le_trans)

  show ?thesis
  proof -
    have "\<forall>pp. vote ((rho (Suc (Suc r'))) pp) = Some v"
    proof
      fix pp
      from run obtain \<mu>pp
        where nxtpp: "nextState Ute_M (Suc r') pp (rho (Suc r') pp) \<mu>pp
                                      (rho (Suc (Suc r')) pp)"
          and mupp: "\<mu>pp \<in> SHOmsgVectors Ute_M (Suc r') pp (rho (Suc r'))
                                     (HOs (Suc r') pp) (SHOs (Suc r') pp)"
        by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)
      with vT have vT':"card {q. \<mu>pp q = Some (Val v)} > T"
        by auto
      moreover
      from stpr rr' have "step (Suc r') = 0"
        by (auto simp: mod_Suc step_def)
      with nxtpp
      have "next0 (Suc r') pp (rho (Suc r') pp) \<mu>pp (rho (Suc (Suc r')) pp)"
        by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
      ultimately
      obtain w
        where wT:"card {q. \<mu>pp q = Some (Val w)} > T"
          and votew:"vote (rho (Suc (Suc r')) pp) = Some w"
        by (auto simp: next0_def)
      from vT' wT have "v = w"
        by (auto dest: unique_majority_T)
      with votew show "vote (rho (Suc (Suc r')) pp) = Some v" by simp
    qed
    with run stpr rr'
    have "\<forall>p. N = card {q. sendMsg Ute_M (Suc (Suc (Suc r))) q p
                                  ((rho (Suc (Suc (Suc r)))) q) = Vote (Some v)}"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq
                     Ute_sendMsg_def send1_def step_def mod_Suc)
    with rr' majE EltN show ?thesis by auto
  qed
qed

text {*
  A process that holds some decision @{text v} has decided @{text v}
  sometime in the past.
*}

lemma decisionNonNullThenDecided:
  assumes run:"SHORun Ute_M rho HOs SHOs" and dec: "decide (rho n p) = Some v"
  shows "\<exists>m<n. decide (rho (Suc m) p) \<noteq> decide (rho m p)
             \<and> decide (rho (Suc m) p) = Some v"
proof -
  let "?dec k" = "decide ((rho k) p)"
  have "(\<forall>m<n. ?dec (Suc m) \<noteq> ?dec m \<longrightarrow> ?dec (Suc m) \<noteq> Some v)
        \<longrightarrow> ?dec n \<noteq> Some v"
    (is "?P n" is "?A n \<longrightarrow> _")
  proof (induct n)
    from run show "?P 0"
      by (auto simp: Ute_SHOMachine_def SHORun_eq HOinitConfig_eq
                     initState_def Ute_initState_def)
  next
    fix n
    assume ih: "?P n" thus "?P (Suc n)" by force
  qed
  with dec show ?thesis by auto
qed

text {*
  If process @{text "p1"} has decided value @{text "v1"} and process
  @{text "p2"} later decides, then @{text "p2"} must decide @{text "v1"}.
*}
(*
  The proof relies on previous lemmas @{text decide_step},
  @{text decide_with_threshold_E}, @{text unique_majority_E_\<alpha>},
  @{text decisionNonNullThenDecided} and @{text safety_inductive_argument}.
*)

lemma laterProcessDecidesSameValue:
  assumes run:"SHORun Ute_M rho HOs SHOs"
  and comm:"\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and dv1:"decide (rho (Suc r) p1) = Some v1"
  and dn2:"decide (rho (r + k) p2) \<noteq> Some v2"
  and dv2:"decide (rho (Suc (r + k)) p2) = Some v2"
  shows "v2 = v1"
proof -
  from run dv1 obtain r1
    where r1r:"r1 < Suc r"
      and dn1:"decide (rho r1 p1) \<noteq> Some v1"
      and dv1':"decide (rho (Suc r1) p1) = Some v1"
    by (auto dest: decisionNonNullThenDecided)

  from r1r obtain s where rr1:"Suc r = Suc (r1 + s)"
    by (auto dest: less_imp_Suc_add)
  then obtain k' where kk':"r + k = r1 + k'"
    by auto
  with dn2 dv2
  have dn2': "decide (rho (r1 + k') p2) \<noteq> Some v2"
    and dv2': "decide (rho (Suc (r1 + k')) p2) = Some v2"
    by auto

  from run dn1 dv1' dn2' dv2'
  have rs0:"step r1 = Suc 0" and  rks0:"step (r1 + k') = Suc 0"
    by (auto simp: mod_Suc step_def dest: decide_step)

  have "step (r1 + k') = step (step r1 + k')"
    unfolding step_def by (rule mod_add_left_eq)
  with rs0 rks0 have "step k' = 0" by (auto simp: step_def mod_Suc)
  then obtain k'' where "k' = k''*nSteps" by (auto simp: step_def)
  with dn2' dv2'
  have dn2'':"decide (rho (r1 + k''*nSteps) p2) \<noteq> Some v2"
    and dv2'':"decide (rho (Suc (r1 + k''*nSteps)) p2) = Some v2"
    by auto

  from rs0 have stp:"step (r1 + k''*nSteps) = Suc 0"
    unfolding step_def by auto

  have inv:"card {q. sendMsg Ute_M (r1 + k''*nSteps) q p1 (rho (r1 + k''*nSteps) q)
                         = Vote (Some v1)} > E - \<alpha>"
  proof (induct k'')
    from stp have "step (r1 + 0*nSteps) = Suc 0"
      by (auto simp: step_def)
    from run comm dn1 dv1'
    show "card {q. sendMsg Ute_M (r1 + 0*nSteps) q p1 (rho (r1 + 0*nSteps) q)
                      = Vote (Some v1)} > E - \<alpha>"
      by (intro decide_with_threshold_E) auto
  next
    fix k''
    assume ih: "E - \<alpha> <
          card {q. sendMsg Ute_M (r1 + k''*nSteps) q p1 (rho (r1 + k''*nSteps) q)
                       = Vote (Some v1)}"
    from rs0 have stps: "step (r1 + k''*nSteps) = Suc 0"
      by (auto simp: step_def)
    with run comm ih
    have "E - \<alpha>  <
       card {q. sendMsg Ute_M (Suc (Suc (r1 + k''*nSteps))) q p1
                              (rho (Suc (Suc (r1 + k''*nSteps))) q)
                   = Vote (Some v1)}"
      by (rule safety_inductive_argument)
    thus "E - \<alpha> <
       card {q. sendMsg Ute_M (r1 + Suc k'' * nSteps) q p1
                              (rho (r1 + Suc k'' * nSteps) q)
                     = Vote (Some v1)}"
      by auto
  qed
  moreover
  from run
  have "\<forall>q. sendMsg Ute_M (r1 + k''*nSteps) q p1 (rho (r1 + k''*nSteps) q)
          = sendMsg Ute_M (r1 + k''*nSteps) q p2 (rho (r1 + k''*nSteps) q)"
    by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def
                   step_def send0_def send1_def)
  moreover
  from run comm dn2'' dv2''
  have "E - \<alpha> <
      card {q. sendMsg Ute_M (r1 + k''*nSteps) q p2 (rho (r1 + k''*nSteps) q)
                  = Vote (Some v2)}"
    by (auto dest: decide_with_threshold_E)
  ultimately
  show "v2 = v1" by (auto dest: unique_majority_E_\<alpha>)
qed

text {*
  The Agreement property is an immediate consequence of the two
  preceding lemmas.
*}

theorem ute_agreement:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and p: "decide (rho m p) = Some v"
  and q: "decide (rho n q) = Some w"
  shows "v = w"
proof -
  from run p obtain k
    where k1: "decide (rho (Suc k) p) \<noteq> decide (rho k p)"
      and k2: "decide (rho (Suc k) p) = Some v"
    by (auto dest: decisionNonNullThenDecided)
  from run q obtain l
    where l1: "decide (rho (Suc l) q) \<noteq> decide (rho l q)"
      and l2: "decide (rho (Suc l) q) = Some w"
    by (auto dest: decisionNonNullThenDecided)
  show ?thesis
  proof (cases "k \<le> l")
    case True
    then obtain m where m: "l = k+m" by (auto simp add: le_iff_add)
    from run comm k2 l1 l2 m have "w = v"
      by (auto elim!: laterProcessDecidesSameValue)
    thus ?thesis by simp
  next
    case False
    hence "l \<le> k" by simp
    then obtain m where m: "k = l+m" by (auto simp add: le_iff_add)
    from run comm l2 k1 k2 m show ?thesis
      by (auto elim!: laterProcessDecidesSameValue)
  qed
qed

text {*
  Main lemma for the proof of the Validity property.
*}
(*
  The proof relies on previous lemmas @{text safety_inductive_argument},
  @{text unique_majority_T} and the @{text Ute_commPerRound} predicate.
*)

      from majv majw have "v = w" by (auto dest: unique_majority_T)
      with votew show "vote ((rho (Suc 0)) pp) = Some v" by simp
    qed
    with run
    have "card {q. sendMsg Ute_M (Suc 0) q p (rho (Suc 0) q) = Vote (Some v)} = N"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq
                     Ute_nextState_def step_def Ute_sendMsg_def send1_def)
    thus "E - \<alpha> <
      card {q. sendMsg Ute_M (Suc 0 + 0 * nSteps) q p (rho (Suc 0 + 0 * nSteps) q)
                   = Vote (Some v)}"
      using majE EltN by auto
  next
    fix k
    assume ih:"E - \<alpha> <
        card {q. sendMsg Ute_M (Suc 0 + k * nSteps) q p (rho (Suc 0 + k * nSteps) q)
                     = Vote (Some v)}"
    have "step (Suc 0 + k * nSteps) = Suc 0"
      by (auto simp: mod_Suc step_def)
    from run comm ih this
    have "E - \<alpha> <
      card {q. sendMsg Ute_M (Suc (Suc (Suc 0 + k * nSteps))) q p
                             (rho (Suc (Suc (Suc 0 + k * nSteps))) q)
                  = Vote (Some v)}"
      by (rule safety_inductive_argument)
    thus "E - \<alpha> <
       card {q. sendMsg Ute_M (Suc 0 + Suc k * nSteps) q p
                              (rho (Suc 0 + Suc k * nSteps) q)
                 = Vote (Some v)}" by simp
  qed
  ultimately
  show ?thesis by simp
qed

text {*
  The following theorem shows the Validity property of algorithm \ute{}.
*}
(*
 The proof relies on previous lemmas @{text decisionNonNullThenDecided},
 @{text decide_step}, @{text decide_with_threshold_E},  @{text unique_majority_E_\<alpha>},
 and the @{text Validity_argument}.
*)

theorem ute_validity:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and comm: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and init: "\<forall>p. x (rho 0 p) = v"
  and dw: "decide (rho r p) = Some w"
  shows "v = w"
proof -
  from run dw obtain r1
    where dnr1:"decide ((rho r1) p) \<noteq> Some w"
      and dwr1:"decide ((rho (Suc r1)) p) = Some w"
    by (force dest: decisionNonNullThenDecided)
  with run have "step r1 \<noteq> 0" by (rule decide_step)
  hence "step r1 = Suc 0" by (simp add: step_def mod_Suc)
  with assms
  have "E - \<alpha> <
        card {q. sendMsg Ute_M r1 q p (rho r1 q) = Vote (Some v)}"
    by (rule validity_argument)
  moreover
  from run comm dnr1 dwr1
  have "card {q. sendMsg Ute_M r1 q p (rho r1 q) = Vote (Some w)} > E - \<alpha>"
    by (auto dest: decide_with_threshold_E)
  ultimately
  show "v = w" by (auto dest: unique_majority_E_\<alpha>)
qed

subsection {* Proof of Termination *}

text {*
  At the second round of a phase that satisfies the conditions expressed in
  the global communication predicate, processes update their @{text x} variable
  with the value @{text v} they receive in more than @{text \<alpha>} messages.
*}
(* The proof relies on @{text common_vote}. *)

lemma set_x_from_vote:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and comm: "SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and stp: "step (Suc r) = Suc 0"
  and \<pi>: "\<forall>p. HOs (Suc r) p = SHOs (Suc r) p"
  and nxt: "nextState Ute_M (Suc r) p (rho (Suc r) p) \<mu> (rho (Suc (Suc r)) p)"
  and mu: "\<mu> \<in> SHOmsgVectors Ute_M (Suc r) p (rho (Suc r))
                                   (HOs (Suc r) p) (SHOs (Suc r) p)"
  and vp: "\<alpha> < card {qq. \<mu> qq = Some (Vote (Some v))}"
  shows "x ((rho (Suc (Suc r))) p) = v"
proof -
  from nxt stp vp obtain wp
    where xwp:"\<alpha> < card {qq. \<mu> qq = Some (Vote (Some wp))}"
      and xp:"x (rho (Suc (Suc r)) p) = wp"
    by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def next1_def)

  have "wp = v"
  proof -
    from xwp obtain pp where smw:"\<mu> pp = Some (Vote (Some wp))"
      by force
    have "vote (rho (Suc r) pp) = Some wp"
    proof -
      from smw mu \<pi>
      have "\<mu> pp = Some (sendMsg Ute_M (Suc r) pp p (rho (Suc r) pp))"
        unfolding SHOmsgVectors_def by force
      with stp have "\<mu> pp = Some (Vote (vote (rho (Suc r) pp)))"
        by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def send1_def)
      with smw show ?thesis by auto
    qed
    moreover
    from vp obtain qq where smv:"\<mu> qq = Some (Vote (Some v))"
      by force
    have "vote (rho (Suc r) qq) = Some v"
    proof -
      from smv mu \<pi>
      have "\<mu> qq = Some (sendMsg Ute_M (Suc r) qq p (rho (Suc r) qq))"
        unfolding SHOmsgVectors_def by force
      with stp have "\<mu> qq = Some (Vote (vote (rho (Suc r) qq)))"
        by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def send1_def)
      with smv show ?thesis by auto
    qed
    moreover
    from run obtain \<mu>pp \<mu>qq
      where "nextState Ute_M r pp (rho r pp) \<mu>pp (rho (Suc r) pp)"
        and "\<mu>pp \<in> SHOmsgVectors Ute_M r pp (rho r) (HOs r pp) (SHOs r pp)"
        and "nextState Ute_M r qq ((rho r) qq)  \<mu>qq (rho (Suc r) qq)"
        and "\<mu>qq \<in> SHOmsgVectors Ute_M r qq (rho r) (HOs r qq) (SHOs r qq)"
      unfolding Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq by blast
    ultimately
    show ?thesis using comm by (auto dest: common_vote)
  qed
  with xp show ?thesis by simp
qed

text {*
  Assume that HO and SHO sets are uniform at the second step of some
  phase. Then at the subsequent round there exists some value @{text v}
  such that any received message which is not corrupted holds @{text v}.
*}
(* The proof relies on lemma @{text set_x_from_vote}. *)

lemma termination_argument_1:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and comm: "SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and stp: "step (Suc r) = Suc 0"
  and \<pi>: "\<forall>p. \<pi>0 = HOs (Suc r) p \<and> \<pi>0 = SHOs (Suc r) p"
  obtains v where
    "\<And>p \<mu>p' q.
       \<lbrakk> q \<in> SHOs (Suc (Suc r)) p \<inter> HOs (Suc (Suc r)) p;
         \<mu>p' \<in> SHOmsgVectors Ute_M (Suc (Suc r)) p (rho (Suc (Suc r)))
                             (HOs (Suc (Suc r)) p) (SHOs (Suc (Suc r)) p)
       \<rbrakk> \<Longrightarrow> \<mu>p' q = (Some (Val v))"
proof -
  from \<pi> have hosho:"\<forall>p. SHOs (Suc r) p = SHOs (Suc r) p \<inter> HOs (Suc r) p"
    by simp

  have "\<And>p q. x (rho (Suc (Suc r)) p) = x (rho (Suc (Suc r)) q)"
  proof -
    fix p q
    from run obtain \<mu>p
      where nxt: "nextState Ute_M (Suc r) p (rho (Suc r) p)
                                  \<mu>p (rho (Suc (Suc r)) p)"
        and mu: "\<mu>p \<in> SHOmsgVectors Ute_M (Suc r) p (rho (Suc r))
                                          (HOs (Suc r) p) (SHOs (Suc r) p)"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)

    from run obtain \<mu>q
      where nxtq: "nextState Ute_M (Suc r) q (rho (Suc r) q)
                                   \<mu>q (rho (Suc (Suc r)) q)"
       and muq: "\<mu>q \<in> SHOmsgVectors Ute_M (Suc r) q (rho (Suc r))
                                          (HOs (Suc r) q) (SHOs (Suc r) q)"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)

    have "\<forall>qq. \<mu>p qq = \<mu>q qq"
    proof
      fix qq
      show "\<mu>p qq = \<mu>q qq"
      proof (cases "\<mu>p qq = None")
        case False
        with mu \<pi> have 1:"qq \<in> SHOs (Suc r) p" and 2:"qq \<in> SHOs (Suc r) q"
          unfolding SHOmsgVectors_def by auto
        from mu \<pi> 1
        have "\<mu>p qq = Some (sendMsg Ute_M (Suc r) qq p (rho (Suc r) qq))"
          unfolding SHOmsgVectors_def by auto
        moreover
        from muq \<pi> 2
        have "\<mu>q qq = Some (sendMsg Ute_M (Suc r) qq q (rho (Suc r) qq))"
          unfolding SHOmsgVectors_def by auto
        ultimately
        show ?thesis
          by (auto simp: Ute_SHOMachine_def Ute_sendMsg_def step_def
                         send0_def send1_def)
      next
        case True
        with mu have "qq \<notin> HOs (Suc r) p" unfolding SHOmsgVectors_def by auto
        with \<pi> muq have "\<mu>q qq = None" unfolding SHOmsgVectors_def by auto
        with True show ?thesis by simp
      qed
    qed
    hence vsets:"\<And>v. {qq. \<mu>p qq = Some (Vote (Some v))}
                    = {qq. \<mu>q qq = Some (Vote (Some v))}"
      by auto
    (* NB: due to the Global predicate (HO = SHO), we do not need \<alpha> + 1 msgs
       holding a true vote, only 1. We might also prefer to invoke only the
       @{text Ute_commPerRound} predicate to obtain qq :
       since "card (HOs (Suc r) p - SHOs (Suc r) p) < \<alpha>", there should be one
       "correct" message holding a vote and this vote should be common according
       to previous (Suc r)esults. *)

    show "x (rho (Suc (Suc r)) p) = x (rho (Suc (Suc r)) q)"
    proof (cases "\<exists>v. \<alpha> < card {qq. \<mu>p qq = Some (Vote (Some v))}", clarify)
      fix v
      assume vp: "\<alpha> < card {qq. \<mu>p qq = Some (Vote (Some v))}"
      with run comm stp \<pi> nxt mu have "x (rho (Suc (Suc r)) p) = v"
        by (auto dest: set_x_from_vote)
      moreover
      from vsets vp
      have "\<alpha> < card {qq. \<mu>q qq = Some (Vote (Some v))}" by auto
      with run comm stp \<pi> nxtq muq have "x (rho (Suc (Suc r)) q) = v"
        by (auto dest: set_x_from_vote)
      ultimately
      show "x (rho (Suc (Suc r)) p) = x (rho (Suc (Suc r)) q)"
        by auto
    next
      assume nov: "\<not> (\<exists>v. \<alpha> < card {qq. \<mu>p qq = Some (Vote (Some v))})"
      with nxt stp have "x (rho (Suc (Suc r)) p) = undefined"
        by (auto simp: Ute_SHOMachine_def nextState_def
                       Ute_nextState_def next1_def)
      moreover
      from vsets nov
      have "\<not> (\<exists>v. \<alpha> < card {qq. \<mu>q qq = Some (Vote (Some v))})" by auto
      with nxtq stp have "x (rho (Suc (Suc r)) q) = undefined"
        by (auto simp: Ute_SHOMachine_def nextState_def
                       Ute_nextState_def next1_def)
      ultimately
      show ?thesis by simp
    qed
  qed
  then obtain v where "\<And>q. x (rho (Suc (Suc r)) q) = v" by blast
  moreover
  from stp have "step (Suc (Suc r)) = 0"
    by (auto simp: step_def mod_Suc)
  hence "\<And>p \<mu>p' q.
    \<lbrakk> q \<in> SHOs (Suc (Suc r)) p \<inter> HOs (Suc (Suc r)) p;
      \<mu>p' \<in> SHOmsgVectors Ute_M (Suc (Suc r)) p (rho (Suc (Suc r)))
                          (HOs (Suc (Suc r)) p) (SHOs (Suc (Suc r)) p)
    \<rbrakk> \<Longrightarrow> \<mu>p' q = Some (Val (x (rho (Suc (Suc r)) q)))"
    by (auto simp: Ute_SHOMachine_def SHOmsgVectors_def Ute_sendMsg_def send0_def)
  ultimately
  have "\<And>p \<mu>p' q.
    \<lbrakk> q \<in> SHOs (Suc (Suc r)) p  \<inter> HOs (Suc (Suc r)) p;
      \<mu>p' \<in> SHOmsgVectors Ute_M (Suc (Suc r)) p (rho (Suc (Suc r)))
                                (HOs (Suc (Suc r)) p) (SHOs (Suc (Suc r)) p)
    \<rbrakk> \<Longrightarrow> \<mu>p' q = (Some (Val v))"
    by auto
  with that show thesis by blast
qed

text {*
  If a process @{text p} votes @{text v} at some round @{text r},
  then all messages received by @{text p} in @{text r} that are not
  corrupted hold @{text v}.
*}
(* immediate from lemma @{text vote_step} and the algorithm definition. *)

lemma termination_argument_2:
  assumes mup: "\<mu>p \<in> SHOmsgVectors Ute_M (Suc r) p (rho (Suc r))
                                     (HOs (Suc r) p) (SHOs (Suc r) p)"
  and nxtq: "nextState Ute_M r q (rho r q)  \<mu>q (rho (Suc r) q)"
  and vq: "vote (rho (Suc r) q) = Some v"
  and qsho: "q \<in> SHOs (Suc r) p \<inter> HOs (Suc r) p"
  shows "\<mu>p q = Some (Vote (Some v))"
proof -
  from nxtq vq have "step r = 0" by (auto simp: vote_step)
  with mup qsho have "\<mu>p q = Some (Vote (vote (rho (Suc r) q)))"
    by (auto simp: Ute_SHOMachine_def SHOmsgVectors_def Ute_sendMsg_def
                   step_def send1_def mod_Suc)
  with vq show "\<mu>p q = Some (Vote (Some v))" by auto
qed

text{*
  We now prove the Termination property.
*}
(*
  The proof relies on previous lemmas @{text termination_argument_1},
  @{text termination_argument_2}, @{text common_vote}, @{text unique_majority_E},
  and the @{text Ute_commGlobal} predicate.
*)

theorem ute_termination:
  assumes run: "SHORun Ute_M rho HOs SHOs"
  and commR: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
  and commG: "SHOcommGlobal Ute_M HOs SHOs"
  shows "\<exists>r v. decide (rho r p) = Some v"
proof -
  from commG
  obtain \<Phi> \<pi> r0
    where rr: "r0 = Suc (nSteps * \<Phi>)"
      and \<pi>: "\<forall>p. \<pi> = HOs r0 p \<and> \<pi> = SHOs r0 p"
      and t: "\<forall>p. card (SHOs (Suc r0) p \<inter> HOs (Suc r0) p) > T"
      and e: "\<forall>p. card (SHOs (Suc (Suc r0)) p \<inter> HOs (Suc (Suc r0)) p) > E"
    by (auto simp: Ute_SHOMachine_def Ute_commGlobal_def Let_def)
  from rr have stp:"step r0 = Suc 0" by (auto simp: step_def)

  obtain w where votew:"\<forall>p. (vote (rho (Suc (Suc r0)) p)) = Some w"
  proof -
    have abc:"\<forall>p. \<exists>w. vote (rho (Suc (Suc r0)) p) = Some w"
    proof
      fix p
      from run stp obtain \<mu>p
        where nxt:"nextState Ute_M (Suc r0) p (rho (Suc r0) p) \<mu>p
                                   (rho (Suc (Suc r0)) p)"
          and mup:"\<mu>p \<in> SHOmsgVectors Ute_M (Suc r0) p (rho (Suc r0))
                                      (HOs (Suc r0) p) (SHOs (Suc r0) p)"
        by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)

      have "\<exists>v. T < card {qq. \<mu>p qq = Some (Val v)}"
      proof -
        from t have "card (SHOs (Suc r0) p \<inter> HOs (Suc r0) p) > T" ..
        moreover
        from run commR stp \<pi> rr
        obtain v where
          "\<And>p \<mu>p' q.
              \<lbrakk> q \<in> SHOs (Suc r0) p \<inter> HOs (Suc r0) p;
                \<mu>p' \<in> SHOmsgVectors Ute_M (Suc r0) p (rho (Suc r0))
                                          (HOs (Suc r0) p) (SHOs (Suc r0) p)
              \<rbrakk> \<Longrightarrow> \<mu>p' q = Some (Val v)"
          using termination_argument_1 by blast

        with mup obtain v where
          "\<And>qq. qq \<in> SHOs (Suc r0) p \<inter> HOs (Suc r0) p \<Longrightarrow> \<mu>p qq = Some (Val v)"
          by auto
        hence "SHOs (Suc r0) p \<inter> HOs (Suc r0) p \<subseteq> {qq. \<mu>p qq = Some (Val v)}"
          by auto
        hence "card (SHOs (Suc r0) p \<inter> HOs (Suc r0) p)
                 \<le> card {qq. \<mu>p qq = Some (Val v)}"
          by (auto intro: card_mono)
        ultimately
        have "T < card {qq. \<mu>p qq = Some (Val v)}" by auto
        thus ?thesis by auto
      qed
      with stp nxt show "\<exists>w. vote ((rho (Suc (Suc r0))) p) = Some w"
        by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def
                       step_def mod_Suc next0_def)
    qed
    then obtain qq w where qqw:"vote (rho (Suc (Suc r0)) qq) = Some w"
      by blast
    have "\<forall>pp. vote (rho (Suc (Suc r0)) pp) = Some w"
    proof
      fix pp
      from abc obtain wp where pwp:"vote ((rho (Suc (Suc r0))) pp) = Some wp"
        by blast
      from run obtain \<mu>pp \<mu>qq
        where nxtp: "nextState Ute_M (Suc r0) pp (rho (Suc r0) pp)
                                     \<mu>pp (rho (Suc (Suc r0)) pp)"
          and mup: "\<mu>pp \<in> SHOmsgVectors Ute_M (Suc r0) pp (rho (Suc r0))
                                          (HOs (Suc r0) pp) (SHOs (Suc r0) pp)"
          and nxtq: "nextState Ute_M (Suc r0) qq (rho (Suc r0) qq)
                                     \<mu>qq (rho (Suc (Suc r0)) qq)"
          and muq: "\<mu>qq \<in> SHOmsgVectors Ute_M (Suc r0) qq (rho (Suc r0))
                                          (HOs (Suc r0) qq) (SHOs (Suc r0) qq)"
        unfolding Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq by blast
      from commR this pwp qqw have "wp = w"
        by (auto dest: common_vote)
      with pwp show "vote ((rho (Suc (Suc r0))) pp) = Some w"
        by auto
    qed
    with that show ?thesis by auto
  qed

  from run obtain \<mu>p'
    where nxtp: "nextState Ute_M (Suc (Suc r0)) p (rho (Suc (Suc r0)) p)
                                 \<mu>p' (rho (Suc (Suc (Suc r0))) p)"
      and mup': "\<mu>p' \<in> SHOmsgVectors Ute_M (Suc (Suc r0)) p (rho (Suc (Suc r0)))
                                     (HOs (Suc (Suc r0)) p) (SHOs (Suc (Suc r0)) p)"
    by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)
  have "\<And>qq. qq \<in> SHOs (Suc (Suc r0)) p \<inter> HOs (Suc (Suc r0)) p
              \<Longrightarrow> \<mu>p' qq = Some (Vote (Some w))"
  proof -
    fix qq
    assume qqsho:"qq \<in> SHOs (Suc (Suc r0)) p \<inter> HOs (Suc (Suc r0)) p"
    from run obtain \<mu>qq where
      nxtqq:"nextState Ute_M (Suc r0) qq (rho (Suc r0) qq)
                             \<mu>qq (rho (Suc (Suc r0)) qq)"
      by (auto simp: Ute_SHOMachine_def SHORun_eq SHOnextConfig_eq)
    from commR mup' nxtqq votew qqsho show "\<mu>p' qq = Some (Vote (Some w))"
      by (auto dest: termination_argument_2)
  qed
  hence "SHOs (Suc (Suc r0)) p  \<inter> HOs (Suc (Suc r0)) p
           \<subseteq> {qq. \<mu>p' qq = Some (Vote (Some w))}"
    by auto
  hence wsho: "card (SHOs (Suc (Suc r0)) p  \<inter> HOs (Suc (Suc r0)) p)
                 \<le> card {qq. \<mu>p' qq = Some (Vote (Some w))}"
    by (auto simp: card_mono)

  from stp have "step (Suc (Suc r0)) = Suc 0"
    unfolding step_def by auto
  with nxtp have "next1 (Suc (Suc r0)) p (rho (Suc (Suc r0)) p) \<mu>p'
                        (rho (Suc (Suc (Suc r0))) p)"
    by (auto simp: Ute_SHOMachine_def nextState_def Ute_nextState_def)
  moreover
  from e have "E < card (SHOs (Suc (Suc r0)) p \<inter> HOs (Suc (Suc r0)) p)"
    by auto
  with wsho have majv:"card {qq. \<mu>p' qq = Some (Vote (Some w))} > E"
    by auto
  ultimately
  show ?thesis by (auto simp: next1_def)
qed

subsection {* \ute{} Solves Weak Consensus *}

text {*
  Summing up, all (coarse-grained) runs of \ute{} for
  HO and SHO collections that satisfy the communication predicate
  satisfy the Weak Consensus property.
*}

theorem ute_weak_consensus:
  assumes run: "SHORun Ute_M rho HOs SHOs"
      and commR: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
      and commG: "SHOcommGlobal Ute_M HOs SHOs"
  shows "weak_consensus (x \<circ> (rho 0)) decide rho"
  unfolding weak_consensus_def
  using ute_validity[OF run commR]
        ute_agreement[OF run commR]
        ute_termination[OF run commR commG]
  by auto

text {*
  By the reduction theorem, the correctness of the algorithm carries over
  to the fine-grained model of runs.
*}

theorem ute_weak_consensus_fg:
  assumes run: "fg_run Ute_M rho HOs SHOs (\<lambda>r q. undefined)"
      and commR: "\<forall>r. SHOcommPerRd Ute_M (HOs r) (SHOs r)"
      and commG: "SHOcommGlobal Ute_M HOs SHOs"
  shows "weak_consensus (\<lambda>p. x (state (rho 0) p)) decide (state \<circ> rho)"
    (is "weak_consensus ?inits _ _")
proof (rule local_property_reduction[OF run weak_consensus_is_local])
  fix crun
  assume crun: "CSHORun Ute_M crun HOs SHOs (\<lambda>r q. undefined)"
     and init: "crun 0 = state (rho 0)"
  from crun have "SHORun Ute_M crun HOs SHOs" by (unfold SHORun_def)
  from this commR commG
  have "weak_consensus (x \<circ> (crun 0)) decide crun"
    by (rule ute_weak_consensus)
  with init show "weak_consensus ?inits decide crun"
    by (simp add: o_def)
qed

end    -- {* context @{text "ute_parameters"} *}

end    (* theory UteProof *)