theory "Nominal-Utils"
imports "../Nominal2/Nominal2" "~~/src/HOL/Library/AList"
begin

subsubsection {* Lemmas helping with equivariance proofs *}

lemma perm_rel_lemma:
  assumes "\<And> \<pi> x y. r (\<pi> \<bullet> x) (\<pi> \<bullet> y) \<Longrightarrow> r x y"
  shows "r (\<pi> \<bullet> x) (\<pi> \<bullet> y) \<longleftrightarrow> r x y" (is "?l \<longleftrightarrow> ?r")
by (metis (full_types) assms permute_minus_cancel(2))

lemma perm_rel_lemma2:
  assumes "\<And> \<pi> x y. r x y \<Longrightarrow> r (\<pi> \<bullet> x) (\<pi> \<bullet> y)"
  shows "r x y \<longleftrightarrow> r (\<pi> \<bullet> x) (\<pi> \<bullet> y)" (is "?l \<longleftrightarrow> ?r")
by (metis (full_types) assms permute_minus_cancel(2))

lemma eqvt_at_apply:
  assumes "eqvt_at f x"
  shows "(p \<bullet> f) x = f x"
by (metis (hide_lams, no_types) assms eqvt_at_def permute_fun_def permute_minus_cancel(1))

lemma eqvt_at_apply':
  assumes "eqvt_at f x"
  shows "p \<bullet> f x = f (p \<bullet> x)"
by (metis (hide_lams, no_types) assms eqvt_at_def)

subsubsection {* Freshness via equivariance *}

lemma eqvt_fresh_cong1: "(\<And>p x. p \<bullet> (f x) = f (p \<bullet> x)) \<Longrightarrow> a \<sharp> x \<Longrightarrow> a \<sharp> f x "
  apply (rule fresh_fun_eqvt_app[of f])
  apply (rule eqvtI)
  apply (rule eq_reflection)
  apply (rule ext)
  apply (metis permute_fun_def permute_minus_cancel(1))
  apply assumption
  done

lemma eqvt_fresh_cong2:
  assumes eqvt: "(\<And>p x y. p \<bullet> (f x y) = f (p \<bullet> x) (p \<bullet> y))"
  and fresh1: "a \<sharp> x" and fresh2: "a \<sharp> y"
  shows "a \<sharp> f x y"
proof-
  have "eqvt (\<lambda> (x,y). f x y)"
    using eqvt
    apply -
    apply (auto simp add: eqvt_def)
    apply (rule ext)
    apply auto
    by (metis permute_minus_cancel(1))
  moreover
  have "a \<sharp> (x, y)" using fresh1 fresh2 by auto
  ultimately
  have "a \<sharp> (\<lambda> (x,y). f x y) (x, y)" by (rule fresh_fun_eqvt_app)
  thus ?thesis by simp
qed

lemma eqvt_fresh_star_cong1:
  assumes eqvt: "(\<And>p x. p \<bullet> (f x) = f (p \<bullet> x))"
  and fresh1: "a \<sharp>* x"
  shows "a \<sharp>* f x"
  by (metis fresh_star_def eqvt_fresh_cong1 assms)

lemma eqvt_fresh_star_cong2:
  assumes eqvt: "(\<And>p x y. p \<bullet> (f x y) = f (p \<bullet> x) (p \<bullet> y))"
  and fresh1: "a \<sharp>* x" and fresh2: "a \<sharp>* y"
  shows "a \<sharp>* f x y"
  by (metis fresh_star_def eqvt_fresh_cong2 assms)

lemma eqvt_fresh_cong3:
  assumes eqvt: "(\<And>p x y z. p \<bullet> (f x y z) = f (p \<bullet> x) (p \<bullet> y) (p \<bullet> z))"
  and fresh1: "a \<sharp> x" and fresh2: "a \<sharp> y" and fresh3: "a \<sharp> z"
  shows "a \<sharp> f x y z"
proof-
  have "eqvt (\<lambda> (x,y,z). f x y z)"
    using eqvt
    apply -
    apply (auto simp add: eqvt_def)
    apply (rule ext)
    apply auto
    by (metis permute_minus_cancel(1))
  moreover
  have "a \<sharp> (x, y, z)" using fresh1 fresh2 fresh3 by auto
  ultimately
  have "a \<sharp> (\<lambda> (x,y,z). f x y z) (x, y, z)" by (rule fresh_fun_eqvt_app)
  thus ?thesis by simp
qed

lemma eqvt_fresh_star_cong3:
  assumes eqvt: "(\<And>p x y z. p \<bullet> (f x y z) = f (p \<bullet> x) (p \<bullet> y) (p \<bullet> z))"
  and fresh1: "a \<sharp>* x" and fresh2: "a \<sharp>* y" and fresh3: "a \<sharp>* z"
  shows "a \<sharp>* f x y z"
  by (metis fresh_star_def eqvt_fresh_cong3 assms)

subsubsection {* Additional simplification rules *}

lemma not_self_fresh[simp]: "atom x \<sharp> x \<longleftrightarrow> False"
  by (metis fresh_at_base(2))

lemma fresh_star_singleton: "{ x } \<sharp>* e \<longleftrightarrow> x \<sharp> e"
  by (simp add: fresh_star_def)

subsubsection {* Additional equivariance lemmas *}

lemma range_eqvt: "\<pi> \<bullet> range Y = range (\<pi> \<bullet> Y)"
  unfolding image_eqvt UNIV_eqvt ..

lemma case_option_eqvt[eqvt]:
  "\<pi> \<bullet> case_option d f x = case_option (\<pi> \<bullet> d) (\<pi> \<bullet> f) (\<pi> \<bullet> x)"
  by(cases x)(simp_all)

lemma funpow_eqvt[simp,eqvt]:
  "\<pi> \<bullet> ((f :: 'a \<Rightarrow> 'a::pt) ^^ n) = (\<pi> \<bullet> f) ^^ (\<pi> \<bullet> n)"
 apply (induct n)
 apply simp
 apply (rule ext)
 apply simp
 apply perm_simp
 apply simp
 done

lemma delete_eqvt[eqvt]:
  "\<pi> \<bullet> AList.delete x \<Gamma> = AList.delete (\<pi> \<bullet> x) (\<pi> \<bullet> \<Gamma>)"
by (induct \<Gamma>, auto)

lemma dom_perm:
  "dom (\<pi> \<bullet> f) = \<pi> \<bullet> (dom f)"
  unfolding dom_def by (perm_simp) (simp)

lemmas dom_perm_rev[simp,eqvt] = dom_perm[symmetric]

lemma ran_perm[simp]:
  "\<pi> \<bullet> (ran f) = ran (\<pi> \<bullet> f)"
  unfolding ran_def by (perm_simp) (simp)

lemma map_add_eqvt[eqvt]:
  "\<pi> \<bullet> (m1 ++ m2) = (\<pi> \<bullet> m1) ++ (\<pi> \<bullet> m2)"
  unfolding map_add_def
  by (perm_simp, rule)

lemma map_of_eqvt[eqvt]:
  "\<pi> \<bullet> map_of l = map_of (\<pi> \<bullet> l)"
  apply (induct l)
  apply (simp add: permute_fun_def)
  apply simp
  apply perm_simp
  apply auto
  done

subsubsection {* Freshness lemmas *}

lemma fresh_list_elem:
  assumes "a \<sharp> \<Gamma>"
  and "e \<in> set \<Gamma>"
  shows "a \<sharp> e"
using assms
by(induct \<Gamma>)(auto simp add: fresh_Cons)

lemma set_not_fresh:
  "x \<in> set L \<Longrightarrow> \<not>(atom x \<sharp> L)"
  by (metis fresh_list_elem not_self_fresh)

lemma pure_fresh_star[simp]: "a \<sharp>* (x :: 'a :: pure)"
  by (simp add: fresh_star_def pure_fresh)

lemma supp_set_mem: "x \<in> set L \<Longrightarrow> supp x \<subseteq> supp L"
  by (induct L) (auto simp add: supp_Cons)

lemma set_supp_mono: "set L \<subseteq> set L2 \<Longrightarrow> supp L \<subseteq> supp L2"
  by (induct L)(auto simp add: supp_Cons supp_Nil dest:supp_set_mem)

subsubsection {* Freshness and support for subsets of variables *}

lemma supp_mono: "finite (B::'a::fs set) \<Longrightarrow> A \<subseteq> B \<Longrightarrow> supp A \<subseteq> supp B"
  by (metis infinite_super subset_Un_eq supp_of_finite_union)

lemma fresh_subset:
  "finite B \<Longrightarrow> x \<sharp> (B :: 'a::at_base set) \<Longrightarrow> A \<subseteq> B \<Longrightarrow> x \<sharp> A"
  by (auto dest:supp_mono simp add: fresh_def)

lemma fresh_star_subset:
  "finite B \<Longrightarrow> x \<sharp>* (B :: 'a::at_base set) \<Longrightarrow> A \<subseteq> B \<Longrightarrow> x \<sharp>* A"
  by (metis fresh_star_def fresh_subset)

lemma fresh_star_set_subset:
  "x \<sharp>* (B :: 'a::at_base list) \<Longrightarrow> set A \<subseteq> set B \<Longrightarrow> x \<sharp>* A"
  by (metis fresh_star_set fresh_star_subset[OF finite_set])

subsubsection {* The set of free variables of an expression *}

definition fv :: "'a::pt \<Rightarrow> 'b::at_base set" where "fv e = {v. atom v \<in> supp e}"

lemma fv_eqvt[simp,eqvt]: "\<pi> \<bullet> (fv e) = fv (\<pi> \<bullet> e)"
  unfolding fv_def by simp

lemma fv_Nil[simp]: "fv [] = {}"
  by (auto simp add: fv_def supp_Nil)
lemma fv_Cons[simp]: "fv (x # xs) = fv x \<union> fv xs"
  by (auto simp add: fv_def supp_Cons)
lemma fv_Pair[simp]: "fv (x, y) = fv x \<union> fv y"
  by (auto simp add: fv_def supp_Pair)
lemma fv_append[simp]: "fv (x @ y) = fv x \<union> fv y"
  by (auto simp add: fv_def supp_append)
lemma fv_at_base[simp]: "fv a = {a::'a::at_base}"
  by (auto simp add: fv_def supp_at_base)
lemma fv_pure[simp]: "fv (a::'a::pure) = {}"
  by (auto simp add: fv_def pure_supp)

subsubsection {* Other useful lemmas *}

lemma pure_permute_id: "permute p = (\<lambda> x. (x::'a::pure))"
  by rule (simp add: permute_pure)

lemma supp_set_elem_finite:
  assumes "finite S"
  and "(m::'a::fs) \<in> S"
  and "y \<in> supp m"
  shows "y \<in> supp S"
  using assms supp_of_finite_sets
  by auto

lemmas fresh_star_Cons = fresh_star_list(2)

end


(*  Author:  Florian Haftmann, TUM
*)

section \<open>Proof of concept for residue rings over int using type numerals\<close>

theory Residue_Ring
  imports Main "HOL-Library.Type_Length"
begin

class len2 = len0 +
  assumes len_ge_2 [iff]: "2 \<le> LENGTH('a)"
begin

subclass len
proof
  show "0 < LENGTH('a)" using len_ge_2
    by arith
qed

lemma len_not_eq_Suc_0 [simp]:
  "LENGTH('a) \<noteq> Suc 0"
  using len_ge_2 by arith

end

instance bit0 and bit1 :: (len) len2
  by standard (simp_all add: Suc_le_eq)

quotient_type (overloaded) 'a residue_ring = int / "\<lambda>k l. k mod int (LENGTH('a)) = l mod int (LENGTH('a::len2))"
  by (auto intro!: equivpI reflpI sympI transpI)

context semiring_1
begin

lift_definition repr :: "'b::len2 residue_ring \<Rightarrow> 'a"
  is "\<lambda>k. of_nat (nat (k mod int (LENGTH('b))))"
  by simp

end

instantiation residue_ring :: (len2) comm_ring_1
begin

lift_definition zero_residue_ring :: "'a residue_ring"
  is 0 .

lift_definition one_residue_ring :: "'a residue_ring"
  is 1 .

lift_definition plus_residue_ring :: "'a residue_ring \<Rightarrow> 'a residue_ring \<Rightarrow> 'a residue_ring"
  is plus
  by (fact mod_add_cong)

lift_definition uminus_residue_ring :: "'a residue_ring \<Rightarrow> 'a residue_ring"
  is uminus
  by (fact mod_minus_cong)

lift_definition minus_residue_ring :: "'a residue_ring \<Rightarrow> 'a residue_ring \<Rightarrow> 'a residue_ring"
  is minus
  by (fact mod_diff_cong)

lift_definition times_residue_ring :: "'a residue_ring \<Rightarrow> 'a residue_ring \<Rightarrow> 'a residue_ring"
  is times
  by (fact mod_mult_cong)

instance
  by (standard; transfer) (simp_all add: algebra_simps mod_eq_0_iff_dvd)

end

context
  includes lifting_syntax
begin

lemma [transfer_rule]:
  "((=) ===> pcr_residue_ring) numeral numeral"
  by (rule transfer_rule_numeral; transfer_prover)

lemma [transfer_rule]:
  "((=) ===> pcr_residue_ring) int of_nat"
  by (rule transfer_rule_of_nat; transfer_prover)

end

end


theory Submission
  imports Defs
begin

record p_state =
  p_pc :: "pc_label"
  p_x  :: "nat"
  p_y  :: "nat"

definition get_p_state where
  "get_p_state s p \<equiv> \<lparr>
  p_pc = pc s p, p_x = x s p, p_y = y s p\<rparr>"

lemma n_pos: "N \<ge> 1"
  using proc_0
  by (auto simp add: Proc_def)

lemma possible_states:
  assumes "reachable st"
    and "N > 1"
  shows "(\<forall>p. let ps = get_p_state st p in
     (\<exists>x y. ps = \<lparr>p_pc = assign_x, p_x = x, p_y = y\<rparr>)
  \<or> (\<exists>y. ps = \<lparr>p_pc = assign_y, p_x = 1, p_y = y\<rparr>)
  \<or> (\<exists>y. ps = \<lparr>p_pc = finished, p_x = 1, p_y = y\<rparr>))
      \<and> safe st"
  using \<open>reachable st\<close>
proof induct
  case (init init_x init_y)
  then show ?case
    using proc_0 by (auto simp add: Let_def get_p_state_def safe_def)
next
  case (x_step st i)
  then show ?case
    using proc_0 by (auto simp add: Let_def get_p_state_def safe_def update_x_def update_pc_def)
next
  case (y_step st i)
  show ?case
  proof (cases "\<forall>p. Proc p \<longrightarrow> p\<noteq>i \<longrightarrow> pc st p = finished")
    case True
      \<comment> \<open>If all others are finished, then we must have a 1 for y.\<close>
    hence "pc st (Suc i mod N) = finished"
      using `N > 1`
      by (metis Proc_def less_le_trans mod_Suc mod_less_divisor mod_mod_trivial mod_self n_not_Suc_n n_pos nat_neq_iff zero_less_one)

    hence h1: "x st (Suc i mod N) = 1"
      using y_step.hyps proc_0
      by (auto simp add: Let_def get_p_state_def safe_def update_x_def update_pc_def update_y_def)
        force+

    from `pc st i = assign_y`
    have "x st i = Suc 0"
      using y_step.hyps
      by (auto simp add: Let_def get_p_state_def)
        force

    show ?thesis
    proof (intro conjI allI)
      show "safe (update_y (update_pc st i finished) i (x st ((i + 1) mod N)))"
        by (auto simp add: safe_def update_y_def update_pc_def)
          (metis One_nat_def h1 safe_def y_step.hyps(2))

      show "let ps = get_p_state (update_y (update_pc st i finished) i (x st ((i + 1) mod N))) p
        in (\<exists>x y. ps = \<lparr>p_pc = assign_x, p_x = x, p_y = y\<rparr>) \<or>
           (\<exists>y. ps = \<lparr>p_pc = assign_y, p_x = 1, p_y = y\<rparr>) \<or> (\<exists>y. ps = \<lparr>p_pc = finished, p_x = 1, p_y = y\<rparr>)" for p
      proof (cases "p = i")
        case True
        then show ?thesis
          using n_pos True h1 by (auto simp add:  \<open>x st i = Suc 0\<close> Let_def get_p_state_def safe_def update_x_def update_pc_def update_y_def)
      next
        case False
        then show ?thesis
          using y_step.hyps
          by (auto simp add: get_p_state_def update_y_def update_pc_def)
      qed
    qed
  next
    case False
    from this obtain pu
      where "pc st pu \<noteq> finished" and "pu \<noteq> i" and "Proc pu"
      by blast

    show ?thesis
    proof (intro conjI allI)
      show "safe (update_y (update_pc st i finished) i (x st ((i + 1) mod N)))"
        using Proc_def \<open>Proc pu\<close> \<open>pc st pu \<noteq> finished\<close> \<open>pu \<noteq> i\<close>
        by (auto simp add: safe_def update_y_def update_pc_def Proc_def)

      show "let ps = get_p_state (update_y (update_pc st i finished) i (x st ((i + 1) mod N))) p
         in (\<exists>x y. ps = \<lparr>p_pc = assign_x, p_x = x, p_y = y\<rparr>) \<or>
            (\<exists>y. ps = \<lparr>p_pc = assign_y, p_x = 1, p_y = y\<rparr>) \<or> (\<exists>y. ps = \<lparr>p_pc = finished, p_x = 1, p_y = y\<rparr>)"
        for p
        using y_step.hyps False
        by (auto simp add: get_p_state_def update_y_def update_pc_def safe_def Proc_def)
          force+
    qed
  qed
qed

lemma possible_states_n1:
  assumes "reachable st"
    and "N = 1"
  shows "(let ps = get_p_state st 0 in
     (\<exists>x y. ps = \<lparr>p_pc = assign_x, p_x = x, p_y = y\<rparr>)
  \<or> (\<exists>y. ps = \<lparr>p_pc = assign_y, p_x = 1, p_y = y\<rparr>)
  \<or> (\<exists>y. ps = \<lparr>p_pc = finished, p_x = 1, p_y = y\<rparr>))
      \<and> safe st"
  using \<open>reachable st\<close>
proof induct
  case (init init_x init_y)
  then show ?case using proc_0 by (auto simp add: Let_def get_p_state_def safe_def)
next
  case (x_step st i)
  then show ?case using proc_0 by (auto simp add: Let_def get_p_state_def safe_def update_x_def update_pc_def)
next
  case (y_step st i)

  show ?case
  proof (cases "i=0")
    case True

    have "x st 0 = 1"
      by (metis One_nat_def True get_p_state_def p_state.iffs pc_label.distinct(1) y_step.hyps(2) y_step.hyps(3))

    show ?thesis
      using proc_0
      by (auto simp add: `N = 1` `i=0` `x st 0 = 1` Let_def get_p_state_def safe_def update_x_def update_pc_def update_y_def)
  next
    case False
    then show ?thesis
      using proc_0 y_step.hyps(2)
      by (auto simp add: `N = 1`   Let_def get_p_state_def safe_def update_x_def update_pc_def update_y_def)
  qed
qed

theorem reachable_safe :
  "safe st" if "reachable st"
proof (cases "N = 1")
  case True
  then show ?thesis
    by (simp add: possible_states_n1 that)
next
  case False
  then show ?thesis
    using n_pos possible_states that by auto
qed

end


theory
  Only_Fives
imports
  Main
begin

inductive only_fives :: \<open>nat list \<Rightarrow> bool\<close> where
  \<open>only_fives []\<close> |
  \<open>\<lbrakk>only_fives xs\<rbrakk> \<Longrightarrow> only_fives (xs @ [5])\<close>

theorem only_fives_concat:
  assumes \<open>only_fives xs\<close> and \<open>only_fives ys\<close>
  shows \<open>only_fives (xs @ ys)\<close>
using assms proof (induction ys rule: List.rev_induct)
  case Nil
  then show \<open>only_fives (xs @ [])\<close>
    by simp
next
  case (snoc y ys)
  hence \<open>only_fives ys\<close>
    using only_fives.cases by auto
  hence \<open>only_fives (xs @ ys)\<close>
    by (simp add: snoc.IH snoc.prems(1))
  moreover have \<open>y = 5\<close>
    using only_fives.cases snoc.prems(2) by blast
  ultimately show \<open>only_fives (xs @ ys @ [y])\<close>
    using only_fives.intros(2) by fastforce
qed

end


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

    Copyright (C) 2005, 2006  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>Groups 3\<close>

theory Group_ZF_3 imports Group_ZF_2 Finite1

begin

text\<open>In this theory we consider notions in group theory that are useful
  for the construction of real numbers in the \<open>Real_ZF_x\<close> series of
  theories.\<close>

subsection\<open>Group valued finite range functions\<close>

text\<open>In this section show that the group valued functions
  $f : X\rightarrow G$, with the property that $f(X)$ is
  a finite subset of $G$, is a group. Such functions play an important
  role in the construction of real numbers in the \<open>Real_ZF\<close> series.\<close>

text\<open>The following proves the essential condition to show that the set of
  finite range functions is
  closed with respect to the lifted group operation.\<close>

lemma (in group0) Group_ZF_3_1_L1:
  assumes A1: "F = P {lifted to function space over} X"
  and
  A2: "s \<in> FinRangeFunctions(X,G)"  "r \<in>  FinRangeFunctions(X,G)"
  shows "F`\<langle> s,r\<rangle> \<in> FinRangeFunctions(X,G)"
proof -
  let ?q = "F`\<langle> s,r\<rangle>"
  from A2 have T1:"s:X\<rightarrow>G" "r:X\<rightarrow>G"
    using FinRangeFunctions_def by auto
  with A1 have T2:"?q : X\<rightarrow>G"
    using group0_2_L1 monoid0.Group_ZF_2_1_L0
    by simp
  moreover have "?q``(X) \<in> Fin(G)"
  proof -
    from A2 have
      "{s`(x). x\<in>X} \<in> Fin(G)"
      "{r`(x). x\<in>X} \<in> Fin(G)"
      using Finite1_L18 by auto
    with A1 T1 T2 show ?thesis using
      group_oper_fun Finite1_L15 Group_ZF_2_1_L3 func_imagedef
      by simp
  qed
  ultimately show ?thesis using FinRangeFunctions_def
    by simp
qed

text\<open>The set of group valued finite range functions is closed with respect
  to the lifted group operation.\<close>

lemma (in group0) Group_ZF_3_1_L2:
  assumes A1: "F = P {lifted to function space over} X"
  shows "FinRangeFunctions(X,G) {is closed under} F"
proof -
  let ?A = "FinRangeFunctions(X,G)"
  from A1 have "\<forall>x\<in>?A. \<forall>y\<in>?A. F`\<langle> x,y\<rangle> \<in> ?A"
    using Group_ZF_3_1_L1 by simp
  then show ?thesis using IsOpClosed_def by simp
qed

text\<open>A composition of a finite range function with the group inverse is
  a finite range function.\<close>

lemma (in group0) Group_ZF_3_1_L3:
  assumes A1: "s \<in> FinRangeFunctions(X,G)"
  shows "GroupInv(G,P) O s \<in> FinRangeFunctions(X,G)"
  using groupAssum assms group0_2_T2 Finite1_L20 by simp

text\<open>The set of finite range functions is s subgroup of the lifted group.\<close>

theorem Group_ZF_3_1_T1:
  assumes A1: "IsAgroup(G,P)"
  and A2: "F = P {lifted to function space over} X"
  and A3: "X\<noteq>0"
  shows "IsAsubgroup(FinRangeFunctions(X,G),F)"
proof -
  let ?e = "TheNeutralElement(G,P)"
  let ?S = "FinRangeFunctions(X,G)"
  from A1 have T1: "group0(G,P)" using group0_def
    by simp
  with A1 A2 have T2:"group0(X\<rightarrow>G,F)"
    using group0.Group_ZF_2_1_T2 group0_def
    by simp
  moreover have "?S \<noteq> 0"
  proof -
    from T1 A3 have
      "ConstantFunction(X,?e) \<in> ?S"
      using group0.group0_2_L1 monoid0.unit_is_neutral
	Finite1_L17 by simp
    thus ?thesis by auto
  qed
  moreover have "?S \<subseteq> X\<rightarrow>G"
    using FinRangeFunctions_def by auto
  moreover from A2 T1 have
    "?S {is closed under} F"
    using group0.Group_ZF_3_1_L2
    by simp
  moreover from A1 A2 T1 have
    "\<forall>s \<in> ?S. GroupInv(X\<rightarrow>G,F)`(s) \<in> ?S"
    using FinRangeFunctions_def group0.Group_ZF_2_1_L6
      group0.Group_ZF_3_1_L3 by simp
  ultimately show ?thesis
    using group0.group0_3_T3 by simp
qed

subsection\<open>Almost homomorphisms\<close>

text\<open>An almost homomorphism is a group valued function
  defined on a monoid $M$
  with the property that the set $\{ f(m+n)-f(m)-f(n)\}_{m,n \in M}$ is finite.
  This term is used by R. D. Arthan in "The Eudoxus Real Numbers". We use this
  term in the general group context and use the A`Campo's term "slopes"
  (see his "A natural construction for the real numbers") to mean
  an almost homomorphism mapping interegers into themselves.
  We consider almost homomorphisms because we use slopes to
  define real numbers in the \<open>Real_ZF_x\<close> series.\<close>

text\<open>HomDiff is an acronym for "homomorphism difference".
  This is the expression
  $s(mn)(s(m)s(n))^{-1}$, or $s(m+n)-s(m)-s(n)$ in the additive notation.
  It is equal to the neutral element of the group if $s$ is a homomorphism.
\<close>

definition
  "HomDiff(G,f,s,x) \<equiv>
  f`\<langle>s`(f`\<langle> fst(x),snd(x)\<rangle>) ,
  (GroupInv(G,f)`(f`\<langle> s`(fst(x)),s`(snd(x))\<rangle>))\<rangle>"

text\<open>Almost homomorphisms are defined as those maps
  $s:G\rightarrow G$ such that the
  homomorphism difference takes only finite number of values on $G\times G$.
\<close>

definition
  "AlmostHoms(G,f) \<equiv>
  {s \<in> G\<rightarrow>G.{HomDiff(G,f,s,x). x \<in> G\<times>G } \<in> Fin(G)}"

text\<open>AlHomOp1$(G,f)$ is the group operation on almost
  homomorphisms defined in a natural way
  by $(s\cdot r)(n) = s(n)\cdot r(n)$. In the terminology defined in
  func1.thy this is the group operation $f$ (on $G$)
  lifted to the function space $G\rightarrow G$ and restricted to the set
  AlmostHoms$(G,f)$.\<close>

definition
  "AlHomOp1(G,f) \<equiv>
  restrict(f {lifted to function space over} G,
  AlmostHoms(G,f)\<times>AlmostHoms(G,f))"

text\<open>We also define a composition (binary) operator on almost homomorphisms in
  a natural way. We call that operator \<open>AlHomOp2\<close> - the second operation
  on almost homomorphisms. Composition of almost homomorphisms is
  used to define multiplication of real numbers in \<open>Real_ZF\<close> series.
\<close>

definition
  "AlHomOp2(G,f) \<equiv>
  restrict(Composition(G),AlmostHoms(G,f)\<times>AlmostHoms(G,f))"

text\<open>This lemma provides more readable notation for the HomDiff
  definition. Not really intended to be used in proofs, but just to see the
  definition in the notation defined in the group0 locale.\<close>

lemma (in group0) HomDiff_notation:
  shows "HomDiff(G,P,s,\<langle> m,n\<rangle>) = s`(m\<cdot>n)\<cdot>(s`(m)\<cdot>s`(n))\<inverse>"
  using HomDiff_def by simp

text\<open>The next lemma shows the set from the definition of almost
  homomorphism in a different form.\<close>

lemma (in group0) Group_ZF_3_2_L1A: shows
  "{HomDiff(G,P,s,x). x \<in> G\<times>G } = {s`(m\<cdot>n)\<cdot>(s`(m)\<cdot>s`(n))\<inverse>. \<langle> m,n\<rangle> \<in> G\<times>G}"
proof -
  have "\<forall>m\<in>G.\<forall>n\<in>G. HomDiff(G,P,s,\<langle> m,n\<rangle>) = s`(m\<cdot>n)\<cdot>(s`(m)\<cdot>s`(n))\<inverse>"
    using HomDiff_notation by simp
  then show ?thesis by (rule ZF1_1_L4A)
qed

text\<open>Let's define some notation. We inherit the notation and assumptions
  from the group0 context (locale)
  and add some. We will use AH to denote the set of almost homomorphisms.
  $\sim$ is the inverse (negative if the group is the group of integers) of
  almost homomorphisms, $(\sim p)(n)= p(n)^{-1}$.
  $\delta $ will denote the homomorphism difference specific
  for the group (HomDiff$(G,f)$). The notation $s \approx r$ will mean that
  $s,r$ are almost equal, that is they are in the equivalence relation
  defined by the group of finite range
  functions (that is a normal subgroup of almost homomorphisms,
  if the group is abelian). We show that
  this is equivalent to the set $\{ s(n)\cdot r(n)^{-1}: n\in G\}$ being
  finite.
  We also add an assumption that the
  $G$ is abelian as many needed properties do not hold without that.\<close>

locale group1 = group0 +
  assumes isAbelian: "P {is commutative on} G"

  fixes AH
  defines AH_def [simp]: "AH \<equiv> AlmostHoms(G,P)"

  fixes Op1
  defines Op1_def [simp]: "Op1 \<equiv> AlHomOp1(G,P)"

  fixes Op2
  defines Op2_def [simp]: "Op2 \<equiv> AlHomOp2(G,P)"

  fixes FR
  defines FR_def [simp]: "FR \<equiv> FinRangeFunctions(G,G)"

  fixes neg ("\<sim>_" [90] 91)
  defines neg_def [simp]: "\<sim>s \<equiv> GroupInv(G,P) O s"

  fixes \<delta>
  defines \<delta>_def [simp]: "\<delta>(s,x) \<equiv> HomDiff(G,P,s,x)"

  fixes AHprod (infix "\<bullet>" 69)
  defines AHprod_def [simp]: "s \<bullet> r \<equiv>  AlHomOp1(G,P)`\<langle>s,r\<rangle>"

  fixes AHcomp (infix "\<circ>" 70)
  defines AHcomp_def [simp]: "s \<circ> r \<equiv>  AlHomOp2(G,P)`\<langle>s,r\<rangle>"

  fixes AlEq (infix "\<approx>" 68)
  defines AlEq_def [simp]:
  "s \<approx> r \<equiv> \<langle>s,r\<rangle> \<in> QuotientGroupRel(AH,Op1,FR)"

text\<open>HomDiff is a homomorphism on the lifted group structure.\<close>

lemma (in group1) Group_ZF_3_2_L1:
  assumes A1: "s:G\<rightarrow>G"  "r:G\<rightarrow>G"
  and A2: "x \<in> G\<times>G"
  and A3: "F = P {lifted to function space over} G"
  shows "\<delta>(F`\<langle> s,r\<rangle>,x) = \<delta>(s,x)\<cdot>\<delta>(r,x)"
proof -
  let ?p = "F`\<langle> s,r\<rangle>"
  from A2 obtain m n where
    D1: "x = \<langle> m,n\<rangle>" "m\<in>G" "n\<in>G"
    by auto
  then have T1:"m\<cdot>n \<in> G"
    using group0_2_L1 monoid0.group0_1_L1 by simp
  with A1 D1 have T2:
    "s`(m)\<in>G" "s`(n)\<in>G" "r`(m)\<in>G"
    "r`(n)\<in>G" "s`(m\<cdot>n)\<in>G" "r`(m\<cdot>n)\<in>G"
    using apply_funtype by auto
  from A3 A1 have T3:"?p : G\<rightarrow>G"
    using group0_2_L1 monoid0.Group_ZF_2_1_L0
    by simp
  from D1 T3 have
    "\<delta>(?p,x) = ?p`(m\<cdot>n)\<cdot>((?p`(n))\<inverse>\<cdot>(?p`(m))\<inverse>)"
    using HomDiff_notation apply_funtype group_inv_of_two
    by simp
  also from A3 A1 D1 T1 isAbelian T2 have
    "\<dots> = \<delta>(s,x)\<cdot> \<delta>(r,x)"
    using Group_ZF_2_1_L3 group0_4_L3 HomDiff_notation
    by simp
  finally show ?thesis by simp
qed

text\<open>The group operation lifted to the function space over $G$ preserves
  almost homomorphisms.\<close>

lemma (in group1) Group_ZF_3_2_L2: assumes A1: "s \<in> AH" "r \<in> AH"
  and A2: "F = P {lifted to function space over} G"
  shows "F`\<langle> s,r\<rangle> \<in> AH"
proof -
  let ?p = "F`\<langle> s,r\<rangle>"
  from A1 A2 have "?p : G\<rightarrow>G"
    using AlmostHoms_def group0_2_L1 monoid0.Group_ZF_2_1_L0
    by simp
  moreover have
    "{\<delta>(?p,x). x \<in> G\<times>G} \<in> Fin(G)"
  proof -
    from A1 have
      "{\<delta>(s,x). x \<in> G\<times>G } \<in> Fin(G)"
      "{\<delta>(r,x). x \<in> G\<times>G } \<in> Fin(G)"
      using AlmostHoms_def by auto
    with groupAssum A1 A2 show ?thesis
      using IsAgroup_def IsAmonoid_def IsAssociative_def
      Finite1_L15 AlmostHoms_def Group_ZF_3_2_L1
      by auto
  qed
  ultimately show ?thesis using AlmostHoms_def
    by simp
qed

text\<open>The set of almost homomorphisms is closed under the
  lifted group operation.\<close>

lemma (in group1) Group_ZF_3_2_L3:
  assumes "F = P {lifted to function space over} G"
  shows "AH {is closed under} F"
  using assms IsOpClosed_def Group_ZF_3_2_L2 by simp

text\<open>The terms in the homomorphism difference for a function
  are in the group.\<close>

lemma (in group1) Group_ZF_3_2_L4:
  assumes "s:G\<rightarrow>G" and "m\<in>G"  "n\<in>G"
  shows
  "m\<cdot>n \<in> G"
  "s`(m\<cdot>n) \<in> G"
  "s`(m) \<in> G" "s`(n) \<in> G"
  "\<delta>(s,\<langle> m,n\<rangle>) \<in> G"
  "s`(m)\<cdot>s`(n) \<in> G"
  using assms group_op_closed inverse_in_group
    apply_funtype HomDiff_def by auto

text\<open>It is handy to have a version of \<open> Group_ZF_3_2_L4\<close>
  specifically for almost homomorphisms.\<close>

corollary (in group1) Group_ZF_3_2_L4A:
  assumes "s \<in> AH" and "m\<in>G"  "n\<in>G"
  shows "m\<cdot>n \<in> G"
  "s`(m\<cdot>n) \<in> G"
  "s`(m) \<in> G" "s`(n) \<in> G"
  "\<delta>(s,\<langle> m,n\<rangle>) \<in> G"
  "s`(m)\<cdot>s`(n) \<in> G"
  using assms AlmostHoms_def Group_ZF_3_2_L4
  by auto

text\<open>The terms in the homomorphism difference are in the group,
  a different form.\<close>

lemma (in group1) Group_ZF_3_2_L4B:
  assumes A1:"s \<in> AH" and A2:"x\<in>G\<times>G"
  shows "fst(x)\<cdot>snd(x) \<in> G"
  "s`(fst(x)\<cdot>snd(x)) \<in> G"
  "s`(fst(x)) \<in> G" "s`(snd(x)) \<in> G"
  "\<delta>(s,x) \<in> G"
  "s`(fst(x))\<cdot>s`(snd(x)) \<in> G"
proof -
  let ?m = "fst(x)"
  let ?n = "snd(x)"
  from A1 A2 show
    "?m\<cdot>?n \<in> G"  "s`(?m\<cdot>?n) \<in> G"
    "s`(?m) \<in> G" "s`(?n) \<in> G"
    "s`(?m)\<cdot>s`(?n) \<in> G"
    using Group_ZF_3_2_L4A
    by auto
  from A1 A2 have "\<delta>(s,\<langle> ?m,?n\<rangle>) \<in> G" using Group_ZF_3_2_L4A
    by simp
  moreover from A2 have "\<langle> ?m,?n\<rangle> = x" by auto
  ultimately show "\<delta>(s,x) \<in> G" by simp
qed

text\<open>What are the values of the inverse of an almost homomorphism?\<close>

lemma (in group1) Group_ZF_3_2_L5:
  assumes "s \<in> AH" and "n\<in>G"
  shows "(\<sim>s)`(n) = (s`(n))\<inverse>"
  using assms AlmostHoms_def comp_fun_apply by auto

text\<open>Homomorphism difference commutes with the inverse for almost
  homomorphisms.\<close>

lemma (in group1) Group_ZF_3_2_L6:
  assumes A1:"s \<in> AH" and A2:"x\<in>G\<times>G"
  shows "\<delta>(\<sim>s,x) = (\<delta>(s,x))\<inverse>"
proof -
  let ?m = "fst(x)"
  let ?n = "snd(x)"
  have "\<delta>(\<sim>s,x) = (\<sim>s)`(?m\<cdot>?n)\<cdot>((\<sim>s)`(?m)\<cdot>(\<sim>s)`(?n))\<inverse>"
    using HomDiff_def by simp
  from A1 A2 isAbelian show ?thesis
    using Group_ZF_3_2_L4B HomDiff_def
      Group_ZF_3_2_L5 group0_4_L4A
    by simp
qed

text\<open>The inverse of an almost homomorphism  maps the group into itself.\<close>

lemma (in group1) Group_ZF_3_2_L7:
  assumes "s \<in> AH"
  shows "\<sim>s : G\<rightarrow>G"
  using groupAssum assms AlmostHoms_def group0_2_T2 comp_fun by auto

text\<open>The inverse of an almost homomorphism is an almost homomorphism.\<close>

lemma (in group1) Group_ZF_3_2_L8:
  assumes A1: "F = P {lifted to function space over} G"
  and A2: "s \<in> AH"
  shows "GroupInv(G\<rightarrow>G,F)`(s) \<in> AH"
proof -
  from A2 have "{\<delta>(s,x). x \<in> G\<times>G} \<in> Fin(G)"
    using AlmostHoms_def by simp
  with groupAssum  have
    "GroupInv(G,P)``{\<delta>(s,x). x \<in> G\<times>G} \<in> Fin(G)"
    using group0_2_T2 Finite1_L6A by blast
  moreover have
     "GroupInv(G,P)``{\<delta>(s,x). x \<in> G\<times>G} =
    {(\<delta>(s,x))\<inverse>. x \<in> G\<times>G}"
  proof -
    from groupAssum have
      "GroupInv(G,P) : G\<rightarrow>G"
      using group0_2_T2 by simp
    moreover from A2 have
      "\<forall>x\<in>G\<times>G. \<delta>(s,x)\<in>G"
      using Group_ZF_3_2_L4B by simp
    ultimately show ?thesis
      using func1_1_L17 by simp
  qed
  ultimately have "{(\<delta>(s,x))\<inverse>. x \<in> G\<times>G} \<in> Fin(G)"
    by simp
  moreover from A2 have
    "{(\<delta>(s,x))\<inverse>. x \<in> G\<times>G} = {\<delta>(\<sim>s,x). x \<in> G\<times>G}"
    using Group_ZF_3_2_L6 by simp
  ultimately have "{\<delta>(\<sim>s,x). x \<in> G\<times>G} \<in> Fin(G)"
    by simp
  with A2 groupAssum A1 show ?thesis
    using Group_ZF_3_2_L7 AlmostHoms_def Group_ZF_2_1_L6
    by simp
qed

text\<open>The function that assigns the neutral element everywhere
  is an almost homomorphism.\<close>

lemma (in group1) Group_ZF_3_2_L9: shows
  "ConstantFunction(G,\<one>) \<in> AH" and "AH\<noteq>0"
proof -
  let ?z = "ConstantFunction(G,\<one>)"
  have "G\<times>G\<noteq>0" using group0_2_L1 monoid0.group0_1_L3A
    by blast
  moreover have "\<forall>x\<in>G\<times>G. \<delta>(?z,x) = \<one>"
  proof
    fix x assume A1:"x \<in> G \<times> G"
    then obtain m n where "x = \<langle> m,n\<rangle>" "m\<in>G" "n\<in>G"
      by auto
    then show "\<delta>(?z,x) = \<one>"
      using group0_2_L1 monoid0.group0_1_L1
	func1_3_L2 HomDiff_def group0_2_L2
	group_inv_of_one by simp
  qed
  ultimately have "{\<delta>(?z,x). x\<in>G\<times>G} = {\<one>}" by (rule ZF1_1_L5)
  then show "?z \<in> AH" using group0_2_L2 Finite1_L16
    func1_3_L1 group0_2_L2 AlmostHoms_def by simp
  then show "AH\<noteq>0" by auto
qed

text\<open>If the group is abelian, then almost homomorphisms form a
  subgroup of the lifted group.\<close>

lemma Group_ZF_3_2_L10:
  assumes A1: "IsAgroup(G,P)"
  and A2: "P {is commutative on} G"
  and A3: "F = P {lifted to function space over} G"
  shows "IsAsubgroup(AlmostHoms(G,P),F)"
proof -
  let ?AH = "AlmostHoms(G,P)"
  from A2 A1 have T1: "group1(G,P)"
    using group1_axioms.intro group0_def group1_def
    by simp
  from A1 A3 have "group0(G\<rightarrow>G,F)"
    using group0_def group0.Group_ZF_2_1_T2 by simp
  moreover from T1 have "?AH\<noteq>0"
    using group1.Group_ZF_3_2_L9 by simp
  moreover have T2:"?AH \<subseteq> G\<rightarrow>G"
    using AlmostHoms_def by auto
  moreover from T1 A3 have
    "?AH {is closed under} F"
    using group1.Group_ZF_3_2_L3 by simp
  moreover from T1 A3 have
    "\<forall>s\<in>?AH. GroupInv(G\<rightarrow>G,F)`(s) \<in> ?AH"
    using group1.Group_ZF_3_2_L8 by simp
  ultimately show "IsAsubgroup(AlmostHoms(G,P),F)"
    using group0.group0_3_T3 by simp
qed

text\<open>If the group is abelian, then almost homomorphisms form a group
  with the first operation, hence we can use theorems proven in group0
  context aplied to this group.\<close>

lemma (in group1) Group_ZF_3_2_L10A:
  shows "IsAgroup(AH,Op1)" "group0(AH,Op1)"
    using groupAssum isAbelian Group_ZF_3_2_L10 IsAsubgroup_def
      AlHomOp1_def group0_def by auto

text\<open>The group of almost homomorphisms is abelian\<close>

lemma Group_ZF_3_2_L11: assumes A1: "IsAgroup(G,f)"
  and A2: "f {is commutative on} G"
  shows
  "IsAgroup(AlmostHoms(G,f),AlHomOp1(G,f))"
  "AlHomOp1(G,f) {is commutative on} AlmostHoms(G,f)"
proof-
  let ?AH = "AlmostHoms(G,f)"
  let ?F = "f {lifted to function space over} G"
  from A1 A2 have "IsAsubgroup(?AH,?F)"
    using Group_ZF_3_2_L10 by simp
  then show "IsAgroup(?AH,AlHomOp1(G,f))"
    using IsAsubgroup_def AlHomOp1_def by simp
  from A1 have "?F : (G\<rightarrow>G)\<times>(G\<rightarrow>G)\<rightarrow>(G\<rightarrow>G)"
    using IsAgroup_def monoid0_def monoid0.Group_ZF_2_1_L0A
    by simp
  moreover have "?AH \<subseteq> G\<rightarrow>G"
    using AlmostHoms_def by auto
  moreover from A1 A2 have
    "?F {is commutative on} (G\<rightarrow>G)"
    using group0_def group0.Group_ZF_2_1_L7
    by simp
  ultimately show
    "AlHomOp1(G,f){is commutative on} ?AH"
    using func_ZF_4_L1 AlHomOp1_def by simp
qed

text\<open>The first operation on homomorphisms acts in a natural way on its
  operands.\<close>

lemma (in group1) Group_ZF_3_2_L12:
  assumes "s\<in>AH"  "r\<in>AH" and "n\<in>G"
  shows "(s\<bullet>r)`(n) = s`(n)\<cdot>r`(n)"
  using assms AlHomOp1_def restrict AlmostHoms_def Group_ZF_2_1_L3
  by simp

text\<open>What is the group inverse in the group of almost homomorphisms?\<close>

lemma (in group1) Group_ZF_3_2_L13:
  assumes A1: "s\<in>AH"
  shows
  "GroupInv(AH,Op1)`(s) = GroupInv(G,P) O s"
  "GroupInv(AH,Op1)`(s) \<in> AH"
  "GroupInv(G,P) O s \<in> AH"
proof -
  let ?F = "P {lifted to function space over} G"
  from groupAssum isAbelian have "IsAsubgroup(AH,?F)"
    using Group_ZF_3_2_L10 by simp
  with A1 show I: "GroupInv(AH,Op1)`(s) = GroupInv(G,P) O s"
    using AlHomOp1_def Group_ZF_2_1_L6A by simp
  from A1 show "GroupInv(AH,Op1)`(s) \<in> AH"
    using Group_ZF_3_2_L10A group0.inverse_in_group by simp
  with I show "GroupInv(G,P) O s \<in> AH" by simp
qed

text\<open>The group inverse in the group of almost homomorphisms acts in a
  natural way on its operand.\<close>

lemma (in group1) Group_ZF_3_2_L14:
  assumes "s\<in>AH" and "n\<in>G"
  shows "(GroupInv(AH,Op1)`(s))`(n) = (s`(n))\<inverse>"
  using isAbelian assms Group_ZF_3_2_L13 AlmostHoms_def comp_fun_apply
  by auto

text\<open>The next lemma states that if $s,r$ are almost homomorphisms, then
  $s\cdot r^{-1}$ is also an almost homomorphism.\<close>

lemma Group_ZF_3_2_L15: assumes "IsAgroup(G,f)"
  and "f {is commutative on} G"
  and "AH = AlmostHoms(G,f)" "Op1 = AlHomOp1(G,f)"
  and "s \<in> AH"  "r \<in> AH"
  shows
  "Op1`\<langle> s,r\<rangle> \<in> AH"
  "GroupInv(AH,Op1)`(r) \<in> AH"
  "Op1`\<langle> s,GroupInv(AH,Op1)`(r)\<rangle> \<in> AH"
  using assms group0_def group1_axioms.intro group1_def
      group1.Group_ZF_3_2_L10A group0.group0_2_L1
      monoid0.group0_1_L1 group0.inverse_in_group by auto

text\<open>A version of \<open>Group_ZF_3_2_L15\<close> formulated in notation
  used in \<open>group1\<close> context. States that the product of almost
  homomorphisms is an almost homomorphism and the the product
  of an almost homomorphism with a (pointwise) inverse of an almost
  homomorphism is an almost homomorphism.\<close>

corollary (in group1) Group_ZF_3_2_L16: assumes "s \<in> AH"  "r \<in> AH"
  shows "s\<bullet>r \<in> AH"  "s\<bullet>(\<sim>r) \<in> AH"
  using assms isAbelian group0_def group1_axioms group1_def
  Group_ZF_3_2_L15 Group_ZF_3_2_L13 by auto

subsection\<open>The classes of almost homomorphisms\<close>

text\<open>In the \<open>Real_ZF\<close> series we define real numbers as a quotient
  of the group of integer almost homomorphisms by the integer finite range
  functions. In this section we setup the background for that in the general
  group context.\<close>

text\<open>Finite range functions are almost homomorphisms.\<close>

lemma (in group1) Group_ZF_3_3_L1: shows "FR \<subseteq> AH"
proof
  fix s assume A1:"s \<in> FR"
  then have T1:"{s`(n). n \<in> G} \<in> Fin(G)"
    "{s`(fst(x)). x\<in>G\<times>G} \<in> Fin(G)"
    "{s`(snd(x)). x\<in>G\<times>G} \<in> Fin(G)"
    using Finite1_L18 Finite1_L6B by auto
  have "{s`(fst(x)\<cdot>snd(x)). x \<in> G\<times>G} \<in> Fin(G)"
  proof -
    have "\<forall>x\<in>G\<times>G. fst(x)\<cdot>snd(x) \<in> G"
      using group0_2_L1 monoid0.group0_1_L1 by simp
    moreover from T1 have "{s`(n). n \<in> G} \<in> Fin(G)" by simp
    ultimately show ?thesis by (rule Finite1_L6B)
  qed
  moreover have
    "{(s`(fst(x))\<cdot>s`(snd(x)))\<inverse>. x\<in>G\<times>G} \<in> Fin(G)"
  proof -
    have "\<forall>g\<in>G. g\<inverse> \<in> G" using inverse_in_group
      by simp
    moreover from T1 have
      "{s`(fst(x))\<cdot>s`(snd(x)). x\<in>G\<times>G} \<in> Fin(G)"
      using group_oper_fun  Finite1_L15 by simp
    ultimately show ?thesis
      by (rule Finite1_L6C)
  qed
  ultimately have "{\<delta>(s,x). x\<in>G\<times>G} \<in> Fin(G)"
    using HomDiff_def Finite1_L15  group_oper_fun
    by simp
  with A1 show "s \<in> AH"
    using FinRangeFunctions_def AlmostHoms_def
    by simp
qed

text\<open>Finite range functions valued in an abelian group form a normal
  subgroup of almost homomorphisms.\<close>

lemma Group_ZF_3_3_L2: assumes A1:"IsAgroup(G,f)"
  and A2:"f {is commutative on} G"
  shows
  "IsAsubgroup(FinRangeFunctions(G,G),AlHomOp1(G,f))"
  "IsAnormalSubgroup(AlmostHoms(G,f),AlHomOp1(G,f),
  FinRangeFunctions(G,G))"
proof -
  let ?H1 = "AlmostHoms(G,f)"
  let ?H2 = "FinRangeFunctions(G,G)"
  let ?F = "f {lifted to function space over} G"
  from A1 A2 have T1:"group0(G,f)"
    "monoid0(G,f)" "group1(G,f)"
    using group0_def group0.group0_2_L1
      group1_axioms.intro group1_def
    by auto
  with A1 A2 have "IsAgroup(G\<rightarrow>G,?F)"
    "IsAsubgroup(?H1,?F)" "IsAsubgroup(?H2,?F)"
    using group0.Group_ZF_2_1_T2 Group_ZF_3_2_L10
      monoid0.group0_1_L3A Group_ZF_3_1_T1
    by auto
  then have
    "IsAsubgroup(?H1\<inter>?H2,restrict(?F,?H1\<times>?H1))"
    using group0_3_L7 by simp
  moreover from T1 have "?H1\<inter>?H2 = ?H2"
    using group1.Group_ZF_3_3_L1 by auto
  ultimately show "IsAsubgroup(?H2,AlHomOp1(G,f))"
    using AlHomOp1_def by simp
  with A1 A2 show "IsAnormalSubgroup(AlmostHoms(G,f),AlHomOp1(G,f),
    FinRangeFunctions(G,G))"
    using Group_ZF_3_2_L11 Group_ZF_2_4_L6
    by simp
qed

text\<open>The group of almost homomorphisms divided by the subgroup of finite
  range functions is an abelian group.\<close>

theorem (in group1) Group_ZF_3_3_T1:
  shows
  "IsAgroup(AH//QuotientGroupRel(AH,Op1,FR),QuotientGroupOp(AH,Op1,FR))"
  and
  "QuotientGroupOp(AH,Op1,FR) {is commutative on}
  (AH//QuotientGroupRel(AH,Op1,FR))"
  using groupAssum isAbelian Group_ZF_3_3_L2 Group_ZF_3_2_L10A
    Group_ZF_2_4_T1 Group_ZF_3_2_L10A Group_ZF_3_2_L11
    Group_ZF_3_3_L2 IsAnormalSubgroup_def Group_ZF_2_4_L6 by auto

text\<open>It is useful to have a direct statement that the
  quotient group relation is an equivalence relation for the group of AH and
  subgroup FR.\<close>

lemma (in group1) Group_ZF_3_3_L3: shows
  "QuotientGroupRel(AH,Op1,FR) \<subseteq> AH \<times> AH" and
  "equiv(AH,QuotientGroupRel(AH,Op1,FR))"
  using groupAssum isAbelian QuotientGroupRel_def
    Group_ZF_3_3_L2 Group_ZF_3_2_L10A group0.Group_ZF_2_4_L3
  by auto

text\<open>The "almost equal" relation is symmetric.\<close>

lemma (in group1) Group_ZF_3_3_L3A: assumes A1: "s\<approx>r"
  shows "r\<approx>s"
proof -
  let ?R = "QuotientGroupRel(AH,Op1,FR)"
  from A1 have "equiv(AH,?R)" and "\<langle>s,r\<rangle> \<in> ?R"
    using Group_ZF_3_3_L3 by auto
  then have "\<langle>r,s\<rangle> \<in> ?R" by (rule equiv_is_sym)
  then show "r\<approx>s" by simp
qed

text\<open>Although we have bypassed this fact when proving that
  group of almost homomorphisms divided by the subgroup of finite
  range functions is a group, it is still useful to know directly
  that the first group operation on AH is congruent with respect to the
  quotient group relation.\<close>

lemma (in group1) Group_ZF_3_3_L4:
  shows "Congruent2(QuotientGroupRel(AH,Op1,FR),Op1)"
  using groupAssum isAbelian Group_ZF_3_2_L10A Group_ZF_3_3_L2
    Group_ZF_2_4_L5A by simp

text\<open>The class of an almost homomorphism $s$ is the neutral element
  of the quotient group of almost homomorphisms iff $s$ is a finite range
  function.\<close>

lemma (in group1) Group_ZF_3_3_L5: assumes "s \<in> AH" and
  "r = QuotientGroupRel(AH,Op1,FR)" and
  "TheNeutralElement(AH//r,QuotientGroupOp(AH,Op1,FR)) = e"
  shows "r``{s} = e \<longleftrightarrow> s \<in> FR"
  using groupAssum isAbelian assms Group_ZF_3_2_L11
    group0_def Group_ZF_3_3_L2 group0.Group_ZF_2_4_L5E
  by simp

text\<open>The group inverse of a class of an almost homomorphism $f$
  is the class of the inverse of $f$.\<close>

lemma (in group1) Group_ZF_3_3_L6:
  assumes A1: "s \<in> AH"  and
  "r = QuotientGroupRel(AH,Op1,FR)" and
  "F = ProjFun2(AH,r,Op1)"
  shows "r``{\<sim>s} = GroupInv(AH//r,F)`(r``{s})"
proof -
  from groupAssum isAbelian assms have
    "r``{GroupInv(AH, Op1)`(s)} = GroupInv(AH//r,F)`(r `` {s})"
    using Group_ZF_3_2_L10A Group_ZF_3_3_L2 QuotientGroupOp_def
      group0.Group_ZF_2_4_L7 by simp
  with A1 show ?thesis using Group_ZF_3_2_L13
    by simp
qed

subsection\<open>Compositions of almost homomorphisms\<close>

text\<open>The goal of this section is to establish some facts about composition
  of almost homomorphisms that are needed for the real numbers construction in
  \<open>Real_ZF_x\<close> series. In particular we show that the set of almost
  homomorphisms is closed under composition and that composition
  is congruent with respect to the equivalence relation defined by the group
  of finite range functions (a normal subgroup of almost homomorphisms).\<close>

text\<open>The next formula restates the definition of the homomorphism
  difference to express the value an almost homomorphism on a product.\<close>

lemma (in group1) Group_ZF_3_4_L1:
  assumes "s\<in>AH" and  "m\<in>G"  "n\<in>G"
  shows "s`(m\<cdot>n) = s`(m)\<cdot>s`(n)\<cdot>\<delta>(s,\<langle> m,n\<rangle>)"
  using isAbelian assms Group_ZF_3_2_L4A HomDiff_def group0_4_L5
  by simp

text\<open>What is the value of a composition of almost homomorhisms?\<close>

lemma (in group1) Group_ZF_3_4_L2:
  assumes "s\<in>AH"  "r\<in>AH" and "m\<in>G"
  shows "(s\<circ>r)`(m) = s`(r`(m))"  "s`(r`(m)) \<in> G"
  using assms AlmostHoms_def func_ZF_5_L3 restrict AlHomOp2_def
    apply_funtype by auto

text\<open>What is the homomorphism difference of a composition?\<close>

lemma (in group1) Group_ZF_3_4_L3:
  assumes A1: "s\<in>AH"  "r\<in>AH" and A2: "m\<in>G"  "n\<in>G"
  shows "\<delta>(s\<circ>r,\<langle> m,n\<rangle>) =
  \<delta>(s,\<langle> r`(m),r`(n)\<rangle>)\<cdot>s`(\<delta>(r,\<langle> m,n\<rangle>))\<cdot>\<delta>(s,\<langle> r`(m)\<cdot>r`(n),\<delta>(r,\<langle> m,n\<rangle>)\<rangle>)"
proof -
  from A1 A2 have T1:
    "s`(r`(m))\<cdot> s`(r`(n)) \<in> G"
    "\<delta>(s,\<langle> r`(m),r`(n)\<rangle>)\<in> G" "s`(\<delta>(r,\<langle> m,n\<rangle>)) \<in>G"
    "\<delta>(s,\<langle> (r`(m)\<cdot>r`(n)),\<delta>(r,\<langle> m,n\<rangle>)\<rangle>) \<in> G"
    using Group_ZF_3_4_L2 AlmostHoms_def apply_funtype
      Group_ZF_3_2_L4A group0_2_L1 monoid0.group0_1_L1
    by auto
  from A1 A2 have "\<delta>(s\<circ>r,\<langle> m,n\<rangle>) =
    s`(r`(m)\<cdot>r`(n)\<cdot>\<delta>(r,\<langle> m,n\<rangle>))\<cdot>(s`((r`(m)))\<cdot>s`(r`(n)))\<inverse>"
    using HomDiff_def group0_2_L1 monoid0.group0_1_L1 Group_ZF_3_4_L2
      Group_ZF_3_4_L1 by simp
  moreover from A1 A2 have
    "s`(r`(m)\<cdot>r`(n)\<cdot>\<delta>(r,\<langle> m,n\<rangle>)) =
    s`(r`(m)\<cdot>r`(n))\<cdot>s`(\<delta>(r,\<langle> m,n\<rangle>))\<cdot>\<delta>(s,\<langle> (r`(m)\<cdot>r`(n)),\<delta>(r,\<langle> m,n\<rangle>)\<rangle>)"
    "s`(r`(m)\<cdot>r`(n)) = s`(r`(m))\<cdot>s`(r`(n))\<cdot>\<delta>(s,\<langle> r`(m),r`(n)\<rangle>)"
    using Group_ZF_3_2_L4A Group_ZF_3_4_L1 by auto
  moreover from T1 isAbelian have
    "s`(r`(m))\<cdot>s`(r`(n))\<cdot>\<delta>(s,\<langle> r`(m),r`(n)\<rangle>)\<cdot>
    s`(\<delta>(r,\<langle> m,n\<rangle>))\<cdot>\<delta>(s,\<langle> (r`(m)\<cdot>r`(n)),\<delta>(r,\<langle> m,n\<rangle>)\<rangle>)\<cdot>
    (s`((r`(m)))\<cdot>s`(r`(n)))\<inverse> =
    \<delta>(s,\<langle> r`(m),r`(n)\<rangle>)\<cdot>s`(\<delta>(r,\<langle> m,n\<rangle>))\<cdot>\<delta>(s,\<langle> (r`(m)\<cdot>r`(n)),\<delta>(r,\<langle> m,n\<rangle>)\<rangle>)"
    using group0_4_L6C by simp
  ultimately show ?thesis by simp
qed

text\<open>What is the homomorphism difference of a composition (another form)?
  Here we split the homomorphism difference of a composition
  into a product of three factors.
  This will help us in proving that the range of homomorphism difference
  for the composition is finite, as each factor has finite range.\<close>

lemma (in group1) Group_ZF_3_4_L4:
  assumes A1: "s\<in>AH"  "r\<in>AH" and A2: "x \<in> G\<times>G"
  and A3:
  "A = \<delta>(s,\<langle> r`(fst(x)),r`(snd(x))\<rangle>)"
  "B = s`(\<delta>(r,x))"
  "C = \<delta>(s,\<langle> (r`(fst(x))\<cdot>r`(snd(x))),\<delta>(r,x)\<rangle>)"
  shows "\<delta>(s\<circ>r,x) = A\<cdot>B\<cdot>C"
proof -
  let ?m = "fst(x)"
  let ?n = "snd(x)"
  note A1
  moreover from A2 have "?m\<in>G" "?n\<in>G"
    by auto
  ultimately have
    "\<delta>(s\<circ>r,\<langle> ?m,?n\<rangle>) =
    \<delta>(s,\<langle> r`(?m),r`(?n)\<rangle>)\<cdot>s`(\<delta>(r,\<langle> ?m,?n\<rangle>))\<cdot>
    \<delta>(s,\<langle> (r`(?m)\<cdot>r`(?n)),\<delta>(r,\<langle> ?m,?n\<rangle>)\<rangle>)"
    by (rule Group_ZF_3_4_L3)
  with A1 A2 A3 show ?thesis
    by auto
qed

text\<open>The range of the homomorphism difference of a composition
  of two almost homomorphisms is finite. This is the essential condition
  to show that a composition of almost homomorphisms is an almost
  homomorphism.\<close>

lemma (in group1) Group_ZF_3_4_L5:
  assumes A1: "s\<in>AH"  "r\<in>AH"
  shows "{\<delta>(Composition(G)`\<langle> s,r\<rangle>,x). x \<in> G\<times>G} \<in> Fin(G)"
proof -
  from A1 have
    "\<forall>x\<in>G\<times>G. \<langle> r`(fst(x)),r`(snd(x))\<rangle> \<in> G\<times>G"
    using Group_ZF_3_2_L4B by simp
  moreover from A1 have
    "{\<delta>(s,x). x\<in>G\<times>G} \<in> Fin(G)"
    using AlmostHoms_def by simp
  ultimately have
    "{\<delta>(s,\<langle> r`(fst(x)),r`(snd(x))\<rangle>). x\<in>G\<times>G} \<in> Fin(G)"
    by (rule Finite1_L6B)
  moreover have "{s`(\<delta>(r,x)). x\<in>G\<times>G} \<in> Fin(G)"
  proof -
    from A1 have "\<forall>m\<in>G. s`(m) \<in> G"
      using AlmostHoms_def apply_funtype by auto
    moreover from A1 have "{\<delta>(r,x). x\<in>G\<times>G} \<in> Fin(G)"
      using AlmostHoms_def by simp
    ultimately show ?thesis
      by (rule Finite1_L6C)
  qed
  ultimately have
    "{\<delta>(s,\<langle> r`(fst(x)),r`(snd(x))\<rangle>)\<cdot>s`(\<delta>(r,x)). x\<in>G\<times>G} \<in> Fin(G)"
    using group_oper_fun Finite1_L15 by simp
  moreover have
    "{\<delta>(s,\<langle> (r`(fst(x))\<cdot>r`(snd(x))),\<delta>(r,x)\<rangle>).  x\<in>G\<times>G} \<in> Fin(G)"
  proof -
    from A1 have
    "\<forall>x\<in>G\<times>G. \<langle> (r`(fst(x))\<cdot>r`(snd(x))),\<delta>(r,x)\<rangle> \<in> G\<times>G"
      using Group_ZF_3_2_L4B by simp
    moreover from A1 have
      "{\<delta>(s,x). x\<in>G\<times>G} \<in> Fin(G)"
      using AlmostHoms_def by simp
    ultimately show ?thesis by (rule Finite1_L6B)
  qed
  ultimately have
    "{\<delta>(s,\<langle> r`(fst(x)),r`(snd(x))\<rangle>)\<cdot>s`(\<delta>(r,x))\<cdot>
    \<delta>(s,\<langle> (r`(fst(x))\<cdot>r`(snd(x))),\<delta>(r,x)\<rangle>). x\<in>G\<times>G} \<in> Fin(G)"
    using group_oper_fun Finite1_L15 by simp
  moreover from A1 have "{\<delta>(s\<circ>r,x). x\<in>G\<times>G} =
    {\<delta>(s,\<langle> r`(fst(x)),r`(snd(x))\<rangle>)\<cdot>s`(\<delta>(r,x))\<cdot>
    \<delta>(s,\<langle> (r`(fst(x))\<cdot>r`(snd(x))),\<delta>(r,x)\<rangle>). x\<in>G\<times>G}"
    using Group_ZF_3_4_L4 by simp
  ultimately have "{\<delta>(s\<circ>r,x). x\<in>G\<times>G} \<in> Fin(G)" by simp
  with A1 show ?thesis using restrict AlHomOp2_def
    by simp
qed

text\<open>Composition of almost homomorphisms is an almost homomorphism.\<close>

theorem (in group1) Group_ZF_3_4_T1:
  assumes A1: "s\<in>AH"  "r\<in>AH"
  shows "Composition(G)`\<langle> s,r\<rangle> \<in> AH" "s\<circ>r \<in> AH"
proof -
  from A1 have "\<langle> s,r\<rangle> \<in> (G\<rightarrow>G)\<times>(G\<rightarrow>G)"
    using AlmostHoms_def by simp
  then have "Composition(G)`\<langle> s,r\<rangle> : G\<rightarrow>G"
    using func_ZF_5_L1 apply_funtype by blast
  with A1 show "Composition(G)`\<langle> s,r\<rangle> \<in> AH"
    using Group_ZF_3_4_L5 AlmostHoms_def
    by simp
  with A1 show  "s\<circ>r \<in> AH" using AlHomOp2_def restrict
    by simp
qed

text\<open>The set of almost homomorphisms is closed under composition.
  The second operation on almost homomorphisms is associative.\<close>

lemma (in group1) Group_ZF_3_4_L6: shows
  "AH {is closed under} Composition(G)"
  "AlHomOp2(G,P) {is associative on} AH"
proof -
  show "AH {is closed under} Composition(G)"
    using Group_ZF_3_4_T1 IsOpClosed_def by simp
  moreover have "AH \<subseteq> G\<rightarrow>G" using AlmostHoms_def
    by auto
  moreover have
    "Composition(G) {is associative on} (G\<rightarrow>G)"
    using func_ZF_5_L5 by simp
  ultimately show "AlHomOp2(G,P) {is associative on} AH"
    using func_ZF_4_L3 AlHomOp2_def by simp
qed

text\<open>Type information related to the situation of two almost
  homomorphisms.\<close>

lemma (in group1) Group_ZF_3_4_L7:
  assumes A1: "s\<in>AH"  "r\<in>AH" and A2: "n\<in>G"
  shows
  "s`(n) \<in> G" "(r`(n))\<inverse> \<in> G"
  "s`(n)\<cdot>(r`(n))\<inverse> \<in> G"   "s`(r`(n)) \<in> G"
proof -
  from A1 A2 show
    "s`(n) \<in> G"
    "(r`(n))\<inverse> \<in> G"
    "s`(r`(n)) \<in> G"
    "s`(n)\<cdot>(r`(n))\<inverse> \<in> G"
    using AlmostHoms_def apply_type
      group0_2_L1 monoid0.group0_1_L1 inverse_in_group
    by auto
qed

text\<open>Type information related to the situation of three almost
  homomorphisms.\<close>

lemma (in group1) Group_ZF_3_4_L8:
  assumes A1: "s\<in>AH"  "r\<in>AH"  "q\<in>AH" and A2: "n\<in>G"
  shows
  "q`(n)\<in>G"
  "s`(r`(n)) \<in> G"
  "r`(n)\<cdot>(q`(n))\<inverse> \<in> G"
  "s`(r`(n)\<cdot>(q`(n))\<inverse>) \<in> G"
  "\<delta>(s,\<langle> q`(n),r`(n)\<cdot>(q`(n))\<inverse>\<rangle>) \<in> G"
proof -
  from A1 A2 show
    "q`(n)\<in> G"  "s`(r`(n)) \<in> G" "r`(n)\<cdot>(q`(n))\<inverse> \<in> G"
    using AlmostHoms_def apply_type
      group0_2_L1 monoid0.group0_1_L1 inverse_in_group
    by auto
  with A1 A2 show "s`(r`(n)\<cdot>(q`(n))\<inverse>) \<in> G"
    "\<delta>(s,\<langle> q`(n),r`(n)\<cdot>(q`(n))\<inverse>\<rangle>) \<in> G"
    using AlmostHoms_def apply_type Group_ZF_3_2_L4A
    by auto
qed

text\<open>A formula useful in showing that the composition of almost
  homomorphisms is congruent with respect
  to the quotient group relation.\<close>

lemma (in group1) Group_ZF_3_4_L9:
  assumes A1: "s1 \<in> AH"  "r1 \<in> AH"  "s2 \<in> AH"  "r2 \<in> AH"
  and A2: "n\<in>G"
  shows "(s1\<circ>r1)`(n)\<cdot>((s2\<circ>r2)`(n))\<inverse> =
  s1`(r2`(n))\<cdot> (s2`(r2`(n)))\<inverse>\<cdot>s1`(r1`(n)\<cdot>(r2`(n))\<inverse>)\<cdot>
  \<delta>(s1,\<langle> r2`(n),r1`(n)\<cdot>(r2`(n))\<inverse>\<rangle>)"
proof -
  from A1 A2 isAbelian have
    "(s1\<circ>r1)`(n)\<cdot>((s2\<circ>r2)`(n))\<inverse> =
    s1`(r2`(n)\<cdot>(r1`(n)\<cdot>(r2`(n))\<inverse>))\<cdot>(s2`(r2`(n)))\<inverse>"
    using Group_ZF_3_4_L2 Group_ZF_3_4_L7 group0_4_L6A
      group_oper_assoc by simp
  with A1 A2 have "(s1\<circ>r1)`(n)\<cdot>((s2\<circ>r2)`(n))\<inverse> = s1`(r2`(n))\<cdot>
    s1`(r1`(n)\<cdot>(r2`(n))\<inverse>)\<cdot>\<delta>(s1,\<langle> r2`(n),r1`(n)\<cdot>(r2`(n))\<inverse>\<rangle>)\<cdot>
    (s2`(r2`(n)))\<inverse>"
    using Group_ZF_3_4_L8 Group_ZF_3_4_L1 by simp
  with A1 A2 isAbelian show ?thesis using
    Group_ZF_3_4_L8 group0_4_L7 by simp
qed

text\<open>The next lemma shows a formula that translates an expression
  in terms of the first group operation on almost homomorphisms and the
  group inverse in the group of almost homomorphisms to an expression using
  only the underlying group operations.\<close>

lemma (in group1) Group_ZF_3_4_L10: assumes A1: "s \<in> AH"  "r \<in> AH"
  and A2: "n \<in> G"
  shows "(s\<bullet>(GroupInv(AH,Op1)`(r)))`(n) = s`(n)\<cdot>(r`(n))\<inverse>"
proof -
  from A1 A2 show ?thesis
    using isAbelian Group_ZF_3_2_L13 Group_ZF_3_2_L12 Group_ZF_3_2_L14
    by simp
qed

text\<open>A neccessary condition for two a. h. to be almost equal.\<close>

lemma (in group1) Group_ZF_3_4_L11:
  assumes A1: "s\<approx>r"
  shows "{s`(n)\<cdot>(r`(n))\<inverse>. n\<in>G} \<in> Fin(G)"
proof -
  from A1 have "s\<in>AH" "r\<in>AH"
    using QuotientGroupRel_def by auto
  moreover from A1 have
    "{(s\<bullet>(GroupInv(AH,Op1)`(r)))`(n). n\<in>G} \<in> Fin(G)"
    using QuotientGroupRel_def Finite1_L18 by simp
  ultimately show ?thesis
    using Group_ZF_3_4_L10 by simp
qed

text\<open>A sufficient condition for two a. h. to be almost equal.\<close>

lemma (in group1) Group_ZF_3_4_L12: assumes A1: "s\<in>AH"  "r\<in>AH"
  and A2: "{s`(n)\<cdot>(r`(n))\<inverse>. n\<in>G} \<in> Fin(G)"
  shows "s\<approx>r"
proof -
  from groupAssum isAbelian A1 A2 show ?thesis
    using Group_ZF_3_2_L15 AlmostHoms_def
    Group_ZF_3_4_L10 Finite1_L19 QuotientGroupRel_def
    by simp
qed

text\<open>Another sufficient consdition for two a.h. to be almost
  equal. It is actually just an expansion of the definition
  of the quotient group relation.\<close>

lemma (in group1) Group_ZF_3_4_L12A: assumes "s\<in>AH"  "r\<in>AH"
  and "s\<bullet>(GroupInv(AH,Op1)`(r)) \<in> FR"
  shows "s\<approx>r"  "r\<approx>s"
proof  -
  from assms show "s\<approx>r" using assms QuotientGroupRel_def
    by simp
  then show "r\<approx>s" by (rule Group_ZF_3_3_L3A)
qed

text\<open>Another necessary condition for two a.h. to be almost
  equal. It is actually just an expansion of the definition
  of the quotient group relation.\<close>

lemma (in group1) Group_ZF_3_4_L12B: assumes "s\<approx>r"
  shows "s\<bullet>(GroupInv(AH,Op1)`(r)) \<in> FR"
  using assms QuotientGroupRel_def by simp

text\<open>The next lemma states the essential condition for
  the composition of a. h. to be congruent
  with respect to the quotient group relation for the subgroup of finite
  range functions.\<close>

lemma (in group1) Group_ZF_3_4_L13:
  assumes A1: "s1\<approx>s2"  "r1\<approx>r2"
  shows "(s1\<circ>r1) \<approx> (s2\<circ>r2)"
proof -
  have "{s1`(r2`(n))\<cdot> (s2`(r2`(n)))\<inverse>. n\<in>G} \<in> Fin(G)"
  proof -
    from A1 have "\<forall>n\<in>G. r2`(n) \<in> G"
      using QuotientGroupRel_def AlmostHoms_def apply_funtype
      by auto
    moreover from A1 have "{s1`(n)\<cdot>(s2`(n))\<inverse>. n\<in>G} \<in> Fin(G)"
      using Group_ZF_3_4_L11 by simp
    ultimately show ?thesis by (rule Finite1_L6B)
  qed
  moreover have "{s1`(r1`(n)\<cdot>(r2`(n))\<inverse>). n \<in> G} \<in> Fin(G)"
  proof -
    from A1 have "\<forall>n\<in>G. s1`(n)\<in>G"
      using QuotientGroupRel_def AlmostHoms_def apply_funtype
      by auto
    moreover from A1 have "{r1`(n)\<cdot>(r2`(n))\<inverse>. n\<in>G} \<in> Fin(G)"
      using Group_ZF_3_4_L11 by simp
    ultimately show ?thesis by (rule Finite1_L6C)
  qed
  ultimately have
    "{s1`(r2`(n))\<cdot> (s2`(r2`(n)))\<inverse>\<cdot>s1`(r1`(n)\<cdot>(r2`(n))\<inverse>).
    n\<in>G} \<in> Fin(G)"
    using group_oper_fun Finite1_L15 by simp
  moreover have
    "{\<delta>(s1,\<langle> r2`(n),r1`(n)\<cdot>(r2`(n))\<inverse>\<rangle>). n\<in>G} \<in> Fin(G)"
  proof -
    from A1 have "\<forall>n\<in>G. \<langle> r2`(n),r1`(n)\<cdot>(r2`(n))\<inverse>\<rangle> \<in> G\<times>G"
      using QuotientGroupRel_def Group_ZF_3_4_L7 by auto
    moreover from A1 have "{\<delta>(s1,x). x \<in> G\<times>G} \<in> Fin(G)"
      using QuotientGroupRel_def AlmostHoms_def by simp
    ultimately show ?thesis by (rule Finite1_L6B)
  qed
  ultimately have
    "{s1`(r2`(n))\<cdot> (s2`(r2`(n)))\<inverse>\<cdot>s1`(r1`(n)\<cdot>(r2`(n))\<inverse>)\<cdot>
    \<delta>(s1,\<langle> r2`(n),r1`(n)\<cdot>(r2`(n))\<inverse>\<rangle>). n\<in>G} \<in> Fin(G)"
    using group_oper_fun Finite1_L15 by simp
  with A1 show ?thesis using
    QuotientGroupRel_def Group_ZF_3_4_L9
    Group_ZF_3_4_T1 Group_ZF_3_4_L12 by simp
qed

text\<open>Composition of a. h. to is congruent
  with respect to the quotient group relation for the subgroup of finite
  range functions. Recall that if an operation say "$\circ $" on $X$ is
  congruent with respect to an equivalence relation $R$ then we can
  define the operation
  on the quotient space $X/R$ by $[s]_R\circ [r]_R := [s\circ r]_R$ and this
  definition will be correct i.e. it will not depend on the choice of
  representants for the classes $[x]$ and $[y]$. This is why we want it here.\<close>

lemma (in group1) Group_ZF_3_4_L13A: shows
  "Congruent2(QuotientGroupRel(AH,Op1,FR),Op2)"
proof -
  show ?thesis using Group_ZF_3_4_L13 Congruent2_def
    by simp
qed

text\<open>The homomorphism difference for the identity function is equal to
  the neutral element of the group (denoted $e$ in the group1 context).\<close>

lemma (in group1) Group_ZF_3_4_L14: assumes A1: "x \<in> G\<times>G"
  shows "\<delta>(id(G),x) = \<one>"
proof -
  from A1 show ?thesis using
    group0_2_L1 monoid0.group0_1_L1 HomDiff_def id_conv group0_2_L6
    by simp
qed

text\<open>The identity function ($I(x) = x$) on $G$ is an almost homomorphism.\<close>

lemma (in group1) Group_ZF_3_4_L15: shows "id(G) \<in> AH"
proof -
  have "G\<times>G \<noteq> 0" using group0_2_L1 monoid0.group0_1_L3A
    by blast
  then show ?thesis using Group_ZF_3_4_L14 group0_2_L2
    id_type AlmostHoms_def by simp
qed

text\<open>Almost homomorphisms form a monoid with composition.
  The identity function on the group is the neutral element there.\<close>

lemma (in group1) Group_ZF_3_4_L16:
  shows
  "IsAmonoid(AH,Op2)"
  "monoid0(AH,Op2)"
  "id(G) = TheNeutralElement(AH,Op2)"
proof-
  let ?i = "TheNeutralElement(G\<rightarrow>G,Composition(G))"
  have
    "IsAmonoid(G\<rightarrow>G,Composition(G))"
    "monoid0(G\<rightarrow>G,Composition(G))"
    using monoid0_def Group_ZF_2_5_L2 by auto
  moreover have "AH {is closed under} Composition(G)"
    using Group_ZF_3_4_L6 by simp
  moreover have "AH \<subseteq> G\<rightarrow>G"
    using AlmostHoms_def by auto
  moreover have "?i \<in> AH"
    using Group_ZF_2_5_L2 Group_ZF_3_4_L15 by simp
  moreover have "id(G) =  ?i"
    using Group_ZF_2_5_L2 by simp
  ultimately show
    "IsAmonoid(AH,Op2)"
    "monoid0(AH,Op2)"
    "id(G) = TheNeutralElement(AH,Op2)"
    using monoid0.group0_1_T1 group0_1_L6 AlHomOp2_def monoid0_def
    by auto
qed

text\<open>We can project the monoid of almost homomorphisms with composition
  to the group of almost homomorphisms divided by the subgroup of finite
  range functions. The class of the identity function is the neutral element
  of the quotient (monoid).\<close>

theorem (in group1) Group_ZF_3_4_T2:
  assumes A1: "R = QuotientGroupRel(AH,Op1,FR)"
  shows
  "IsAmonoid(AH//R,ProjFun2(AH,R,Op2))"
  "R``{id(G)} = TheNeutralElement(AH//R,ProjFun2(AH,R,Op2))"
proof -
  have "group0(AH,Op1)" using Group_ZF_3_2_L10A group0_def
    by simp
  with A1 groupAssum isAbelian show
    "IsAmonoid(AH//R,ProjFun2(AH,R,Op2))"
    "R``{id(G)} = TheNeutralElement(AH//R,ProjFun2(AH,R,Op2))"
    using Group_ZF_3_3_L2 group0.Group_ZF_2_4_L3 Group_ZF_3_4_L13A
      Group_ZF_3_4_L16 monoid0.Group_ZF_2_2_T1 Group_ZF_2_2_L1
    by auto
qed

subsection\<open>Shifting almost homomorphisms\<close>

text\<open>In this this section we consider what happens if we multiply
  an almost homomorphism by a group element. We show that the
  resulting function is also an a. h., and almost equal to the original
  one. This is used only for slopes (integer a.h.) in \<open>Int_ZF_2\<close>
  where we need to correct a positive slopes by adding a constant, so that
  it is at least $2$ on positive integers.\<close>

text\<open>If $s$ is an almost homomorphism and $c$ is some constant from the group,
  then $s\cdot c$ is an almost homomorphism.\<close>

lemma (in group1) Group_ZF_3_5_L1:
  assumes A1: "s \<in> AH" and A2: "c\<in>G" and
  A3: "r = {\<langle>x,s`(x)\<cdot>c\<rangle>. x\<in>G}"
  shows
  "\<forall>x\<in>G. r`(x) = s`(x)\<cdot>c"
  "r \<in> AH"
  "s \<approx> r"
proof -
  from A1 A2 A3 have I: "r:G\<rightarrow>G"
    using AlmostHoms_def apply_funtype group_op_closed
    ZF_fun_from_total by auto
  with A3 show II: "\<forall>x\<in>G. r`(x) = s`(x)\<cdot>c"
    using ZF_fun_from_tot_val by simp
  with isAbelian A1 A2 have III:
    "\<forall>p \<in> G\<times>G. \<delta>(r,p) = \<delta>(s,p)\<cdot>c\<inverse>"
    using group_op_closed AlmostHoms_def apply_funtype
    HomDiff_def group0_4_L7 by auto
  have "{\<delta>(r,p). p \<in> G\<times>G} \<in> Fin(G)"
  proof -
    from A1 A2 have
      "{\<delta>(s,p). p \<in> G\<times>G} \<in> Fin(G)"   "c\<inverse>\<in>G"
      using AlmostHoms_def inverse_in_group by auto
    then have "{\<delta>(s,p)\<cdot>c\<inverse>. p \<in> G\<times>G} \<in> Fin(G)"
      using group_oper_fun Finite1_L16AA
      by simp
    moreover from III have
      "{\<delta>(r,p). p \<in> G\<times>G} = {\<delta>(s,p)\<cdot>c\<inverse>. p \<in> G\<times>G}"
      by (rule ZF1_1_L4B)
    ultimately show ?thesis by simp
  qed
  with I show IV: "r \<in> AH" using AlmostHoms_def
    by simp
  from isAbelian A1 A2 I II have
    "\<forall>n \<in> G. s`(n)\<cdot>(r`(n))\<inverse> = c\<inverse>"
    using AlmostHoms_def apply_funtype group0_4_L6AB
    by auto
  then have "{s`(n)\<cdot>(r`(n))\<inverse>. n\<in>G} = {c\<inverse>. n\<in>G}"
    by (rule ZF1_1_L4B)
  with A1 A2 IV show "s \<approx> r"
    using group0_2_L1 monoid0.group0_1_L3A
      inverse_in_group Group_ZF_3_4_L12 by simp
qed

end


theory Pointwise imports Main begin

text \<open>
Lifting a relation to a function.
\<close>

definition pointwise where "pointwise P m m' = (\<forall> x. P (m x) (m' x))"

end


\<^marker>\<open>creator Bernhard Pöttinger\<close>

chapter \<open>Flow Interface\<close>
theory Flow_Interface
imports Main Auxiliary
begin

paragraph \<open>Summary\<close>
text \<open>This theory implements the basic data structures used by the Flow Framework
@{cite krishna20}: flow interfaces.\<close>

section \<open>Flow Interface\<close>

subsection \<open>Preliminary Flow Interfaces\<close>

text \<open>Flow Interfaces basically are equivalence classes of flow graphs with respect to
their ability to replace each other in sums.\<close>

text \<open>Analogously to flow graphs, we first introduce a preliminary type for flow interfaces due to
unique representation concerns. A flow interface (N,i,o) consists of a domain N,
an inflow i, and an outflow o.\<close>

type_synonym ('n,'m) fi' = "'n set \<times> ('n \<Rightarrow> 'm) \<times> ('n \<Rightarrow> 'm)"

text \<open>We need a notion of equality again due to being partially defined only on N.
Note that the outflow is defined on -N!\<close>

definition fi'_eq :: "('n,'m) fi' \<Rightarrow> ('n,'m) fi' \<Rightarrow> bool" where
"fi'_eq \<equiv> \<lambda>(N1,i1,o1) (N2,i2,o2). N1 = N2 \<and> (i1 = i2 on N1) \<and> (o1 = o2 on -N1)"

lemma fi'_eqI:
  assumes "N1 = N2" "i1 = i2 on N1" "o1 = o2 on -N1"
  shows "fi'_eq (N1,i1,o1) (N2,i2,o2)"
  using assms unfolding fi'_eq_def by (auto split: prod.splits)

text \<open>The only restriction for flow interfaces is that their domain has to be finite.\<close>

definition "def_fi' \<equiv> \<lambda>(N,_,_). finite N"

text \<open>We need a representation for invalid flow interfaces, i.e. lift to option type.\<close>

definition fi'_option_eq
  :: "('n,'m) fi' option \<Rightarrow> ('n,'m :: cancel_comm_monoid_add) fi' option \<Rightarrow> bool" where
"fi'_option_eq \<equiv> \<lambda>i1 i2.
    case (i1,i2) of
      (Some i1', Some i2') \<Rightarrow> (if def_fi' i1' \<and> def_fi' i2' then fi'_eq i1' i2' else
                              if \<not>def_fi' i1' \<and> \<not>def_fi' i2' then True else
                              False)
    | (None, None) \<Rightarrow> True
    | (Some i1, None) \<Rightarrow> \<not>def_fi' i1
    | (None, Some i2) \<Rightarrow> \<not>def_fi' i2"

subsection \<open>Flow Interfaces @{cite \<open>def. 5\<close> krishna20}\<close>

quotient_type (overloaded) ('n,'m) fi =
  "('n,'m :: cancel_comm_monoid_add) fi' option" / fi'_option_eq
  apply (rule equivpI)
  subgoal by (rule reflpI, simp add: fi'_option_eq_def fi'_eq_def split: option.splits)
  subgoal by (rule sympI, auto simp: fi'_option_eq_def fi'_eq_def split: option.splits if_splits)
  subgoal by (rule transpI, simp add: fi'_option_eq_def fi'_eq_def def_fi'_def
              split: option.splits if_splits prod.splits)
  done

text \<open>Accessor functions again... Default values for invalid flow interfaces, default values
for inflow and outflow outside their domain.\<close>

lift_definition dom_fi :: "('n,'m::cancel_comm_monoid_add) fi \<Rightarrow> 'n set"
  is "\<lambda>i. case i of Some (N,f,g) \<Rightarrow> if def_fi' (N,f,g) then N else {} | _ \<Rightarrow> {}"
  by (auto simp: fi'_option_eq_def def_fi'_def fi'_eq_def
      split: option.splits if_splits prod.splits)

lift_definition inf_fi :: "('n,'m::cancel_comm_monoid_add) fi \<Rightarrow> ('n \<Rightarrow> 'm)"
  is "\<lambda>i. case i of
    Some (N,f,g) \<Rightarrow> if def_fi' (N,f,g) then restrict N 0 f else (\<lambda>_. 0) |
    None \<Rightarrow> (\<lambda>_. 0)"
  by (auto simp: fi'_option_eq_def def_fi'_def fi'_eq_def
      split: option.splits if_splits prod.splits)

lift_definition outf_fi :: "('n,'m::cancel_comm_monoid_add) fi \<Rightarrow> ('n \<Rightarrow> 'm)" is
  "\<lambda>i. case i of
    Some (N,f,g) \<Rightarrow> if def_fi' (N,f,g) then restrict (-N) 0 g else (\<lambda>_. 0) |
    None \<Rightarrow> (\<lambda>_. 0)"
  by (auto simp: fi'_option_eq_def def_fi'_def fi'_eq_def
      split: option.splits if_splits prod.splits)

text \<open>Constructor function avoiding Some...\<close>

lift_definition fi :: "'n set \<Rightarrow> ('n \<Rightarrow> 'm) \<Rightarrow> ('n \<Rightarrow> 'm) \<Rightarrow> ('n,'m::cancel_comm_monoid_add) fi" is
  "\<lambda>N1 i1 o1. Some (N1, i1, o1)" .

text \<open>Notation for the invalid element. As discussed for flow graphs, None is the representation.\<close>

instantiation fi :: (type,type) bot
begin
lift_definition bot_fi :: "('n,'m :: cancel_comm_monoid_add) fi" is None .
instance ..
end

text \<open>Simplification rules for accessor functions\<close>

lemma dom_fi_bot[simp]: "dom_fi bot = {}"
  by (transfer, simp)

lemma outf_fi_bot[simp]: "outf_fi bot = (\<lambda>_. 0)"
  by (transfer, simp)

lemma inf_fi_bot[simp]: "inf_fi bot = (\<lambda>_. 0)"
  by (transfer, simp)

lemma dom_fi_fi[simp]:
  "fi N1 i1 o1 \<noteq> bot \<Longrightarrow> dom_fi (fi N1 i1 o1) = N1"
  by (transfer, auto simp: def_fi'_def fi'_option_eq_def)

lemma inf_fi_fi[simp]:
  "fi N1 i1 o1 \<noteq> bot \<Longrightarrow> inf_fi (fi N1 i1 o1) = restrict N1 0 i1"
  by (transfer, auto simp: def_fi'_def fi'_option_eq_def)

lemma outf_fi_fi[simp]:
  "fi N1 i1 o1 \<noteq> bot \<Longrightarrow> outf_fi (fi N1 i1 o1) = restrict (-N1) 0 o1"
  by (transfer, auto simp: def_fi'_def fi'_option_eq_def)

lemma dom_fi_finite[simp]: "finite (dom_fi i)"
  by (transfer, auto split: option.splits simp: def_fi'_def)

text \<open>Establish validity of flow interfaces.\<close>

lemma fiI[simp,intro]: "finite N1 \<Longrightarrow> fi N1 i1 o1 \<noteq> bot"
  by (transfer, auto simp: fi'_option_eq_def def_fi'_def)

text \<open>Establish equality of flow interfaces.\<close>

lemma fi_cong:
  assumes "N1 = N2" "\<forall>n \<in> N1. i1 n = i2 n" "\<forall>n \<in> -N1. o1 n = o2 n"
  shows "fi N1 i1 o1 = fi N2 i2 o2"
  using assms
  by (transfer, auto simp: fi'_option_eq_def fi'_eq_def def_fi'_def)

lemma fi_eqI2:
  fixes i1 i2 :: "('n,'m::cancel_comm_monoid_add) fi"
  assumes "i1 \<noteq> bot \<Longrightarrow> i1 = i2" "i2 \<noteq> bot \<Longrightarrow> i2 = i1"
  shows "i1 = i2"
  using assms
  by auto

(* We need the assumptions that both i1 and i2 do not equal bot as dom_fi, inf_fi and
    outf_fi depend on this information. *)
lemma fi_eqI:
  assumes "i1 \<noteq> bot" "i2 \<noteq> bot"
    and "dom_fi i1 = dom_fi i2"
    "inf_fi i1 = inf_fi i2 on (dom_fi i1)"
    "outf_fi i1 = outf_fi i2 on (-dom_fi i1)"
  shows "i1 = i2"
  using assms
  apply transfer
  by (auto split: option.splits simp: fi'_option_eq_def fi'_eq_def)

lemma fi_components[simp]:
  assumes "i \<noteq> bot"
  shows "fi (dom_fi i) (inf_fi i) (outf_fi i) = i"
  apply (rule fi_eqI)
  using assms by simp+

subsection \<open>Flow Interfaces are a commutative monoid @{cite \<open>def. 6, thm. 1\<close> krishna20}\<close>

instantiation fi :: (type,cancel_comm_monoid_add) comm_monoid_add
begin

text \<open>Empty flow interface is unit element:\<close>

definition zero_fi where
  "zero_fi \<equiv> fi {} (\<lambda>_.0) (\<lambda>_.0)"

lemma zero_fi_ne_bot[simp]:
  "0 \<noteq> (bot :: ('n,'m::cancel_comm_monoid_add) fi)"
  unfolding zero_fi_def bot_fi_def fi_def def_fi'_def
  apply simp
  using fi.abs_eq_iff unfolding fi'_option_eq_def def_fi'_def
  apply (auto split: option.splits if_splits) by force

text \<open>The implicit definition of flow interface sums according to @{cite \<open>def. 6\<close> krishna20}\<close>

definition is_sum_fi
  :: "('n,'m) fi \<Rightarrow> ('n,'m) fi \<Rightarrow> ('n,'m::cancel_comm_monoid_add) fi \<Rightarrow> bool" where
  "is_sum_fi i1 i2 i12 \<equiv>
    i1 \<noteq> bot \<and> i2 \<noteq> bot \<and> i12 \<noteq> bot \<and>
    dom_fi i1 \<inter> dom_fi i2 = {} \<and>
    dom_fi i1 \<union> dom_fi i2 = dom_fi i12 \<and>
    (\<forall>n \<in> dom_fi i1. inf_fi i1 n = inf_fi i12 n + outf_fi i2 n) \<and>
    (\<forall>n \<in> dom_fi i2. inf_fi i2 n = inf_fi i12 n + outf_fi i1 n) \<and>
    (\<forall>n \<in> -dom_fi i12. outf_fi i12 n = outf_fi i1 n + outf_fi i2 n)"

lemma is_sum_fi_unique:
  assumes "is_sum_fi i1 i2 i12"
  shows "\<And>i12'. is_sum_fi i1 i2 i12' \<Longrightarrow> i12 = i12'"
proof (rule fi_eqI)
  fix i12'
  assume *: "is_sum_fi i1 i2 i12'"

  show "i12 \<noteq> bot" "i12' \<noteq> bot" "dom_fi i12 = dom_fi i12'"
    using assms *
    unfolding is_sum_fi_def
    by simp_all

  show "inf_fi i12 = inf_fi i12' on dom_fi i12"
    using assms *
    unfolding is_sum_fi_def dom_fi_def inf_fi_def outf_fi_def
    by (auto split: option.splits)

  show "outf_fi i12 = outf_fi i12' on -dom_fi i12"
    using assms *
    unfolding is_sum_fi_def dom_fi_def inf_fi_def outf_fi_def
    by (auto split: option.splits)
qed

lemma is_sum_fi_sym:
  "is_sum_fi i1 i2 i12 \<longleftrightarrow> is_sum_fi i2 i1 i12"
  unfolding is_sum_fi_def
  by (auto simp: algebra_simps)

lemma is_sum_assoc_rl:
  assumes "is_sum_fi i2 i3 i23" "is_sum_fi i1 i23 i123"
  shows "\<exists>i12. is_sum_fi i1 i2 i12 \<and> is_sum_fi i12 i3 i123"
proof -
  let ?N1 = "dom_fi i1" let ?i1 = "inf_fi i1" let ?o1 = "outf_fi i1"
  let ?N2 = "dom_fi i2" let ?i2 = "inf_fi i2" let ?o2 = "outf_fi i2"
  let ?N3 = "dom_fi i3" let ?i3 = "inf_fi i3" let ?o3 = "outf_fi i3"
  let ?N23 = "dom_fi i23" let ?i23 = "inf_fi i23" let ?o23 = "outf_fi i23"
  let ?N123 = "dom_fi i123" let ?i123 = "inf_fi i123" let ?o123 = "outf_fi i123"
  let ?N12 = "dom_fi i1 \<union> dom_fi i2"
  let ?i12 = "\<lambda>n. if n \<in> ?N12 then inf_fi i123 n + outf_fi i3 n else 0"
  let ?o12 = "\<lambda>n. if n \<in> -?N12 then outf_fi i1 n + outf_fi i2 n else 0"

  have *: "is_sum_fi i1 i2 (fi ?N12 ?i12 ?o12)"
  proof -
    have "\<forall>n\<in>?N1. ?i1 n = ?i123 n + ?o3 n + ?o2 n"
    proof
      fix n assume "n \<in> ?N1"
      hence "?o23 n = ?o2 n + ?o3 n" "?i1 n = ?i123 n + ?o23 n"
        using assms unfolding is_sum_fi_def by auto
      thus "?i1 n = ?i123 n + ?o3 n + ?o2 n" by (simp add: ac_simps)
    qed
    moreover have "\<forall>n\<in>?N2. ?i2 n = ?i123 n + ?o3 n + ?o1 n"
    proof
      fix n assume "n \<in> ?N2"
      hence "?i2 n = ?i23 n + ?o3 n" "?i23 n = ?i123 n + ?o1 n"
        using assms unfolding is_sum_fi_def by auto
      thus "?i2 n = ?i123 n + ?o3 n + ?o1 n" by (simp add: ac_simps)
    qed
    ultimately show ?thesis
      using assms
      unfolding is_sum_fi_def
      by auto
  qed

  have "\<forall>n\<in>?N3. ?i3 n = ?i123 n + ?o12 n"
  proof
    fix n assume A: "n \<in> ?N3"
    moreover have "?N3 \<subseteq> -?N12"
      using assms unfolding is_sum_fi_def by auto
    ultimately have A': "n \<in> -?N12" by blast
    hence "?i3 n = ?i23 n + ?o2 n"
      "?i23 n = ?i123 n + ?o1 n" "?o12 n = ?o1 n + ?o2 n"
      using assms A unfolding is_sum_fi_def by auto
    thus "?i3 n = ?i123 n + ?o12 n" using A' by (auto simp: ac_simps)
  qed
  moreover have "\<forall>n\<in>- ?N123. ?o123 n = ?o12 n + ?o3 n"
  proof
    fix n assume A: "n \<in> -?N123"
    hence "?o12 n = ?o1 n + ?o2 n" "?o23 n = ?o2 n + ?o3 n" "?o123 n = ?o1 n + ?o23 n"
      using assms unfolding is_sum_fi_def by auto
    moreover have "n \<notin> ?N12" using A assms unfolding is_sum_fi_def by auto
    ultimately show "?o123 n = ?o12 n + ?o3 n" by (simp add: ac_simps)
  qed
  moreover have "?N12 \<inter> ?N3 = {} \<and> ?N123 = ?N12 \<union> ?N3"
    using assms unfolding is_sum_fi_def by auto
  ultimately have "is_sum_fi (fi ?N12 ?i12 ?o12) i3 i123"
    using assms
    unfolding is_sum_fi_def
    by simp
  thus ?thesis using * by blast
qed

lemma is_sum_assoc_lr:
  assumes "is_sum_fi h1 h2 h12" "is_sum_fi h12 h3 h123"
  shows "\<exists>h23. is_sum_fi h2 h3 h23 \<and> is_sum_fi h1 h23 h123"
proof -
  (* second direction of associativity based on first one and commutativity*)
  have "is_sum_fi h3 h12 h123"
    using is_sum_fi_sym assms by blast
  then obtain h13 where *: "is_sum_fi h3 h1 h13" "is_sum_fi h13 h2 h123"
    using is_sum_assoc_rl[of h1 h2 h12 h3 h123] assms by blast
  hence "is_sum_fi h2 h13 h123"
    using is_sum_fi_sym by blast
  then obtain h23' where "is_sum_fi h2 h3 h23'" "is_sum_fi h23' h1 h123"
    using is_sum_assoc_rl * by blast
  thus ?thesis
    using is_sum_fi_sym assms
    by blast
qed

lemma is_sum_fi_unit:
  "i1 \<noteq> bot \<Longrightarrow> is_sum_fi 0 i1 i1"
  unfolding is_sum_fi_def zero_fi_def
  by (auto)

text \<open>Here, we define the actual addition of flow interfaces by obtaining an implicitly
provided sum if available.\<close>

definition plus_fi
  :: "('n,'m) fi \<Rightarrow> ('n,'m) fi \<Rightarrow> ('n,'m::cancel_comm_monoid_add) fi" where
  "plus_fi i1 i2 \<equiv>
    if (\<exists>i12. is_sum_fi i1 i2 i12)
      then (THE i12. is_sum_fi i1 i2 i12)
      else bot"

lemma plus_fi_ops_exist:
  assumes "i1 + i2 \<noteq> (bot :: ('n,'m::cancel_comm_monoid_add) fi)"
  shows "i1 \<noteq> bot" "i2 \<noteq> bot"
  using assms unfolding plus_fi_def is_sum_fi_def
  by auto

lemma plus_fi_bot_bot[simp]: "bot + h = bot" "h + bot = (bot :: ('n,'m::cancel_comm_monoid_add) fi)"
  unfolding bot_fi_def plus_fi_def is_sum_fi_def by auto

text \<open>Converting between the explicit and implicit representations of sums:\<close>

lemma plus_fi_to_is_sum_fi:
  assumes "i1 + i2 = i12" "i12 \<noteq> bot"
  shows "is_sum_fi i1 i2 i12"
proof -
  obtain i12' where *: "is_sum_fi i1 i2 i12'"
    using assms unfolding plus_fi_def by (auto split: if_splits)
  moreover have **: "(THE i12. is_sum_fi  i1 i2 i12) = i12"
    using assms unfolding plus_fi_def by auto
  ultimately have "is_sum_fi i1 i2 (THE i12. is_sum_fi i1 i2 i12)"
    using is_sum_fi_unique theI by metis
  thus ?thesis
    using ** is_sum_fi_unique by simp
qed

lemma is_sum_fi_to_plus_fi:
  assumes "is_sum_fi i1 i2 i12"
  shows "i1 + i2 = i12"
proof -
  have *: "i1 + i2 = (THE i12. is_sum_fi i1 i2 i12)"
    using assms unfolding plus_fi_def is_sum_fi_def by auto
  hence "is_sum_fi i1 i2 (THE i12. is_sum_fi i1 i2 i12)"
    using is_sum_fi_unique assms theI by metis
  hence "i12 = (THE i12. is_sum_fi i1 i2 i12)"
    using assms is_sum_fi_unique by auto
  thus ?thesis
    using * by simp
qed

lemma unfold_inf_fi:
  assumes "i1 + i2 \<noteq> bot" "x \<in> dom_fi i1"
  shows "inf_fi i1 x = inf_fi (i1 + i2) x + outf_fi i2 x"
  using assms is_sum_fi_def plus_fi_to_is_sum_fi by fastforce

text \<open>Simplification of domain calculations of flow interfaces\<close>

lemma dom_fi_plus_fi[simp]:
  "i1 + i2 \<noteq> bot \<Longrightarrow> dom_fi (i1 + i2) = dom_fi i1 \<union> dom_fi i2"
  "i1 + i2 \<noteq> bot \<Longrightarrow> dom_fi i1 \<inter> dom_fi i2 = {}"
  unfolding plus_fi_def
   apply (auto split: if_splits simp: is_sum_fi_unique the_equality)
     apply (metis UnE is_sum_fi_def)
  apply (metis UnI1 is_sum_fi_def)
   apply (metis UnI2 is_sum_fi_def)
  by (metis insert_Diff insert_disjoint(1) is_sum_fi_def)

text \<open>Proof of flow interfaces being a commutative monoid @{cite \<open>thm. 1\<close> krishna20}\<close>

instance
proof (standard,goal_cases)
  case (1 a b c)
  then show ?case
  proof (rule fi_eqI2, goal_cases)
    case 1
    then have A: "is_sum_fi (a + b) c (a + b + c)"
      by (simp add: plus_fi_to_is_sum_fi)
    then have "a + b \<noteq> bot"
      unfolding is_sum_fi_def by simp
    then have "is_sum_fi a b (a + b)"
      by (simp add: plus_fi_to_is_sum_fi)
    then obtain bc where "is_sum_fi b c bc" "is_sum_fi a bc (a + b + c)"
      using is_sum_assoc_lr[of a b "a + b" c "a + b + c"] A by auto
    then have "a + bc = a + b + c" "b + c = bc"
      by (simp_all add: is_sum_fi_to_plus_fi)
    then show ?case
      by simp
  next
    case 2
    then have A: "is_sum_fi a (b + c) (a + (b + c))"
      by (simp add: plus_fi_to_is_sum_fi)
    then have "b + c \<noteq> bot"
      unfolding is_sum_fi_def by simp
    then have "is_sum_fi b c (b + c)"
      by (simp add: plus_fi_to_is_sum_fi)
    then obtain ab where "is_sum_fi ab c (a + (b + c))" "is_sum_fi a b ab"
      using is_sum_assoc_rl[of b c "b + c" a "a + (b + c)"] A by auto
    then have "ab + c = a + (b + c)" "a + b = ab"
      by (simp_all add: is_sum_fi_to_plus_fi)
    then show ?case
      by simp
  qed
next
  case (2 a b)
  then show ?case
    unfolding plus_fi_def using is_sum_fi_sym by auto
next
  case (3 a)
  then show ?case
    unfolding plus_fi_def
    using is_sum_fi_unit
    apply (cases "a = bot", auto simp: is_sum_fi_unique the_equality)
    unfolding is_sum_fi_def by auto
qed

end

text \<open>Again, flow interfaces are not generally cancellative but only for valid sums:\<close>

lemma is_sum_fi_unique2:
  assumes "is_sum_fi i1 i2 i12" "is_sum_fi i1 i2' i12"
  shows "i2 = i2'"
proof (rule fi_eqI)
  show "i2 \<noteq> bot" "i2' \<noteq> bot"
    using assms unfolding is_sum_fi_def by auto
  show *: "dom_fi i2 = dom_fi i2'"
    using assms unfolding is_sum_fi_def by auto
  show "inf_fi i2 = inf_fi i2' on dom_fi i2"
    using assms unfolding is_sum_fi_def by auto
  have "\<forall>n \<in> -dom_fi i12. outf_fi i1 n + outf_fi i2 n = outf_fi i1 n + outf_fi i2' n"
    using assms unfolding is_sum_fi_def by auto
  moreover have "\<forall>n \<in> dom_fi i1. inf_fi i12 n + outf_fi i2 n = inf_fi i12 n + outf_fi i2' n"
    using assms unfolding is_sum_fi_def by auto
  ultimately show "outf_fi i2 = outf_fi i2' on -dom_fi i2"
    using assms unfolding is_sum_fi_def by auto
qed

lemma plus_fi_cancel_right:
  fixes a b c :: "('a,'b::cancel_comm_monoid_add) fi"
  assumes "a + b \<noteq> bot" "a + b = a + c"
  shows "b = c"
proof -
  have "a \<noteq> bot" "b \<noteq> bot" "c \<noteq> bot"
    using assms plus_fi_ops_exist by auto
  hence "is_sum_fi a b (a + c)" "is_sum_fi a c (a + c)"
    using plus_fi_to_is_sum_fi assms by auto
  thus "b = c"
    using is_sum_fi_unique2 by blast
qed

lemma plus_fi_cancel_left:
  assumes "a + c \<noteq> (bot :: ('a,'b::cancel_comm_monoid_add) fi)" "a + c = b + c"
  shows "a = b"
  using plus_fi_cancel_right[of c a b] assms by (simp add: algebra_simps)

section \<open>Computations on Flow Interfaces\<close>

text \<open>Here we try to simplify validity proofs for flow interfaces\<close>

lemma fi_plus_fi_nbot:
  assumes "X1 \<inter> X2 = {}" "\<forall>x \<in> X1. i1 x = i x + o2 x" "\<forall>x \<in> X2. i2 x = i x + o1 x"
    "finite X1" "finite X2"
  shows "fi X1 i1 o1 + fi X2 i2 o2 \<noteq> bot"
proof -
  let ?i1 = "fi X1 i1 o1" let ?i2 = "fi X2 i2 o2" let ?i12' = "?i1 + ?i2"
  let ?i12 = "fi (X1 \<union> X2) i (\<lambda>x. o1 x + o2 x)"

  have nbot: "?i1 \<noteq> bot" "?i2 \<noteq> bot" "?i12 \<noteq> bot"
    using assms fiI by auto
  then have "is_sum_fi ?i1 ?i2 ?i12"
    using assms unfolding is_sum_fi_def by auto
  then have "?i1 + ?i2 = ?i12"
    using is_sum_fi_to_plus_fi by blast
  then show ?thesis
    using nbot is_sum_fi_to_plus_fi by simp
qed

text \<open>For some flow domains the following rule might be simpler to apply:\<close>
text \<open>Exploiting a stronger flow domain enables us to check equalities more efficiently!\<close>

lemma fi_plus_fi_nbot':
  fixes i1 i2 o1 o2 :: "'a \<Rightarrow> 'b :: ordered_cancel_comm_monoid_diff"
  assumes "X1 \<inter> X2 = {}" "\<forall>x \<in> X1. i1 x \<ge> o2 x" "\<forall>x \<in> X2. i2 x \<ge> o1 x" "finite X1" "finite X2"
  shows "fi X1 i1 o1 + fi X2 i2 o2 \<noteq> bot"
  apply (rule fi_plus_fi_nbot[of _ _ _ "\<lambda>x. if x \<in> X1 then i1 x - o2 x else i2 x - o1 x"])
  using assms by (auto simp: ordered_cancel_comm_monoid_diff_class.diff_add)

lemma fi_plus_fg_calc:
  fixes i1 i2 o1 o2 :: "'a \<Rightarrow> 'b :: ordered_cancel_comm_monoid_diff"
  assumes "X1 \<inter> X2 = {}" "\<forall>x \<in> X1. i1 x \<ge> o2 x" "\<forall>x \<in> X2. i2 x \<ge> o1 x" "finite X1" "finite X2"
  shows "fi X1 i1 o1 + fi X2 i2 o2 =
    fi (X1 \<union> X2) (\<lambda>x. if x \<in> X1 then i1 x - o2 x else i2 x - o1 x) (\<lambda>x. o1 x + o2 x)"
proof -
  let ?i1 = "fi X1 i1 o1" let ?i2 = "fi X2 i2 o2"
  let ?i12 = "fi (X1 \<union> X2) (\<lambda>x. if x \<in> X1 then i1 x - o2 x else i2 x - o1 x) (\<lambda>x. o1 x + o2 x)"

  have *: "is_sum_fi ?i1 ?i2 ?i12"
    unfolding is_sum_fi_def
    using assms
    by (auto simp: algebra_simps ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
  show ?thesis
    by (fact is_sum_fi_to_plus_fi[OF *])
qed

end


header {*  Marking Using a Stack  *}

theory StackMark
imports SetMark "../DataRefinementIBP/DataRefinement"
begin

text{*
In this theory we refine the set marking diagram to a diagram in which the
set is replaced by a list (stack). Iniatially the list contains the root element
and as long as the list is nonempty and the top of the list has an unmarked
successor $y$, then $y$ is added to the top of the list. If the top does not
have unmarked sucessors, it is removed from the list. The diagram terminates when
the list is empty.

The data refinement relation of the two diagrams is true if the list
has distinct elements and the elements of the list and the set are the same.
*}

subsection {* Transitions *}

definition (in graph)
  "Q1'_a \<equiv> [:\<lambda> (stk::('node list), mrk::('node set)) . {(stk'::('node list), mrk') .
             root = nil \<and> stk' = [] \<and> mrk' = mrk}:]"

definition (in graph)
  "Q2'_a \<equiv> [:\<lambda> (stk::('node list), mrk::('node set)) . {(stk', mrk') .
         root \<noteq> nil \<and> stk' = [root] \<and> mrk' = mrk \<union> {root}}:]"

definition (in graph)
  "Q3'_a \<equiv> [:\<lambda> (stk, mrk) . {(stk', mrk') .  stk \<noteq> [] \<and> (\<exists> y . (hd stk, y) \<in> next \<and>
         y \<notin> mrk \<and> stk' = y # stk \<and> mrk' = mrk \<union> {y})}:]"

definition (in graph)
  "Q4'_a \<equiv> [:\<lambda> (stk, mrk) . {(stk', mrk') . stk \<noteq> [] \<and>
        (\<forall> y . (hd stk, y) \<in> next \<longrightarrow> y \<in> mrk) \<and> stk' = tl stk \<and> mrk' = mrk}:]"

definition
  "Q5'_a \<equiv> [:\<lambda> (stk, mrk) . {(stk', mrk') . stk = [] \<and> mrk' = mrk}:]"

subsection {* Invariants *}

definition
  "Init' \<equiv> UNIV"

definition
  "Loop' \<equiv> { (stk, mrk) . distinct stk}"

definition
  "Final' \<equiv> UNIV"

definition [simp]:
  "StackMarkInv i = (case i of
      I.init  \<Rightarrow> Init' |
      I.loop  \<Rightarrow> Loop' |
      I.final \<Rightarrow> Final')"

subsection {* Data refinement relations *}

definition
  "R1_a \<equiv> {: stk, mrk \<leadsto> X, mrk' . mrk' = mrk :}"

definition
  "R2_a \<equiv> {: stk, mrk \<leadsto> X, mrk' . X = set stk \<and> (stk, mrk) \<in> Loop' \<and> mrk' = mrk :}"

lemma [simp]: "R2_a \<in> Apply.Disjunctive" by (simp add: R2_a_def)

definition [simp]:
  "R_a i = (case i of
      I.init  \<Rightarrow> R1_a |
      I.loop  \<Rightarrow> R2_a |
      I.final \<Rightarrow> R1_a)"

lemma [simp]: "Disjunctive_fun R_a" by (simp add: Disjunctive_fun_def)

definition
  "angelic_fun r = (\<lambda> i . {:r i:})"

definition (in graph)
  "StackMark_a = (\<lambda> (i, j) . (case (i, j) of
      (I.init, I.loop)  \<Rightarrow> Q1'_a \<sqinter> Q2'_a |
      (I.loop, I.loop)  \<Rightarrow> Q3'_a \<sqinter> Q4'_a |
      (I.loop, I.final) \<Rightarrow> Q5'_a |
       _ \<Rightarrow> \<top>))"

subsection {* Data refinement of the transitions *}

theorem (in graph) init_nil [simp]:
  "DataRefinement ({.Init.} o Q1_a) R1_a R2_a Q1'_a"
   by (simp add: data_refinement_hoare hoare_demonic Q1'_a_def Init_def
     Loop'_def R1_a_def R2_a_def Q1_a_def angelic_def subset_eq)

theorem (in graph) init_root [simp]:
  "DataRefinement ({.Init.} o Q2_a) R1_a R2_a Q2'_a"
   by (simp add: data_refinement_hoare hoare_demonic Q2'_a_def Init_def
     Loop'_def R1_a_def R2_a_def Q2_a_def angelic_def subset_eq)

theorem (in graph) step1 [simp]:
  "DataRefinement ({.Loop.} o Q3_a) R2_a R2_a Q3'_a"
  apply (simp add: data_refinement_hoare hoare_demonic Loop_def
    Loop'_def R2_a_def Q3_a_def Q3'_a_def angelic_def subset_eq)
  apply (simp add: simp_eq_emptyset)
  by (metis List.set_simps(2) hd_in_set distinct.simps(2))

theorem (in graph) step2 [simp]:
  "DataRefinement ({.Loop.} o Q4_a) R2_a R2_a Q4'_a"
  apply (simp add: data_refinement_hoare hoare_demonic Loop_def
    Loop'_def R2_a_def Q4_a_def Q4'_a_def angelic_def subset_eq)
  apply (simp add: simp_eq_emptyset)
  apply clarify
  apply (case_tac a)
  by auto

subsection {* Diagram data refinement *}

lemma assert_comp_choice: "{.p.} o (S \<sqinter> T) = ({.p.} o S) \<sqinter> ({.p.} o T)"
  apply (rule antisym)
  apply (simp_all add: fun_eq_iff assert_def le_fun_def inf_fun_def inf_assoc)
  apply safe
  apply (rule_tac y = "S x \<sqinter> T x" in order_trans)
  apply (rule inf_le2)
  apply simp
  apply (rule_tac y = "S x \<sqinter> T x" in order_trans)
  apply (rule inf_le2)
  apply simp
  apply (rule_tac y = "S x \<sqinter> (p \<sqinter> T x)" in order_trans)
  apply (rule inf_le2)
  apply simp
  apply (rule_tac y = "S x \<sqinter> (p \<sqinter> T x)" in order_trans)
  apply (rule inf_le2)
  apply (rule_tac y = "p \<sqinter> T x" in order_trans)
  apply (rule inf_le2)
  by simp

theorem (in graph) StackMark_DataRefinement [simp]:
 "DgrDataRefinement2 SetMarkInv SetMark R_a StackMark_a"
  by (simp add: DgrDataRefinement2_def  StackMark_a_def SetMark_def demonic_sup_inf
    SetMarkInv_def data_refinement_choice2 assert_comp_choice)

subsection {* Diagram correctness *}

theorem (in graph) StackMark_correct:
  "Hoare_dgr (R_a .. SetMarkInv) StackMark_a ((R_a .. SetMarkInv) \<sqinter> (- grd (step (StackMark_a))))"
  apply (rule_tac D = "SetMark" in Diagram_DataRefinement2)
  apply auto
  by (rule SetMark_correct1)

end