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

    Copyright (C) 2013-2022 Daniel de la Concepcion

    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 5\<close>

theory Group_ZF_5 imports Group_ZF_4 Ring_ZF Semigroup_ZF

begin

subsection\<open>Homomorphisms\<close>

text\<open>A homomorphism is a function between groups that preserves
group operations.\<close>

definition
  Homomor ("_{is a homomorphism}{_,_}\<rightarrow>{_,_}" 85)
  where "IsAgroup(G,P) \<Longrightarrow> IsAgroup(H,F) \<Longrightarrow> Homomor(f,G,P,H,F) \<equiv> \<forall>g1\<in>G. \<forall>g2\<in>G. f`(P`\<langle>g1,g2\<rangle>)=F`\<langle>f`g1,f`g2\<rangle>"

text\<open>Now a lemma about the definition:\<close>

lemma homomor_eq:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "g1\<in>G" "g2\<in>G"
  shows "f`(P`\<langle>g1,g2\<rangle>)=F`\<langle>f`g1,f`g2\<rangle>"
  using assms Homomor_def by auto

text\<open>An endomorphism is a homomorphism from a group to the same group. In case
the group is abelian, it has a nice structure.\<close>

definition
  End
  where "End(G,P) \<equiv> {f:G\<rightarrow>G. Homomor(f,G,P,G,P)}"

text\<open>The set of endomorphisms forms a submonoid of the monoid of function
from a set to that set under composition.\<close>

lemma(in group0) end_composition:
  assumes "f1\<in>End(G,P)""f2\<in>End(G,P)"
  shows "Composition(G)`\<langle>f1,f2\<rangle>\<in>End(G,P)"
proof-
  from assms have fun:"f1:G\<rightarrow>G""f2:G\<rightarrow>G" unfolding End_def by auto
  then have fun2:"f1 O f2:G\<rightarrow>G" using comp_fun by auto
  have comp:"Composition(G)`\<langle>f1,f2\<rangle>=f1 O f2" using func_ZF_5_L2 fun by auto
  {
    fix g1 g2 assume AS2:"g1\<in>G""g2\<in>G"
    then have g1g2:"g1\<cdot>g2\<in>G" using group_op_closed by auto
    from fun2 have "(f1 O f2)`(g1\<cdot>g2)=f1`(f2`(g1\<cdot>g2))" using comp_fun_apply fun(2) g1g2 by auto
    also have "\<dots>=f1`((f2`g1)\<cdot>(f2`g2))" using assms(2) unfolding End_def Homomor_def[OF groupAssum groupAssum]
      using AS2 by auto moreover
    have "f2`g1\<in>G""f2`g2\<in>G" using fun(2) AS2 apply_type by auto ultimately
    have "(f1 O f2)`(g1\<cdot>g2)=(f1`(f2`g1))\<cdot>(f1`(f2`g2))" using assms(1) unfolding End_def Homomor_def[OF groupAssum groupAssum]
      using AS2 by auto
    then have "(f1 O f2)`(g1\<cdot>g2)=((f1 O f2)`g1)\<cdot>((f1 O f2)`g2)" using comp_fun_apply fun(2) AS2 by auto
  }
  then have "\<forall>g1\<in>G. \<forall>g2\<in>G. (f1 O f2)`(g1\<cdot>g2)=((f1 O f2)`g1)\<cdot>((f1 O f2)`g2)" by auto
  then have "(f1 O f2)\<in>End(G,P)" unfolding End_def Homomor_def[OF groupAssum groupAssum] using fun2 by auto
  with comp show "Composition(G)`\<langle>f1,f2\<rangle>\<in>End(G,P)" by auto
qed

theorem(in group0) end_comp_monoid:
  shows "IsAmonoid(End(G,P),restrict(Composition(G),End(G,P)\<times>End(G,P)))"
  and "TheNeutralElement(End(G,P),restrict(Composition(G),End(G,P)\<times>End(G,P)))=id(G)"
proof-
  have fun:"id(G):G\<rightarrow>G" unfolding id_def by auto
  {
    fix g h assume "g\<in>G""h\<in>G"
    then have id:"g\<cdot>h\<in>G""id(G)`g=g""id(G)`h=h" using group_op_closed by auto
    then have "id(G)`(g\<cdot>h)=g\<cdot>h" unfolding id_def by auto
    with id(2,3) have "id(G)`(g\<cdot>h)=(id(G)`g)\<cdot>(id(G)`h)" by auto
  }
  with fun have "id(G)\<in>End(G,P)" unfolding End_def Homomor_def[OF groupAssum groupAssum] by auto moreover
  from Group_ZF_2_5_L2(2) have A0:"id(G)=TheNeutralElement(G \<rightarrow> G, Composition(G))" by auto ultimately
  have A1:"TheNeutralElement(G \<rightarrow> G, Composition(G))\<in>End(G,P)" by auto moreover
  have A2:"End(G,P)\<subseteq>G\<rightarrow>G" unfolding End_def by auto moreover
  from end_composition have A3:"End(G,P){is closed under}Composition(G)" unfolding IsOpClosed_def by auto
  ultimately show "IsAmonoid(End(G,P),restrict(Composition(G),End(G,P)\<times>End(G,P)))"
    using monoid0.group0_1_T1 unfolding monoid0_def using Group_ZF_2_5_L2(1)
    by force
  have "IsAmonoid(G\<rightarrow>G,Composition(G))" using Group_ZF_2_5_L2(1) by auto
  with A0 A1 A2 A3 show "TheNeutralElement(End(G,P),restrict(Composition(G),End(G,P)\<times>End(G,P)))=id(G)"
    using group0_1_L6 by auto
qed

text\<open>The set of endomorphisms is closed under pointwise addition. This is so because the
group is abelian.\<close>

theorem(in abelian_group) end_pointwise_addition:
  assumes "f\<in>End(G,P)" "g\<in>End(G,P)" "F = P {lifted to function space over} G"
  shows "F`\<langle>f,g\<rangle>\<in>End(G,P)"
proof-
  from assms(1,2) have fun:"f\<in>G\<rightarrow>G""g\<in>G\<rightarrow>G" unfolding End_def by auto
  then have fun2:"F`\<langle>f,g\<rangle>:G\<rightarrow>G" using monoid0.Group_ZF_2_1_L0 group0_2_L1 assms(3) by auto
  {
    fix g1 g2 assume AS:"g1\<in>G""g2\<in>G"
    then have "g1\<cdot>g2\<in>G" using group_op_closed by auto
    then have "(F`\<langle>f,g\<rangle>)`(g1\<cdot>g2)=(f`(g1\<cdot>g2))\<cdot>(g`(g1\<cdot>g2))" using Group_ZF_2_1_L3 fun assms(3) by auto
    also have "\<dots>=(f`(g1)\<cdot>f`(g2))\<cdot>(g`(g1)\<cdot>g`(g2))" using assms unfolding End_def Homomor_def[OF groupAssum groupAssum]
      using AS by auto ultimately
    have "(F`\<langle>f,g\<rangle>)`(g1\<cdot>g2)=(f`(g1)\<cdot>f`(g2))\<cdot>(g`(g1)\<cdot>g`(g2))" by auto moreover
    have "f`g1\<in>G""f`g2\<in>G""g`g1\<in>G""g`g2\<in>G" using fun apply_type AS by auto ultimately
    have "(F`\<langle>f,g\<rangle>)`(g1\<cdot>g2)=(f`(g1)\<cdot>g`(g1))\<cdot>(f`(g2)\<cdot>g`(g2))" using group0_4_L8(3) assms(3) isAbelian
      by auto
    with AS have "(F`\<langle>f,g\<rangle>)`(g1\<cdot>g2)=((F`\<langle>f,g\<rangle>)`g1)\<cdot>((F`\<langle>f,g\<rangle>)`g2)"
      using Group_ZF_2_1_L3 fun assms(3) by auto
  }
  with fun2 show ?thesis unfolding End_def Homomor_def[OF groupAssum groupAssum] by auto
qed

text\<open>The inverse of an abelian group is an endomorphism.\<close>

lemma(in abelian_group) end_inverse_group:
  shows "GroupInv(G,P)\<in>End(G,P)"
proof-
  {
    fix s t assume AS:"s\<in>G""t\<in>G"
    then have elinv:"s\<inverse>\<in>G""t\<inverse>\<in>G" using inverse_in_group by auto
    have "(s\<cdot>t)\<inverse>=t\<inverse>\<cdot>s\<inverse>" using group_inv_of_two AS by auto
    then have "(s\<cdot>t)\<inverse>=s\<inverse>\<cdot>t\<inverse>" using isAbelian elinv unfolding IsCommutative_def by auto
  }
  then have "\<forall>s\<in>G. \<forall>t\<in>G. GroupInv(G,P)`(s\<cdot>t)=GroupInv(G,P)`(s)\<cdot>GroupInv(G,P)`(t)" by auto
  with group0_2_T2 groupAssum show ?thesis unfolding End_def using Homomor_def by auto
qed

text\<open>The set of homomorphisms of an abelian group is an abelian subgroup of
the group of functions from a set to a group, under pointwise multiplication.\<close>

theorem(in abelian_group) end_addition_group:
  assumes "F = P {lifted to function space over} G"
  shows "IsAgroup(End(G,P),restrict(F,End(G,P)\<times>End(G,P)))" "restrict(F,End(G,P)\<times>End(G,P)){is commutative on}End(G,P)"
proof-
  from end_comp_monoid(1) monoid0.group0_1_L3A have "End(G,P)\<noteq>0" unfolding monoid0_def by auto
  moreover have "End(G,P)\<subseteq>G\<rightarrow>G" unfolding End_def by auto moreover
  have "End(G,P){is closed under}F" unfolding IsOpClosed_def using end_pointwise_addition
    assms(1) isAbelian by auto moreover
  {
    fix ff assume AS:"ff\<in>End(G,P)"
    then have "restrict(Composition(G),End(G,P)\<times>End(G,P))`\<langle>GroupInv(G,P), ff\<rangle>\<in>End(G,P)" using monoid0.group0_1_L1
      unfolding monoid0_def using end_composition(1) end_inverse_group
      by force
    then have "Composition(G)`\<langle>GroupInv(G,P), ff\<rangle>\<in>End(G,P)" using AS end_inverse_group
      by auto
    then have "GroupInv(G,P) O ff\<in>End(G,P)" using func_ZF_5_L2 AS group0_2_T2 groupAssum unfolding
      End_def by auto
    then have "GroupInv(G\<rightarrow>G,F)`ff\<in>End(G,P)" using Group_ZF_2_1_L6 assms(1) AS unfolding End_def
      by auto
  }
  then have "\<forall>ff\<in>End(G,P). GroupInv(G\<rightarrow>G,F)`ff\<in>End(G,P)" by auto ultimately
  show "IsAgroup(End(G,P),restrict(F,End(G,P)\<times>End(G,P)))" using group0.group0_3_T3 Group_ZF_2_1_T2[OF assms(1)] unfolding IsAsubgroup_def group0_def
    by auto
  show "restrict(F,End(G,P)\<times>End(G,P)){is commutative on}End(G,P)" using Group_ZF_2_1_L7[OF assms(1)] isAbelian unfolding End_def IsCommutative_def by auto
qed

lemma(in abelian_group) distributive_comp_pointwise:
  assumes "F = P {lifted to function space over} G"
  shows "IsDistributive(End(G,P),restrict(F,End(G,P)\<times>End(G,P)),restrict(Composition(G),End(G,P)\<times>End(G,P)))"
proof-
  {
    fix b c d assume AS:"b\<in>End(G,P)""c\<in>End(G,P)""d\<in>End(G,P)"
    have ig1:"Composition(G) `\<langle>b, F ` \<langle>c, d\<rangle>\<rangle> =b O (F`\<langle>c,d\<rangle>)" using monoid.Group_ZF_2_1_L0 assms(1)
      AS unfolding End_def using func_ZF_5_L2 by auto
    have ig2:"F `\<langle>Composition(G) `\<langle>b , c\<rangle>,Composition(G) `\<langle>b , d\<rangle>\<rangle>=F `\<langle>b O c,b O d\<rangle>" using AS unfolding End_def using func_ZF_5_L2 by auto
    have comp1fun:"(b O (F`\<langle>c,d\<rangle>)):G\<rightarrow>G" using monoid.Group_ZF_2_1_L0 assms(1) comp_fun AS unfolding End_def by force
    have comp2fun:"(F `\<langle>b O c,b O d\<rangle>):G\<rightarrow>G" using monoid.Group_ZF_2_1_L0 assms(1) comp_fun AS unfolding End_def by force
    {
      fix g assume gG:"g\<in>G"
      then have "(b O (F`\<langle>c,d\<rangle>))`g=b`((F`\<langle>c,d\<rangle>)`g)" using comp_fun_apply monoid.Group_ZF_2_1_L0 assms(1)
        AS(2,3) unfolding End_def by force
      also have "\<dots>=b`(c`(g)\<cdot>d`(g))" using Group_ZF_2_1_L3[OF assms(1)] AS(2,3) gG unfolding End_def by auto
      ultimately have "(b O (F`\<langle>c,d\<rangle>))`g=b`(c`(g)\<cdot>d`(g))" by auto moreover
      have "c`g\<in>G""d`g\<in>G" using AS(2,3) unfolding End_def using apply_type gG by auto
      ultimately have "(b O (F`\<langle>c,d\<rangle>))`g=(b`(c`g))\<cdot>(b`(d`g))" using AS(1) unfolding End_def
        Homomor_def[OF groupAssum groupAssum] by auto
      then have "(b O (F`\<langle>c,d\<rangle>))`g=((b O c)`g)\<cdot>((b O d)`g)" using comp_fun_apply gG AS(2,3)
        unfolding End_def by auto
      then have "(b O (F`\<langle>c,d\<rangle>))`g=(F`\<langle>b O c,b O d\<rangle>)`g" using gG Group_ZF_2_1_L3[OF assms(1) comp_fun comp_fun gG]
        AS unfolding End_def by auto
    }
    then have "\<forall>g\<in>G. (b O (F`\<langle>c,d\<rangle>))`g=(F`\<langle>b O c,b O d\<rangle>)`g" by auto
    then have "b O (F`\<langle>c,d\<rangle>)=F`\<langle>b O c,b O d\<rangle>" using fun_extension[OF comp1fun comp2fun] by auto
    with ig1 ig2 have "Composition(G) `\<langle>b, F ` \<langle>c, d\<rangle>\<rangle> =F `\<langle>Composition(G) `\<langle>b , c\<rangle>,Composition(G) `\<langle>b , d\<rangle>\<rangle>" by auto moreover
    have "F ` \<langle>c, d\<rangle>=restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>" using AS(2,3) restrict by auto moreover
    have "Composition(G) `\<langle>b , c\<rangle>=restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b , c\<rangle>" "Composition(G) `\<langle>b , d\<rangle>=restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b , d\<rangle>"
      using restrict AS by auto moreover
    have "Composition(G) `\<langle>b, F ` \<langle>c, d\<rangle>\<rangle> =restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b, F ` \<langle>c, d\<rangle>\<rangle>" using AS(1)
      end_pointwise_addition[OF AS(2,3) assms] by auto
    moreover have "F `\<langle>Composition(G) `\<langle>b , c\<rangle>,Composition(G) `\<langle>b , d\<rangle>\<rangle>=restrict(F,End(G,P)\<times>End(G,P)) `\<langle>Composition(G) `\<langle>b , c\<rangle>,Composition(G) `\<langle>b , d\<rangle>\<rangle>"
      using end_composition[OF AS(1,2)] end_composition[OF AS(1,3)] by auto ultimately
    have eq1:"restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b, restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>\<rangle> =restrict(F,End(G,P)\<times>End(G,P)) `\<langle>restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b , c\<rangle>,restrict(Composition(G),End(G,P)\<times>End(G,P))`\<langle>b , d\<rangle>\<rangle>"
      by auto
    have ig1:"Composition(G) `\<langle> F ` \<langle>c, d\<rangle>,b\<rangle> = (F`\<langle>c,d\<rangle>) O b" using monoid.Group_ZF_2_1_L0 assms(1)
      AS unfolding End_def using func_ZF_5_L2 by auto
    have ig2:"F `\<langle>Composition(G) `\<langle>c , b\<rangle>,Composition(G) `\<langle>d , b\<rangle>\<rangle>=F `\<langle>c O b,d O b\<rangle>" using AS unfolding End_def using func_ZF_5_L2 by auto
    have comp1fun:"((F`\<langle>c,d\<rangle>) O b):G\<rightarrow>G" using monoid.Group_ZF_2_1_L0 assms(1) comp_fun AS unfolding End_def by force
    have comp2fun:"(F `\<langle>c O b,d O b\<rangle>):G\<rightarrow>G" using monoid.Group_ZF_2_1_L0 assms(1) comp_fun AS unfolding End_def by force
    {
      fix g assume gG:"g\<in>G"
      then have bg:"b`g\<in>G" using AS(1) unfolding End_def using apply_type by auto
      from gG have "((F`\<langle>c,d\<rangle>) O b)`g=(F`\<langle>c,d\<rangle>)`(b`g)" using comp_fun_apply AS(1) unfolding End_def by force
      also have "\<dots>=(c`(b`g))\<cdot>(d`(b`g))" using Group_ZF_2_1_L3[OF assms(1)] AS(2,3) bg unfolding End_def by auto
      also  have "\<dots>=((c O b)`g)\<cdot>((d O b)`g)" using comp_fun_apply gG AS unfolding End_def by auto
      also have "\<dots>=(F`\<langle>c O b,d O b\<rangle>)`g" using gG Group_ZF_2_1_L3[OF assms(1) comp_fun comp_fun gG]
        AS unfolding End_def by auto
      ultimately have"((F`\<langle>c,d\<rangle>) O b)`g=(F`\<langle>c O b,d O b\<rangle>)`g" by auto
    }
    then have "\<forall>g\<in>G. ((F`\<langle>c,d\<rangle>) O b)`g=(F`\<langle>c O b,d O b\<rangle>)`g" by auto
    then have "(F`\<langle>c,d\<rangle>) O b=F`\<langle>c O b,d O b\<rangle>" using fun_extension[OF comp1fun comp2fun] by auto
    with ig1 ig2 have "Composition(G) `\<langle>F ` \<langle>c, d\<rangle>,b\<rangle> =F `\<langle>Composition(G) `\<langle>c , b\<rangle>,Composition(G) `\<langle>d , b\<rangle>\<rangle>" by auto moreover
    have "F ` \<langle>c, d\<rangle>=restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>" using AS(2,3) restrict by auto moreover
    have "Composition(G) `\<langle>c , b\<rangle>=restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>c , b\<rangle>" "Composition(G) `\<langle>d , b\<rangle>=restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>d , b\<rangle>"
      using restrict AS by auto moreover
    have "Composition(G) `\<langle>F ` \<langle>c, d\<rangle>,b\<rangle> =restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>F ` \<langle>c, d\<rangle>,b\<rangle>" using AS(1)
      end_pointwise_addition[OF AS(2,3) assms] by auto
    moreover have "F `\<langle>Composition(G) `\<langle>c , b\<rangle>,Composition(G) `\<langle>d , b\<rangle>\<rangle>=restrict(F,End(G,P)\<times>End(G,P)) `\<langle>Composition(G) `\<langle>c , b\<rangle>,Composition(G) `\<langle>d , b\<rangle>\<rangle>"
      using end_composition[OF AS(2,1)] end_composition[OF AS(3,1)] by auto ultimately
    have eq2:"restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle> restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>,b\<rangle> =restrict(F,End(G,P)\<times>End(G,P)) `\<langle>restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>c ,b\<rangle>,restrict(Composition(G),End(G,P)\<times>End(G,P))`\<langle>d , b\<rangle>\<rangle>"
      by auto
    with eq1 have "(restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b, restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>\<rangle> =restrict(F,End(G,P)\<times>End(G,P)) `\<langle>restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>b , c\<rangle>,restrict(Composition(G),End(G,P)\<times>End(G,P))`\<langle>b , d\<rangle>\<rangle>)\<and>
      (restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle> restrict(F,End(G,P)\<times>End(G,P)) ` \<langle>c, d\<rangle>,b\<rangle> =restrict(F,End(G,P)\<times>End(G,P)) `\<langle>restrict(Composition(G),End(G,P)\<times>End(G,P)) `\<langle>c ,b\<rangle>,restrict(Composition(G),End(G,P)\<times>End(G,P))`\<langle>d , b\<rangle>\<rangle>)"
      by auto
  }
  then show ?thesis unfolding IsDistributive_def by auto
qed

text\<open>The endomorphisms of an abelian group is in fact a ring with the previous
  operations.\<close>

theorem(in abelian_group) end_is_ring:
  assumes "F = P {lifted to function space over} G"
  shows "IsAring(End(G,P),restrict(F,End(G,P)\<times>End(G,P)),restrict(Composition(G),End(G,P)\<times>End(G,P)))"
  unfolding IsAring_def using end_addition_group[OF assms] end_comp_monoid(1) distributive_comp_pointwise[OF assms]
  by auto

sublocale abelian_group < endo_ring:ring0 "End(G,P)" "restrict(P {lifted to function space over} G,End(G,P)\<times>End(G,P))" "restrict(Composition(G),End(G,P)\<times>End(G,P))"
  "\<lambda>x b. restrict(P {lifted to function space over} G,End(G,P)\<times>End(G,P))`\<langle>x,b\<rangle>" "\<lambda>x. GroupInv(End(G, P), restrict(P {lifted to function space over} G, End(G, P) \<times> End(G, P))) `x"
  "\<lambda>x b. restrict(P {lifted to function space over} G, End(G, P) \<times> End(G, P)) ` \<langle>x, GroupInv(End(G, P), restrict(P {lifted to function space over} G, End(G, P) \<times> End(G, P))) ` b\<rangle>"
  "\<lambda>x b. restrict(Composition(G), End(G, P) \<times> End(G, P)) ` \<langle>x, b\<rangle>"
  "TheNeutralElement(End(G, P), restrict(P {lifted to function space over} G, End(G, P) \<times> End(G, P)))"
  "TheNeutralElement(End(G, P), restrict(Composition(G), End(G, P) \<times> End(G, P)))"
  "restrict(P {lifted to function space over} G, End(G, P) \<times> End(G, P)) `
     \<langle>TheNeutralElement
       (End(G, P), restrict(Composition(G), End(G, P) \<times> End(G, P))),
      TheNeutralElement
       (End(G, P), restrict(Composition(G), End(G, P) \<times> End(G, P)))\<rangle>"
  "\<lambda>x. restrict(Composition(G), End(G, P) \<times> End(G, P)) ` \<langle>x, x\<rangle>"
  using end_is_ring unfolding ring0_def by auto

subsection\<open>First isomorphism theorem\<close>

text\<open>Now we will prove that any homomorphism $f:G\to H$ defines a bijective
homomorphism between $G/H$ and $f(G)$.\<close>

text\<open>A group homomorphism sends the neutral element to the neutral element
and commutes with the inverse.\<close>

lemma image_neutral:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H"
  shows "f`TheNeutralElement(G,P)=TheNeutralElement(H,F)"
proof-
  have g:"TheNeutralElement(G,P)=P`\<langle>TheNeutralElement(G,P),TheNeutralElement(G,P)\<rangle>" "TheNeutralElement(G,P)\<in>G"
    using assms(1) group0.group0_2_L2 unfolding group0_def by auto
  from g(1) have "f`TheNeutralElement(G,P)=f`(P`\<langle>TheNeutralElement(G,P),TheNeutralElement(G,P)\<rangle>)" by auto
  also have "\<dots>=F`\<langle>f`TheNeutralElement(G,P),f`TheNeutralElement(G,P)\<rangle>"
    using assms(3) unfolding Homomor_def[OF assms(1,2)] using g(2) by auto
  ultimately have "f`TheNeutralElement(G,P)=F`\<langle>f`TheNeutralElement(G,P),f`TheNeutralElement(G,P)\<rangle>" by auto moreover
  have h:"f`TheNeutralElement(G,P)\<in>H" using g(2) apply_type[OF assms(4)] by auto
  then have "f`TheNeutralElement(G,P)=F`\<langle>f`TheNeutralElement(G,P),TheNeutralElement(H,F)\<rangle>"
    using assms(2) group0.group0_2_L2 unfolding group0_def by auto ultimately
  have "F`\<langle>f`TheNeutralElement(G,P),TheNeutralElement(H,F)\<rangle>=F`\<langle>f`TheNeutralElement(G,P),f`TheNeutralElement(G,P)\<rangle>" by auto
  with h have "LeftTranslation(H,F,f`TheNeutralElement(G,P))`TheNeutralElement(H,F)=LeftTranslation(H,F,f`TheNeutralElement(G,P))`(f`TheNeutralElement(G,P))"
    using group0.group0_5_L2(2)[OF _ h] assms(2) group0.group0_2_L2 unfolding group0_def by auto
  moreover have "LeftTranslation(H,F,f`TheNeutralElement(G,P))\<in>bij(H,H)" using group0.trans_bij(2)
    assms(2) h unfolding group0_def by auto
  then have "LeftTranslation(H,F,f`TheNeutralElement(G,P))\<in>inj(H,H)" unfolding bij_def by auto ultimately
  show "f`TheNeutralElement(G,P)=TheNeutralElement(H,F)" using h assms(2) group0.group0_2_L2 unfolding inj_def group0_def
    by force
qed

lemma image_inv:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H" "g\<in>G"
  shows "f`( GroupInv(G,P)`g)=GroupInv(H,F)` (f`g)"
proof-
  have im:"f`g\<in>H" using apply_type[OF assms(4,5)].
  have inv:"GroupInv(G,P)`g\<in>G" using group0.inverse_in_group[OF _ assms(5)] assms(1) unfolding group0_def by auto
  then have inv2:"f`(GroupInv(G,P)`g)\<in>H"using apply_type[OF assms(4)] by auto
  have "f`TheNeutralElement(G,P)=f`(P`\<langle>g,GroupInv(G,P)`g\<rangle>)" using assms(1,5) group0.group0_2_L6
    unfolding group0_def by auto
  also have "\<dots>=F`\<langle>f`g,f`(GroupInv(G,P)`g)\<rangle>" using assms(3) unfolding Homomor_def[OF assms(1,2)] using
    assms(5) inv by auto
  ultimately have "TheNeutralElement(H,F)=F`\<langle>f`g,f`(GroupInv(G,P)`g)\<rangle>" using image_neutral[OF assms(1-4)]
    by auto
  then show ?thesis using group0.group0_2_L9(2)[OF _ im inv2] assms(2) unfolding group0_def by auto
qed

text\<open>The preimage of a subgroup is a subgroup\<close>

theorem preimage_sub:
  assumes "IsAgroup(G,P)"
          "IsAgroup(H,F)"
          "Homomor(f,G,P,H,F)"
          "f:G\<rightarrow>H"
          "IsAsubgroup(K,F)"
        shows "IsAsubgroup(f-``K,P)"
proof(rule group0.group0_3_T3)
  show "group0(G, P)" unfolding group0_def using assms(1).
  show KG:"f-``K \<subseteq> G" using func1_1_L3 assms(4) by auto
  have "f`TheNeutralElement(G,P) = TheNeutralElement(H,F)"
    using image_neutral assms(1-4) by auto
  then have "f`TheNeutralElement(G,P) \<in> K" using group0.group0_3_L5
    assms(2,5) unfolding group0_def by auto
  then have "TheNeutralElement(G,P)\<in>f-``K"
    using func1_1_L15 assms(4) assms(1) group0.group0_2_L2[of G P] unfolding group0_def
    by auto
  then show "f-``K\<noteq>0" by auto
  {
    fix x assume "x\<in>f-``K"
    then obtain y where y:"\<langle>x,y\<rangle>\<in>f" "y \<in> K" using vimage_iff by auto
    from y(1) have x:"x:G" using assms(4) unfolding Pi_def by auto
    with y(1) have "\<langle>GroupInv(G, P)`x,GroupInv(H, F)`y\<rangle>\<in>f" using
        image_inv[OF assms(1-4), of x]
      apply_Pair[OF assms(4), of x] assms(4)
      apply_Pair[OF assms(4) group0.inverse_in_group[of G P x]]
      assms(1)
      unfolding Pi_def function_def group0_def by force
    moreover have "GroupInv(H, F)`y \<in> K" using group0.group0_3_T3A
      assms(2,5) y(2) unfolding group0_def by auto
    ultimately have "GroupInv(G, P)`x \<in>f-``K" using vimage_iff by auto
  }
  then show "\<forall>x\<in>f -`` K. GroupInv(G, P) ` x \<in> f -`` K" by auto
  {
    fix x y assume as:"x:f-``K" "y:f-``K"
    then obtain x1 y1 where xy1:"\<langle>x,x1\<rangle>\<in>f" "x1\<in>K" "\<langle>y,y1\<rangle>\<in>f" "y1\<in>K"
      using vimage_iff by auto
    have "f`(P`\<langle>x,y\<rangle>) = F`\<langle>f`x,f`y\<rangle>" using homomor_eq[OF assms(1-3)]
      as KG by auto moreover
    from assms(4) xy1(3) apply_Pair[OF assms(4), of y]
    have "y1=f`y" unfolding Pi_def function_def by blast moreover
    from assms(4) xy1(1) apply_Pair[OF assms(4), of x]
    have "x1=f`x" unfolding Pi_def function_def by blast ultimately
    have "f`(P`\<langle>x,y\<rangle>) = F`\<langle>x1,y1\<rangle>" by auto
    with xy1(2,4) have "f`(P`\<langle>x,y\<rangle>) \<in> K" using group0.group0_3_L6
      assms(2,5) unfolding group0_def by auto
    then have "P`\<langle>x,y\<rangle>:f-``K" using func1_1_L15[OF assms(4)]
      using group0.group_op_closed as KG unfolding group0_def
      using assms(1) by auto
  }
  then show "f -`` K {is closed under} P" unfolding IsOpClosed_def by auto
qed

text\<open>The preimage of a normal subgroup is normal\<close>

theorem preimage_normal_subgroup:
  assumes  "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H"
          "IsAnormalSubgroup(H,F,K)"
        shows "IsAnormalSubgroup(G,P,f-``K)"
proof (rule group0.cont_conj_is_normal)
  show "group0(G,P)" unfolding group0_def using assms(1).
  show "IsAsubgroup(f-``K,P)" using preimage_sub assms unfolding IsAnormalSubgroup_def
    by auto
  {
    fix g assume g:"g\<in>G"
    {
      fix h assume "h:{P ` \<langle>g, P ` \<langle>h, GroupInv(G, P) ` g\<rangle>\<rangle> . h \<in> f -`` K}"
      then obtain k where k:"h = P ` \<langle>g, P ` \<langle>k, GroupInv(G, P) ` g\<rangle>\<rangle>" "k\<in> f -`` K" by auto
      from k(1) have "f`h = f`(P ` \<langle>g, P ` \<langle>k, GroupInv(G, P) ` g\<rangle>\<rangle>)" by auto
      moreover have "k:G" using k(2) assms(4) vimage_iff unfolding Pi_def by auto
      moreover note g
      ultimately have f:"f`h = F`\<langle>f`g,F`\<langle>f`k,GroupInv(H,F)`(f`g)\<rangle>\<rangle>"
        using group0.group_op_closed[of G P] group0.inverse_in_group[of G P]
        image_inv[OF assms(1-4)] homomor_eq[OF assms(1-3)]
        assms(1) unfolding group0_def by auto
      from g k have hg:"h:G" using group0.group_op_closed[of G P]
        group0.inverse_in_group[of G P] func1_1_L15[OF assms(4)] assms(1)
        unfolding group0_def by auto
      from k(2) have fk:"f`k:K" using func1_1_L15[OF assms(4)] by auto
      moreover have fg:"f`g:H" using apply_type[OF assms(4)] g by auto
      ultimately have "F`\<langle>F`\<langle>f`g,f`k\<rangle>,GroupInv(H,F)`(f`g)\<rangle> \<in>K"
        using assms(5) unfolding IsAnormalSubgroup_def by auto
      then have "f`h \<in>K" using group0.group_oper_assoc[of H F "f`g" "f`k"]
        fk fg f assms(2,5) group0.group0_3_L2[of H F K]
        group0.inverse_in_group[of H F "f`g"]
        unfolding group0_def IsAnormalSubgroup_def by auto
      then have "h:f-``K" using func1_1_L15[OF assms(4)] hg by auto
    }
    then have "{P ` \<langle>g, P ` \<langle>h, GroupInv(G, P) ` g\<rangle>\<rangle> . h \<in> f -`` K} \<subseteq> f -`` K" by auto
  }
  then show "\<forall>g\<in>G. {P ` \<langle>g, P ` \<langle>h, GroupInv(G, P) ` g\<rangle>\<rangle> . h \<in> f -`` K} \<subseteq> f -`` K" by auto
qed

text\<open>The kernel of an homomorphism is a normal subgroup.\<close>

corollary kerner_normal_sub:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H"
  shows "IsAnormalSubgroup(G,P,f-``{TheNeutralElement(H,F)})"
  using preimage_normal_subgroup[OF assms]
    group0.trivial_normal_subgroup[of H F] unfolding group0_def
  using assms(2) by auto

text\<open>The image of a subgroup is a subgroup\<close>

theorem image_subgroup:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)"
    "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H" "IsAsubgroup(K,P)"
  shows "IsAsubgroup(f``K,F)"
proof(rule group0.group0_3_T3)
  have sub:"K\<subseteq>G" using group0.group0_3_L2[of G P K] assms(1,5) unfolding group0_def by auto
  show "group0(H,F)" using assms(2) unfolding group0_def.
  show "f``K \<subseteq> H" using func_imagedef[OF assms(4)] sub apply_type[OF assms(4)] by auto
  have "TheNeutralElement(G,P) :  K" using group0.group0_3_L5
    assms(1,5) unfolding group0_def by auto
  then have "f`TheNeutralElement(G,P) \<in>f``K" using func_imagedef[OF assms(4)]
    sub by auto
  then show "f``K \<noteq> 0" by auto
  {
    fix x assume x:"x:f``K"
    then obtain q where q:"q:K" "x=f`q" using func_imagedef[OF assms(4)] sub by auto
    then have "GroupInv(H,F)`x = f`(GroupInv(G,P)`q)" using
      image_inv[OF assms(1-4)] sub by auto
    then have "GroupInv(H,F)`x:f``K" using group0.group0_3_T3A[of G P K q]
      assms(1,5) q(1) func_imagedef[OF assms(4)] sub unfolding group0_def by auto
  }
  then show "\<forall>x\<in>f `` K. GroupInv(H, F) ` x \<in> f `` K" by auto
  {
    fix x y assume "x:f``K" "y:f``K"
    then obtain qx qy where q:"qx:K" "x=f`qx" "qy:K" "y=f`qy" using func_imagedef[OF assms(4)] sub by auto
    then have "F`\<langle>x,y\<rangle> = f`(P`\<langle>qx,qy\<rangle>)" using homomor_eq[OF assms(1-3), of qx qy] sub by force
    moreover from q(1,3) have "P`\<langle>qx,qy\<rangle>:K" using group0.group0_3_L6
      assms(1,5) unfolding group0_def by auto
    ultimately have "F`\<langle>x,y\<rangle> \<in>f``K" using func_imagedef[OF assms(4)] sub by auto
  }
  then show "f `` K {is closed under} F" unfolding IsOpClosed_def by auto
qed

corollary image_group:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H"
  shows "IsAsubgroup(f``G,F)"
proof-
  have "restrict(P,G\<times>G)=P" using group0.group_oper_fun[of G P] restrict_idem assms(1)
    unfolding Pi_def group0_def by auto
  then have "IsAsubgroup(G,P)" unfolding IsAsubgroup_def using assms(1) by auto
  then show ?thesis using image_subgroup[OF assms, of G] by auto
qed

text\<open>Now we are able to prove the first isomorphism theorem. This theorem states
that any group homomorphism $f:G\to H$ gives an isomorphism between a quotient group of $G$
and a subgroup of $H$.\<close>

theorem isomorphism_first_theorem:
  assumes "IsAgroup(G,P)" "IsAgroup(H,F)" "Homomor(f,G,P,H,F)" "f:G\<rightarrow>H"
  defines "r \<equiv> QuotientGroupRel(G,P,f-``{TheNeutralElement(H,F)})" and
  "PP \<equiv> QuotientGroupOp(G,P,f-``{TheNeutralElement(H,F)})"
  shows "\<exists>ff. Homomor(ff,G//r,PP,f``G,restrict(F,(f``G)\<times>(f``G))) \<and> ff\<in>bij(G//r,f``G)"
proof-
  let ?ff="{\<langle>r``{g},f`g\<rangle>. g\<in>G}"
  {
    fix t assume "t\<in>{\<langle>r``{g},f`g\<rangle>. g\<in>G}"
    then obtain g where "t=\<langle>r``{g},f`g\<rangle>" "g\<in>G" by auto
    moreover then have "r``{g}\<in>G//r" unfolding r_def quotient_def by auto
    moreover from \<open>g\<in>G\<close> have "f`g\<in>f``G" using func_imagedef[OF assms(4)] by auto
    ultimately have "t\<in>(G//r)\<times>f``G" by auto
  }
  then have "?ff\<in>Pow((G//r)\<times>f``G)" by auto
  moreover have "(G//r)\<subseteq>domain(?ff)" unfolding domain_def quotient_def by auto moreover
  {
    fix x y t assume A:"\<langle>x,y\<rangle>\<in>?ff" "\<langle>x,t\<rangle>\<in>?ff"
    then obtain gy gr where "\<langle>x, y\<rangle>=\<langle>r``{gy},f`gy\<rangle>" "\<langle>x, t\<rangle>=\<langle>r``{gr},f`gr\<rangle>" and p:"gr\<in>G""gy\<in>G" by auto
    then have B:"r``{gy}=r``{gr}""y=f`gy""t=f`gr" by auto
    from B(2,3) have q:"y\<in>H""t\<in>H" using apply_type p assms(4) by auto
    have "\<langle>gy,gr\<rangle>\<in>r" using eq_equiv_class[OF B(1) _ p(1)] group0.Group_ZF_2_4_L3 kerner_normal_sub[OF assms(1-4)]
      assms(1) unfolding group0_def IsAnormalSubgroup_def r_def by auto
    then have "P`\<langle>gy,GroupInv(G,P)`gr\<rangle>\<in>f-``{TheNeutralElement(H,F)}" unfolding r_def QuotientGroupRel_def by auto
    then have eq:"f`(P`\<langle>gy,GroupInv(G,P)`gr\<rangle>)=TheNeutralElement(H,F)" using func1_1_L15[OF assms(4)] by auto
    from B(2,3) have "F`\<langle>y,GroupInv(H,F)`t\<rangle>=F`\<langle>f`gy,GroupInv(H,F)`(f`gr)\<rangle>" by auto
    also have "\<dots>=F`\<langle>f`gy,f`(GroupInv(G,P)`gr)\<rangle>" using image_inv[OF assms(1-4)] p(1) by auto
    also have "\<dots>=f`(P`\<langle>gy,GroupInv(G,P)`gr\<rangle>)" using assms(3) unfolding Homomor_def[OF assms(1,2)] using p(2)
      group0.inverse_in_group assms(1) p(1) unfolding group0_def by auto
    ultimately have "F`\<langle>y,GroupInv(H,F)`t\<rangle>=TheNeutralElement(H,F)" using eq by auto
    then have "y=t" using assms(2) group0.group0_2_L11A q unfolding group0_def by auto
  }
  then have "\<forall>x y. \<langle>x,y\<rangle>\<in>?ff \<longrightarrow> (\<forall>y'. \<langle>x,y'\<rangle>\<in>?ff \<longrightarrow> y=y')" by auto
  ultimately have ff_fun:"?ff:G//r\<rightarrow>f``G" unfolding Pi_def function_def by auto
  {
    fix a1 a2 assume AS:"a1\<in>G//r""a2\<in>G//r"
    then obtain g1 g2 where p:"g1\<in>G""g2\<in>G" and a:"a1=r``{g1}""a2=r``{g2}" unfolding quotient_def by auto
    have "equiv(G,r)" using group0.Group_ZF_2_4_L3 kerner_normal_sub[OF assms(1-4)]
      assms(1) unfolding group0_def IsAnormalSubgroup_def r_def by auto moreover
    have "Congruent2(r,P)" using Group_ZF_2_4_L5A[OF assms(1) kerner_normal_sub[OF assms(1-4)]]
      unfolding r_def by auto moreover
    have "PP=ProjFun2(G,r,P)" unfolding PP_def QuotientGroupOp_def r_def by auto moreover
    note a p ultimately have "PP`\<langle>a1,a2\<rangle>=r``{P`\<langle>g1,g2\<rangle>}" using group0.Group_ZF_2_2_L2 assms(1)
      unfolding group0_def by auto
    then have "\<langle>PP`\<langle>a1,a2\<rangle>,f`(P`\<langle>g1,g2\<rangle>)\<rangle>\<in>?ff" using group0.group_op_closed[OF _ p] assms(1) unfolding group0_def
      by auto
    then have eq:"?ff`(PP`\<langle>a1,a2\<rangle>)=f`(P`\<langle>g1,g2\<rangle>)" using apply_equality ff_fun by auto
    from p a have "\<langle>a1,f`g1\<rangle>\<in>?ff""\<langle>a2,f`g2\<rangle>\<in>?ff" by auto
    then have "?ff`a1=f`g1""?ff`a2=f`g2" using apply_equality ff_fun by auto
    then have "F`\<langle>?ff`a1,?ff`a2\<rangle>=F`\<langle>f`g1,f`g2\<rangle>" by auto
    also have "\<dots>=f`(P`\<langle>g1,g2\<rangle>)" using assms(3) unfolding Homomor_def[OF assms(1,2)] using p by auto
    ultimately have "F`\<langle>?ff`a1,?ff`a2\<rangle>=?ff`(PP`\<langle>a1,a2\<rangle>)" using eq by auto moreover
    have "?ff`a1\<in>f``G""?ff`a2\<in>f``G" using ff_fun apply_type AS by auto ultimately
    have "restrict(F,f``G\<times>f``G)`\<langle>?ff`a1,?ff`a2\<rangle>=?ff`(PP`\<langle>a1,a2\<rangle>)" by auto
  }
  then have r:"\<forall>a1\<in>G//r. \<forall>a2\<in>G//r. restrict(F,f``G\<times>f``G)`\<langle>?ff`a1,?ff`a2\<rangle>=?ff`(PP`\<langle>a1,a2\<rangle>)" by auto
  have G:"IsAgroup(G//r,PP)" using Group_ZF_2_4_T1[OF assms(1) kerner_normal_sub[OF assms(1-4)]] unfolding r_def PP_def by auto
  have H:"IsAgroup(f``G, restrict(F,f``G\<times>f``G))" using image_group[OF assms(1-4)] unfolding IsAsubgroup_def .
  have HOM:"Homomor(?ff,G//r,PP,f``G,restrict(F,(f``G)\<times>(f``G)))" using r unfolding Homomor_def[OF G H] by auto
  {
    fix b1 b2 assume AS:"?ff`b1=?ff`b2""b1\<in>G//r""b2\<in>G//r"
    have invb2:"GroupInv(G//r,PP)`b2\<in>G//r" using group0.inverse_in_group[OF _ AS(3)] G unfolding group0_def
      by auto
    with AS(2) have "PP`\<langle>b1,GroupInv(G//r,PP)`b2\<rangle>\<in>G//r" using group0.group_op_closed G unfolding group0_def by auto moreover
    then obtain gg where gg:"gg\<in>G""PP`\<langle>b1,GroupInv(G//r,PP)`b2\<rangle>=r``{gg}" unfolding quotient_def by auto
    ultimately have E:"?ff`(PP`\<langle>b1,GroupInv(G//r,PP)`b2\<rangle>)=f`gg" using apply_equality[OF _ ff_fun] by auto
    from invb2 have pp:"?ff`(GroupInv(G//r,PP)`b2)\<in>f``G" using apply_type ff_fun by auto
    from AS(2,3) have fff:"?ff`b1\<in>f``G""?ff`b2\<in>f``G" using apply_type[OF ff_fun] by auto
    from fff(1) pp have EE:"F`\<langle>?ff`b1,?ff`(GroupInv(G//r,PP)`b2)\<rangle>=restrict(F,f``G\<times>f``G)`\<langle>?ff`b1,?ff`(GroupInv(G//r,PP)`b2)\<rangle>"
      by auto
    from fff have fff2:"?ff`b1\<in>H""?ff`b2\<in>H" using func1_1_L6(2)[OF assms(4)] by auto
    with AS(1) have "TheNeutralElement(H,F)=F`\<langle>?ff`b1,GroupInv(H,F)`(?ff`b2)\<rangle>" using group0.group0_2_L6(1)
      assms(2) unfolding group0_def by auto
    also have "\<dots>=F`\<langle>?ff`b1,restrict(GroupInv(H,F),f``G)`(?ff`b2)\<rangle>" using restrict fff(2) by auto
    also have "\<dots>=F`\<langle>?ff`b1,?ff`(GroupInv(G//r,PP)`b2)\<rangle>" using image_inv[OF G H HOM ff_fun AS(3)]
      group0.group0_3_T1[OF _ image_group[OF assms(1-4)]] assms(2) unfolding group0_def by auto
    also have "\<dots>=restrict(F,f``G\<times>f``G)`\<langle>?ff`b1,?ff`(GroupInv(G//r,PP)`b2)\<rangle>" using EE by auto
    also have "\<dots>=?ff`(PP`\<langle>b1,GroupInv(G//r,PP)`b2\<rangle>)" using HOM unfolding Homomor_def[OF G H] using AS(2)
      group0.inverse_in_group[OF _ AS(3)] G unfolding group0_def by auto
    also have "\<dots>=f`gg" using E by auto
    ultimately have "f`gg=TheNeutralElement(H,F)" by auto
    then have "gg\<in>f-``{TheNeutralElement(H,F)}" using func1_1_L15[OF assms(4)] \<open>gg\<in>G\<close> by auto
    then have "r``{gg}=TheNeutralElement(G//r,PP)" using group0.Group_ZF_2_4_L5E[OF _ kerner_normal_sub[OF assms(1-4)]
      \<open>gg\<in>G\<close> ] using assms(1) unfolding group0_def r_def PP_def by auto
    with gg(2) have "PP`\<langle>b1,GroupInv(G//r,PP)`b2\<rangle>=TheNeutralElement(G//r,PP)" by auto
    then have "b1=b2" using group0.group0_2_L11A[OF _ AS(2,3)] G unfolding group0_def by auto
  }
  then have "?ff\<in>inj(G//r,f``G)" unfolding inj_def using ff_fun by auto moreover
  {
    fix m assume "m\<in>f``G"
    then obtain g where "g\<in>G""m=f`g" using func_imagedef[OF assms(4)] by auto
    then have "\<langle>r``{g},m\<rangle>\<in>?ff" by auto
    then have "?ff`(r``{g})=m" using apply_equality ff_fun by auto
    then have "\<exists>A\<in>G//r. ?ff`A=m" unfolding quotient_def using \<open>g\<in>G\<close> by auto
  }
  ultimately have "?ff\<in>bij(G//r,f``G)" unfolding bij_def surj_def using ff_fun by auto
  with HOM show ?thesis by auto
qed

text\<open>As a last result, the inverse of a bijective homomorphism is an homomorphism.
Meaning that in the previous result, the homomorphism we found is an isomorphism.\<close>

theorem bij_homomor:
  assumes "f\<in>bij(G,H)""IsAgroup(G,P)""IsAgroup(H,F)""Homomor(f,G,P,H,F)"
  shows "Homomor(converse(f),H,F,G,P)"
proof-
  {
    fix h1 h2 assume A:"h1\<in>H" "h2\<in>H"
    from A(1) obtain g1 where g1:"g1\<in>G" "f`g1=h1" using assms(1) unfolding bij_def surj_def by auto moreover
    from A(2) obtain g2 where g2:"g2\<in>G" "f`g2=h2" using assms(1) unfolding bij_def surj_def by auto ultimately
    have "F`\<langle>f`g1,f`g2\<rangle>=F`\<langle>h1,h2\<rangle>" by auto
    then have "f`(P`\<langle>g1,g2\<rangle>)=F`\<langle>h1,h2\<rangle>" using assms(2,3,4) homomor_eq g1(1) g2(1) by auto
    then have "converse(f)`(f`(P`\<langle>g1,g2\<rangle>))=converse(f)`(F`\<langle>h1,h2\<rangle>)" by auto
    then have "P`\<langle>g1,g2\<rangle>=converse(f)`(F`\<langle>h1,h2\<rangle>)" using left_inverse assms(1) group0.group_op_closed
      assms(2) g1(1) g2(1) unfolding group0_def bij_def by auto moreover
    from g1(2) have "converse(f)`(f`g1)=converse(f)`h1" by auto
    then have "g1=converse(f)`h1" using left_inverse assms(1) unfolding bij_def using g1(1) by auto moreover
    from g2(2) have "converse(f)`(f`g2)=converse(f)`h2" by auto
    then have "g2=converse(f)`h2" using left_inverse assms(1) unfolding bij_def using g2(1) by auto ultimately
    have "P`\<langle>converse(f)`h1,converse(f)`h2\<rangle>=converse(f)`(F`\<langle>h1,h2\<rangle>)" by auto
  }
  then show ?thesis using assms(2,3) Homomor_def by auto
qed

text\<open>A very important homomorphism is given by taken every element
to its class in a group quotient\<close>

lemma (in group0) quotient_map:
  assumes "IsAnormalSubgroup(G,P,H)"
  defines "r \<equiv> QuotientGroupRel(G,P,H)" and "q \<equiv> \<lambda>x\<in>G. QuotientGroupRel(G,P,H)``{x}"
  shows "Homomor(q,G,P,G//r,QuotientGroupOp(G,P,H))"
  unfolding r_def Homomor_def[OF groupAssum Group_ZF_2_4_T1[OF groupAssum assms(1)]]
proof(safe)
  fix x y assume as:"x\<in>G" "y\<in>G"
  then have "x\<cdot>y\<in>G" using group_op_closed by auto
  then have "q`(x\<cdot>y) = r``{x\<cdot>y}" unfolding q_def
    using lam_funtype lamE unfolding r_def by auto
  then have "q`(x\<cdot>y) = QuotientGroupOp(G,P,H)`\<langle>r``{x},r``{y}\<rangle>"
    using EquivClass_1_L10[OF Group_ZF_2_4_L3 _ as]
    Group_ZF_2_4_L5A[OF groupAssum assms(1)] assms(1)
    unfolding IsAnormalSubgroup_def QuotientGroupOp_def
    r_def by auto
  then show "q`(P`\<langle>x,y\<rangle>) = QuotientGroupOp(G, P, H) ` \<langle>q ` x, q ` y\<rangle>"
    unfolding q_def r_def using lam_funtype lamE as by auto
qed

text\<open>In the context of \<open>group0\<close>, we may use all results of \<open>semigr0\<close>.\<close>

sublocale group0 < semigroup:semigr0 G P groper "\<lambda>x. Fold1(P,x)" Append Concat
  unfolding semigr0_def using groupAssum IsAgroup_def IsAmonoid_def by auto

end


theory Mk_Record_Simp
imports Refine_Util Mpat_Antiquot
begin

(*
  mk_record_simp: Converts a lemma of the form
    "f s = x" to the form "r \<equiv> s \<Longrightarrow> f r = x"

  This is used to fold the x.simp - lemmas of a record x with a definition
  of the form "r \<equiv> \<lparr> ... \<rparr>".

  Usage example:
    record foo = ...
    definition c :: foo where "c \<equiv> \<lparr> ... \<rparr>"
    lemmas c_simps[simp] = foo.simps[mk_record_simp, OF c_def]
*)
lemma mk_record_simp_thm:
  fixes f :: "'a \<Rightarrow> 'b"
  assumes "f s = x"
  assumes "r \<equiv> s"
  shows "f r = x"
  using assms by simp

ML \<open>
  fun mk_record_simp context thm = let
    val ctxt = Context.proof_of context
    val cert = Thm.cterm_of ctxt
  in
    case Thm.concl_of thm of
      @{mpat "Trueprop (?f _=_)"} =>
        let
          val cf = cert f
          val r = infer_instantiate ctxt [(("f", 0), cf)] @{thm mk_record_simp_thm}
          val r = r OF [thm]
        in r end
    | _ => raise THM("",~1,[thm])

  end
\<close>

attribute_setup mk_record_simp =
  \<open>Scan.succeed (Thm.rule_attribute [] (mk_record_simp))\<close>
  "Make simplification rule for record definition"

end


(*  Title:      HOL/Proofs/Lambda/Standardization.thy
    Author:     Stefan Berghofer
    Copyright   2005 TU Muenchen
*)

section \<open>Standardization\<close>

theory Standardization
imports NormalForm
begin

text \<open>
Based on lecture notes by Ralph Matthes @{cite "Matthes-ESSLLI2000"},
original proof idea due to Ralph Loader @{cite Loader1998}.
\<close>

subsection \<open>Standard reduction relation\<close>

declare listrel_mono [mono_set]

inductive
  sred :: "dB \<Rightarrow> dB \<Rightarrow> bool"  (infixl "\<rightarrow>\<^sub>s" 50)
  and sredlist :: "dB list \<Rightarrow> dB list \<Rightarrow> bool"  (infixl "[\<rightarrow>\<^sub>s]" 50)
where
  "s [\<rightarrow>\<^sub>s] t \<equiv> listrelp (\<rightarrow>\<^sub>s) s t"
| Var: "rs [\<rightarrow>\<^sub>s] rs' \<Longrightarrow> Var x \<degree>\<degree> rs \<rightarrow>\<^sub>s Var x \<degree>\<degree> rs'"
| Abs: "r \<rightarrow>\<^sub>s r' \<Longrightarrow> ss [\<rightarrow>\<^sub>s] ss' \<Longrightarrow> Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s Abs r' \<degree>\<degree> ss'"
| Beta: "r[s/0] \<degree>\<degree> ss \<rightarrow>\<^sub>s t \<Longrightarrow> Abs r \<degree> s \<degree>\<degree> ss \<rightarrow>\<^sub>s t"

lemma refl_listrelp: "\<forall>x\<in>set xs. R x x \<Longrightarrow> listrelp R xs xs"
  by (induct xs) (auto intro: listrelp.intros)

lemma refl_sred: "t \<rightarrow>\<^sub>s t"
  by (induct t rule: Apps_dB_induct) (auto intro: refl_listrelp sred.intros)

lemma refl_sreds: "ts [\<rightarrow>\<^sub>s] ts"
  by (simp add: refl_sred refl_listrelp)

lemma listrelp_conj1: "listrelp (\<lambda>x y. R x y \<and> S x y) x y \<Longrightarrow> listrelp R x y"
  by (erule listrelp.induct) (auto intro: listrelp.intros)

lemma listrelp_conj2: "listrelp (\<lambda>x y. R x y \<and> S x y) x y \<Longrightarrow> listrelp S x y"
  by (erule listrelp.induct) (auto intro: listrelp.intros)

lemma listrelp_app:
  assumes xsys: "listrelp R xs ys"
  shows "listrelp R xs' ys' \<Longrightarrow> listrelp R (xs @ xs') (ys @ ys')" using xsys
  by (induct arbitrary: xs' ys') (auto intro: listrelp.intros)

lemma lemma1:
  assumes r: "r \<rightarrow>\<^sub>s r'" and s: "s \<rightarrow>\<^sub>s s'"
  shows "r \<degree> s \<rightarrow>\<^sub>s r' \<degree> s'" using r
proof induct
  case (Var rs rs' x)
  then have "rs [\<rightarrow>\<^sub>s] rs'" by (rule listrelp_conj1)
  moreover have "[s] [\<rightarrow>\<^sub>s] [s']" by (iprover intro: s listrelp.intros)
  ultimately have "rs @ [s] [\<rightarrow>\<^sub>s] rs' @ [s']" by (rule listrelp_app)
  hence "Var x \<degree>\<degree> (rs @ [s]) \<rightarrow>\<^sub>s Var x \<degree>\<degree> (rs' @ [s'])" by (rule sred.Var)
  thus ?case by (simp only: app_last)
next
  case (Abs r r' ss ss')
  from Abs(3) have "ss [\<rightarrow>\<^sub>s] ss'" by (rule listrelp_conj1)
  moreover have "[s] [\<rightarrow>\<^sub>s] [s']" by (iprover intro: s listrelp.intros)
  ultimately have "ss @ [s] [\<rightarrow>\<^sub>s] ss' @ [s']" by (rule listrelp_app)
  with \<open>r \<rightarrow>\<^sub>s r'\<close> have "Abs r \<degree>\<degree> (ss @ [s]) \<rightarrow>\<^sub>s Abs r' \<degree>\<degree> (ss' @ [s'])"
    by (rule sred.Abs)
  thus ?case by (simp only: app_last)
next
  case (Beta r u ss t)
  hence "r[u/0] \<degree>\<degree> (ss @ [s]) \<rightarrow>\<^sub>s t \<degree> s'" by (simp only: app_last)
  hence "Abs r \<degree> u \<degree>\<degree> (ss @ [s]) \<rightarrow>\<^sub>s t \<degree> s'" by (rule sred.Beta)
  thus ?case by (simp only: app_last)
qed

lemma lemma1':
  assumes ts: "ts [\<rightarrow>\<^sub>s] ts'"
  shows "r \<rightarrow>\<^sub>s r' \<Longrightarrow> r \<degree>\<degree> ts \<rightarrow>\<^sub>s r' \<degree>\<degree> ts'" using ts
  by (induct arbitrary: r r') (auto intro: lemma1)

lemma lemma2_1:
  assumes beta: "t \<rightarrow>\<^sub>\<beta> u"
  shows "t \<rightarrow>\<^sub>s u" using beta
proof induct
  case (beta s t)
  have "Abs s \<degree> t \<degree>\<degree> [] \<rightarrow>\<^sub>s s[t/0] \<degree>\<degree> []" by (iprover intro: sred.Beta refl_sred)
  thus ?case by simp
next
  case (appL s t u)
  thus ?case by (iprover intro: lemma1 refl_sred)
next
  case (appR s t u)
  thus ?case by (iprover intro: lemma1 refl_sred)
next
  case (abs s t)
  hence "Abs s \<degree>\<degree> [] \<rightarrow>\<^sub>s Abs t \<degree>\<degree> []" by (iprover intro: sred.Abs listrelp.Nil)
  thus ?case by simp
qed

lemma listrelp_betas:
  assumes ts: "listrelp (\<rightarrow>\<^sub>\<beta>\<^sup>*) ts ts'"
  shows "\<And>t t'. t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<Longrightarrow> t \<degree>\<degree> ts \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<degree>\<degree> ts'" using ts
  by induct auto

lemma lemma2_2:
  assumes t: "t \<rightarrow>\<^sub>s u"
  shows "t \<rightarrow>\<^sub>\<beta>\<^sup>* u" using t
  by induct (auto dest: listrelp_conj2
    intro: listrelp_betas apps_preserves_beta converse_rtranclp_into_rtranclp)

lemma sred_lift:
  assumes s: "s \<rightarrow>\<^sub>s t"
  shows "lift s i \<rightarrow>\<^sub>s lift t i" using s
proof (induct arbitrary: i)
  case (Var rs rs' x)
  hence "map (\<lambda>t. lift t i) rs [\<rightarrow>\<^sub>s] map (\<lambda>t. lift t i) rs'"
    by induct (auto intro: listrelp.intros)
  thus ?case by (cases "x < i") (auto intro: sred.Var)
next
  case (Abs r r' ss ss')
  from Abs(3) have "map (\<lambda>t. lift t i) ss [\<rightarrow>\<^sub>s] map (\<lambda>t. lift t i) ss'"
    by induct (auto intro: listrelp.intros)
  thus ?case by (auto intro: sred.Abs Abs)
next
  case (Beta r s ss t)
  thus ?case by (auto intro: sred.Beta)
qed

lemma lemma3:
  assumes r: "r \<rightarrow>\<^sub>s r'"
  shows "s \<rightarrow>\<^sub>s s' \<Longrightarrow> r[s/x] \<rightarrow>\<^sub>s r'[s'/x]" using r
proof (induct arbitrary: s s' x)
  case (Var rs rs' y)
  hence "map (\<lambda>t. t[s/x]) rs [\<rightarrow>\<^sub>s] map (\<lambda>t. t[s'/x]) rs'"
    by induct (auto intro: listrelp.intros Var)
  moreover have "Var y[s/x] \<rightarrow>\<^sub>s Var y[s'/x]"
  proof (cases "y < x")
    case True thus ?thesis by simp (rule refl_sred)
  next
    case False
    thus ?thesis
      by (cases "y = x") (auto simp add: Var intro: refl_sred)
  qed
  ultimately show ?case by simp (rule lemma1')
next
  case (Abs r r' ss ss')
  from Abs(4) have "lift s 0 \<rightarrow>\<^sub>s lift s' 0" by (rule sred_lift)
  hence "r[lift s 0/Suc x] \<rightarrow>\<^sub>s r'[lift s' 0/Suc x]" by (fast intro: Abs.hyps)
  moreover from Abs(3) have "map (\<lambda>t. t[s/x]) ss [\<rightarrow>\<^sub>s] map (\<lambda>t. t[s'/x]) ss'"
    by induct (auto intro: listrelp.intros Abs)
  ultimately show ?case by simp (rule sred.Abs)
next
  case (Beta r u ss t)
  thus ?case by (auto simp add: subst_subst intro: sred.Beta)
qed

lemma lemma4_aux:
  assumes rs: "listrelp (\<lambda>t u. t \<rightarrow>\<^sub>s u \<and> (\<forall>r. u \<rightarrow>\<^sub>\<beta> r \<longrightarrow> t \<rightarrow>\<^sub>s r)) rs rs'"
  shows "rs' => ss \<Longrightarrow> rs [\<rightarrow>\<^sub>s] ss" using rs
proof (induct arbitrary: ss)
  case Nil
  thus ?case by cases (auto intro: listrelp.Nil)
next
  case (Cons x y xs ys)
  note Cons' = Cons
  show ?case
  proof (cases ss)
    case Nil with Cons show ?thesis by simp
  next
    case (Cons y' ys')
    hence ss: "ss = y' # ys'" by simp
    from Cons Cons' have "y \<rightarrow>\<^sub>\<beta> y' \<and> ys' = ys \<or> y' = y \<and> ys => ys'" by simp
    hence "x # xs [\<rightarrow>\<^sub>s] y' # ys'"
    proof
      assume H: "y \<rightarrow>\<^sub>\<beta> y' \<and> ys' = ys"
      with Cons' have "x \<rightarrow>\<^sub>s y'" by blast
      moreover from Cons' have "xs [\<rightarrow>\<^sub>s] ys" by (iprover dest: listrelp_conj1)
      ultimately have "x # xs [\<rightarrow>\<^sub>s] y' # ys" by (rule listrelp.Cons)
      with H show ?thesis by simp
    next
      assume H: "y' = y \<and> ys => ys'"
      with Cons' have "x \<rightarrow>\<^sub>s y'" by blast
      moreover from H have "xs [\<rightarrow>\<^sub>s] ys'" by (blast intro: Cons')
      ultimately show ?thesis by (rule listrelp.Cons)
    qed
    with ss show ?thesis by simp
  qed
qed

lemma lemma4:
  assumes r: "r \<rightarrow>\<^sub>s r'"
  shows "r' \<rightarrow>\<^sub>\<beta> r'' \<Longrightarrow> r \<rightarrow>\<^sub>s r''" using r
proof (induct arbitrary: r'')
  case (Var rs rs' x)
  then obtain ss where rs: "rs' => ss" and r'': "r'' = Var x \<degree>\<degree> ss"
    by (blast dest: head_Var_reduction)
  from Var(1) rs have "rs [\<rightarrow>\<^sub>s] ss" by (rule lemma4_aux)
  hence "Var x \<degree>\<degree> rs \<rightarrow>\<^sub>s Var x \<degree>\<degree> ss" by (rule sred.Var)
  with r'' show ?case by simp
next
  case (Abs r r' ss ss')
  from \<open>Abs r' \<degree>\<degree> ss' \<rightarrow>\<^sub>\<beta> r''\<close> show ?case
  proof
    fix s
    assume r'': "r'' = s \<degree>\<degree> ss'"
    assume "Abs r' \<rightarrow>\<^sub>\<beta> s"
    then obtain r''' where s: "s = Abs r'''" and r''': "r' \<rightarrow>\<^sub>\<beta> r'''" by cases auto
    from r''' have "r \<rightarrow>\<^sub>s r'''" by (blast intro: Abs)
    moreover from Abs have "ss [\<rightarrow>\<^sub>s] ss'" by (iprover dest: listrelp_conj1)
    ultimately have "Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s Abs r''' \<degree>\<degree> ss'" by (rule sred.Abs)
    with r'' s show "Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s r''" by simp
  next
    fix rs'
    assume "ss' => rs'"
    with Abs(3) have "ss [\<rightarrow>\<^sub>s] rs'" by (rule lemma4_aux)
    with \<open>r \<rightarrow>\<^sub>s r'\<close> have "Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s Abs r' \<degree>\<degree> rs'" by (rule sred.Abs)
    moreover assume "r'' = Abs r' \<degree>\<degree> rs'"
    ultimately show "Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s r''" by simp
  next
    fix t u' us'
    assume "ss' = u' # us'"
    with Abs(3) obtain u us where
      ss: "ss = u # us" and u: "u \<rightarrow>\<^sub>s u'" and us: "us [\<rightarrow>\<^sub>s] us'"
      by cases (auto dest!: listrelp_conj1)
    have "r[u/0] \<rightarrow>\<^sub>s r'[u'/0]" using Abs(1) and u by (rule lemma3)
    with us have "r[u/0] \<degree>\<degree> us \<rightarrow>\<^sub>s r'[u'/0] \<degree>\<degree> us'" by (rule lemma1')
    hence "Abs r \<degree> u \<degree>\<degree> us \<rightarrow>\<^sub>s r'[u'/0] \<degree>\<degree> us'" by (rule sred.Beta)
    moreover assume "Abs r' = Abs t" and "r'' = t[u'/0] \<degree>\<degree> us'"
    ultimately show "Abs r \<degree>\<degree> ss \<rightarrow>\<^sub>s r''" using ss by simp
  qed
next
  case (Beta r s ss t)
  show ?case
    by (rule sred.Beta) (rule Beta)+
qed

lemma rtrancl_beta_sred:
  assumes r: "r \<rightarrow>\<^sub>\<beta>\<^sup>* r'"
  shows "r \<rightarrow>\<^sub>s r'" using r
  by induct (iprover intro: refl_sred lemma4)+

subsection \<open>Leftmost reduction and weakly normalizing terms\<close>

inductive
  lred :: "dB \<Rightarrow> dB \<Rightarrow> bool"  (infixl "\<rightarrow>\<^sub>l" 50)
  and lredlist :: "dB list \<Rightarrow> dB list \<Rightarrow> bool"  (infixl "[\<rightarrow>\<^sub>l]" 50)
where
  "s [\<rightarrow>\<^sub>l] t \<equiv> listrelp (\<rightarrow>\<^sub>l) s t"
| Var: "rs [\<rightarrow>\<^sub>l] rs' \<Longrightarrow> Var x \<degree>\<degree> rs \<rightarrow>\<^sub>l Var x \<degree>\<degree> rs'"
| Abs: "r \<rightarrow>\<^sub>l r' \<Longrightarrow> Abs r \<rightarrow>\<^sub>l Abs r'"
| Beta: "r[s/0] \<degree>\<degree> ss \<rightarrow>\<^sub>l t \<Longrightarrow> Abs r \<degree> s \<degree>\<degree> ss \<rightarrow>\<^sub>l t"

lemma lred_imp_sred:
  assumes lred: "s \<rightarrow>\<^sub>l t"
  shows "s \<rightarrow>\<^sub>s t" using lred
proof induct
  case (Var rs rs' x)
  then have "rs [\<rightarrow>\<^sub>s] rs'"
    by induct (iprover intro: listrelp.intros)+
  then show ?case by (rule sred.Var)
next
  case (Abs r r')
  from \<open>r \<rightarrow>\<^sub>s r'\<close>
  have "Abs r \<degree>\<degree> [] \<rightarrow>\<^sub>s Abs r' \<degree>\<degree> []" using listrelp.Nil
    by (rule sred.Abs)
  then show ?case by simp
next
  case (Beta r s ss t)
  from \<open>r[s/0] \<degree>\<degree> ss \<rightarrow>\<^sub>s t\<close>
  show ?case by (rule sred.Beta)
qed

inductive WN :: "dB => bool"
  where
    Var: "listsp WN rs \<Longrightarrow> WN (Var n \<degree>\<degree> rs)"
  | Lambda: "WN r \<Longrightarrow> WN (Abs r)"
  | Beta: "WN ((r[s/0]) \<degree>\<degree> ss) \<Longrightarrow> WN ((Abs r \<degree> s) \<degree>\<degree> ss)"

lemma listrelp_imp_listsp1:
  assumes H: "listrelp (\<lambda>x y. P x) xs ys"
  shows "listsp P xs" using H
  by induct auto

lemma listrelp_imp_listsp2:
  assumes H: "listrelp (\<lambda>x y. P y) xs ys"
  shows "listsp P ys" using H
  by induct auto

lemma lemma5:
  assumes lred: "r \<rightarrow>\<^sub>l r'"
  shows "WN r" and "NF r'" using lred
  by induct
    (iprover dest: listrelp_conj1 listrelp_conj2
     listrelp_imp_listsp1 listrelp_imp_listsp2 intro: WN.intros
     NF.intros [simplified listall_listsp_eq])+

lemma lemma6:
  assumes wn: "WN r"
  shows "\<exists>r'. r \<rightarrow>\<^sub>l r'" using wn
proof induct
  case (Var rs n)
  then have "\<exists>rs'. rs [\<rightarrow>\<^sub>l] rs'"
    by induct (iprover intro: listrelp.intros)+
  then show ?case by (iprover intro: lred.Var)
qed (iprover intro: lred.intros)+

lemma lemma7:
  assumes r: "r \<rightarrow>\<^sub>s r'"
  shows "NF r' \<Longrightarrow> r \<rightarrow>\<^sub>l r'" using r
proof induct
  case (Var rs rs' x)
  from \<open>NF (Var x \<degree>\<degree> rs')\<close> have "listall NF rs'"
    by cases simp_all
  with Var(1) have "rs [\<rightarrow>\<^sub>l] rs'"
  proof induct
    case Nil
    show ?case by (rule listrelp.Nil)
  next
    case (Cons x y xs ys)
    hence "x \<rightarrow>\<^sub>l y" and "xs [\<rightarrow>\<^sub>l] ys" by simp_all
    thus ?case by (rule listrelp.Cons)
  qed
  thus ?case by (rule lred.Var)
next
  case (Abs r r' ss ss')
  from \<open>NF (Abs r' \<degree>\<degree> ss')\<close>
  have ss': "ss' = []" by (rule Abs_NF)
  from Abs(3) have ss: "ss = []" using ss'
    by cases simp_all
  from ss' Abs have "NF (Abs r')" by simp
  hence "NF r'" by cases simp_all
  with Abs have "r \<rightarrow>\<^sub>l r'" by simp
  hence "Abs r \<rightarrow>\<^sub>l Abs r'" by (rule lred.Abs)
  with ss ss' show ?case by simp
next
  case (Beta r s ss t)
  hence "r[s/0] \<degree>\<degree> ss \<rightarrow>\<^sub>l t" by simp
  thus ?case by (rule lred.Beta)
qed

lemma WN_eq: "WN t = (\<exists>t'. t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<and> NF t')"
proof
  assume "WN t"
  then have "\<exists>t'. t \<rightarrow>\<^sub>l t'" by (rule lemma6)
  then obtain t' where t': "t \<rightarrow>\<^sub>l t'" ..
  then have NF: "NF t'" by (rule lemma5)
  from t' have "t \<rightarrow>\<^sub>s t'" by (rule lred_imp_sred)
  then have "t \<rightarrow>\<^sub>\<beta>\<^sup>* t'" by (rule lemma2_2)
  with NF show "\<exists>t'. t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<and> NF t'" by iprover
next
  assume "\<exists>t'. t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<and> NF t'"
  then obtain t' where t': "t \<rightarrow>\<^sub>\<beta>\<^sup>* t'" and NF: "NF t'"
    by iprover
  from t' have "t \<rightarrow>\<^sub>s t'" by (rule rtrancl_beta_sred)
  then have "t \<rightarrow>\<^sub>l t'" using NF by (rule lemma7)
  then show "WN t" by (rule lemma5)
qed

end


subsection\<open>Transforming SC proofs into proofs of CNFs\<close>
theory LSC
imports CNF_Formulas SC_Cut
begin

text\<open>Left handed SC with NNF transformation:\<close>
inductive LSC ("(_ \<Rightarrow>\<^sub>n)" [53]) where
\<comment> \<open>logic:\<close>
Ax: "\<^bold>\<not>(Atom k),Atom k,\<Gamma> \<Rightarrow>\<^sub>n" |
BotL: "\<bottom>,\<Gamma> \<Rightarrow>\<^sub>n" |
AndL: "F,G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F\<^bold>\<and>G,\<Gamma> \<Rightarrow>\<^sub>n" |
OrL: "F,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F\<^bold>\<or>G,\<Gamma> \<Rightarrow>\<^sub>n" |
\<comment> \<open>nnf rules:\<close>
NotOrNNF: "\<^bold>\<not>F,\<^bold>\<not>G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>(F\<^bold>\<or>G),\<Gamma> \<Rightarrow>\<^sub>n" |
NotAndNNF: "\<^bold>\<not>F,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>(F\<^bold>\<and>G),\<Gamma> \<Rightarrow>\<^sub>n" |
ImpNNF: "\<^bold>\<not>F,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F\<^bold>\<rightarrow>G,\<Gamma> \<Rightarrow>\<^sub>n" |
NotImpNNF: "F,\<^bold>\<not>G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>(F\<^bold>\<rightarrow>G),\<Gamma> \<Rightarrow>\<^sub>n" |
NotNotNNF: "F,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>(\<^bold>\<not>F),\<Gamma> \<Rightarrow>\<^sub>n"
lemmas LSC.intros[intro!]
text\<open>You can prove that derivability in @{const SCp} is invariant to @{const nnf},
and then transform @{const SCp} to @{const LSC} while assuming NNF.
However, the transformation introduces the trouble of handling the right side of @{const SCp}.
The idea behind this is that handling the transformation is easier when not requiring NNF.\<close>

text\<open>One downside of the whole approach is that we often need everything to be in NNF. To shorten:\<close>
abbreviation "is_nnf_mset \<Gamma> \<equiv> \<forall>x \<in> set_mset \<Gamma>. is_nnf x"

lemma "\<Gamma> \<Rightarrow> {#} \<Longrightarrow> is_nnf_mset \<Gamma> \<Longrightarrow> \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction \<Gamma> "{#}::'a formula multiset " rule: SCp.induct)
  case (BotL \<Gamma>)
  then obtain \<Gamma>' where "\<Gamma> = \<bottom>,\<Gamma>'" by(meson multi_member_split)
  thus ?case by auto
next
  case (Ax A \<Gamma>) hence False by simp thus ?case ..
  (* this case makes you think that there's something wrong with this proof *)
next
  case (AndL \<Gamma> F G)
  hence IH: "\<Gamma>, F, G \<Rightarrow>\<^sub>n" by force
  thus ?case by auto
next
  case (NotL) thus ?case
  (* this demonstrates it *)
oops

lemma LSC_to_SC:
  shows "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<Gamma> \<Rightarrow> {#}"
proof(induction rule: LSC.induct)
qed (auto dest!: NotL_inv intro!: SCp.intros(3-) intro: extended_Ax)

lemma SC_to_LSC:
  assumes "\<Gamma> \<Rightarrow> \<Delta>"
  shows "\<Gamma> + (image_mset Not \<Delta>) \<Rightarrow>\<^sub>n"
proof -
  have GO[simp]:
    "NO_MATCH {# B #} F \<Longrightarrow> (F,S) + T = F, (S+T)"
    "NO_MATCH {# B #} S \<Longrightarrow> S + (F,T) = F, (S+T)"
    "NO_MATCH (\<^bold>\<not>H) F \<Longrightarrow> F,\<^bold>\<not>G,S = \<^bold>\<not>G,F,S"
    for B S F G H T by simp_all
  from assms show ?thesis
  proof(induction rule: SCp.induct)
    case (BotL \<Gamma>)
    then obtain \<Gamma>' where "\<Gamma> = \<bottom>,\<Gamma>'" by(meson multi_member_split)
    thus ?case by auto
  next
    case (Ax k \<Gamma> \<Delta>)
    then obtain \<Gamma>' \<Delta>' where "\<Gamma> = Atom k, \<Gamma>'" "\<Delta> = Atom k, \<Delta>'" by(meson multi_member_split)
    thus ?case using LSC.Ax by simp
  qed auto
qed

corollary SC_LSC: "\<Gamma> \<Rightarrow> {#} \<longleftrightarrow> \<Gamma> \<Rightarrow>\<^sub>n" using SC_to_LSC LSC_to_SC by fastforce

text\<open>The nice thing: The NNF-Transformation is even easier to show on the one-sided variant.\<close>
(* part of that is because it is written down in a way that is easier to tackle for the solvers *)
lemma LSC_NNF: "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction rule: LSC.induct)
  (* auto solved all, but I want to know what's going on. *)
  case (NotOrNNF F G \<Gamma>)
  from NotOrNNF.IH have "nnf (\<^bold>\<not> F), nnf (\<^bold>\<not> G), image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n" by simp
  with LSC.AndL have "nnf (\<^bold>\<not> F) \<^bold>\<and> nnf (\<^bold>\<not> G), image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n" .
  thus ?case by simp
next
  case (AndL F G \<Gamma>)
  from AndL.IH have "nnf F, nnf G, image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n" by simp
  with LSC.AndL[where 'a='a] have "nnf F \<^bold>\<and> nnf G, image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n" by simp
  thus ?case by simp
next
qed (auto, metis add_mset_commute)

lemma LSC_NNF_back: "image_mset nnf \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction "image_mset nnf \<Gamma>" rule: LSC.induct)
oops
(* should be possible, but I don't need it. *)

text\<open>If we got rid of the rules for NNF, we could call it Gentzen-Schütte-calculus. But it turned out that not doing that works quite fine.\<close>

text\<open>If you stare at left-handed Sequent calcului for too long, and they start staring back:
Try imagining that there is a @{term \<bottom>} on the right hand side.
Also, bear in mind that provability of @{term "\<Gamma> \<Rightarrow>\<^sub>n"} and satisfiability of @{term "\<Gamma>"} are opposites here.\<close>

lemma
 shows LSC_AndL_inv: "F\<^bold>\<and>G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F,G,\<Gamma> \<Rightarrow>\<^sub>n"
 and   LSC_OrL_inv: "F\<^bold>\<or>G,\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F,\<Gamma> \<Rightarrow>\<^sub>n \<and> G,\<Gamma> \<Rightarrow>\<^sub>n"
 using SC_LSC AndL_inv OrL_inv by blast+
lemmas LSC_invs = LSC_AndL_inv LSC_OrL_inv
(* these are actually suitable as dest rules. But the proofs are usually slow, so I'd rather not. *)

(* direct proof is easy here and it saves us the hassle of the nnf-assumption *)
lemma LSC_weaken_set: "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<Gamma> + \<Theta> \<Rightarrow>\<^sub>n"
  by(induction rule: LSC.induct) (auto simp: add.assoc)
lemma LSC_weaken: "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> F,\<Gamma> \<Rightarrow>\<^sub>n"
  using LSC_weaken_set by (metis add_mset_add_single)

lemma LSC_Contract:
  assumes sfp: "F, F, \<Gamma> \<Rightarrow>\<^sub>n"
  shows "F, \<Gamma> \<Rightarrow>\<^sub>n"
  using SC_LSC contractL sfp by blast

lemma cnf:
  shows
    "F \<^bold>\<or> (G \<^bold>\<and> H), \<Gamma> \<Rightarrow>\<^sub>n \<longleftrightarrow> (F \<^bold>\<or> G) \<^bold>\<and> (F \<^bold>\<or> H), \<Gamma> \<Rightarrow>\<^sub>n" (is "?l1 \<longleftrightarrow> ?r1")
    "(G \<^bold>\<and> H) \<^bold>\<or> F, \<Gamma> \<Rightarrow>\<^sub>n \<longleftrightarrow> (G \<^bold>\<or> F) \<^bold>\<and> (H \<^bold>\<or> F), \<Gamma> \<Rightarrow>\<^sub>n" (is "?l2 \<longleftrightarrow> ?r2")
proof -
  have GO(* get out *)[simp]:
    "F,G,S \<Rightarrow>\<^sub>n \<Longrightarrow> G,F,S \<Rightarrow>\<^sub>n"
    for F G :: "'a formula" and S by (simp add: add_mset_commute)
  have ?r1 if ?l1 proof -
    from \<open>?l1\<close>[THEN LSC_invs(2)] have f: "F, \<Gamma> \<Rightarrow>\<^sub>n" "G \<^bold>\<and> H, \<Gamma> \<Rightarrow>\<^sub>n" by simp_all
    from this(2)[THEN LSC_invs(1)] have gh: "G, H, \<Gamma> \<Rightarrow>\<^sub>n" by simp
    show ?r1 using f gh by(auto dest!: LSC_invs simp: LSC_weaken)
  qed
  moreover have ?r2 if ?l2 proof -
    from \<open>?l2\<close> have f: "F, \<Gamma> \<Rightarrow>\<^sub>n" "G, H, \<Gamma> \<Rightarrow>\<^sub>n" by(auto dest!: LSC_invs)
    thus ?r2  by(auto dest!: LSC_invs simp: LSC_weaken)
  qed
  moreover have ?l1 if ?r1 proof -
    from \<open>?r1\<close>[THEN LSC_invs(1)] have *: "F \<^bold>\<or> G, F \<^bold>\<or> H, \<Gamma> \<Rightarrow>\<^sub>n" by simp
    hence "F, \<Gamma> \<Rightarrow>\<^sub>n" "G, H, \<Gamma> \<Rightarrow>\<^sub>n" by (auto elim!: LSC_Contract dest!: LSC_invs)
    thus ?l1 by(intro LSC.intros)
  qed
  moreover have ?l2 if ?r2 proof -
    from \<open>?r2\<close>[THEN LSC_invs(1)] have *: "G \<^bold>\<or> F, H \<^bold>\<or> F, \<Gamma> \<Rightarrow>\<^sub>n" by simp
    hence "F, \<Gamma> \<Rightarrow>\<^sub>n" "G, H, \<Gamma> \<Rightarrow>\<^sub>n" by(auto elim!: LSC_Contract dest!: LSC_invs)
    thus ?l2 by(intro LSC.intros)
  qed
  ultimately show "?l1 \<longleftrightarrow> ?r1" "?l2 \<longleftrightarrow> ?r2" by argo+
qed

text\<open>
  Interestingly, the DNF congruences are a lot easier to show, requiring neither weakening nor contraction.
  The reasons are to be sought in the asymmetries between the rules for @{const And} and @{const Or}.
\<close>
lemma dnf:
  shows
    "F \<^bold>\<and> (G \<^bold>\<or> H), \<Gamma> \<Rightarrow>\<^sub>n \<longleftrightarrow> (F \<^bold>\<and> G) \<^bold>\<or> (F \<^bold>\<and> H), \<Gamma> \<Rightarrow>\<^sub>n" (is "?t1")
    "(G \<^bold>\<or> H) \<^bold>\<and> F, \<Gamma> \<Rightarrow>\<^sub>n \<longleftrightarrow> (G \<^bold>\<and> F) \<^bold>\<or> (H \<^bold>\<and> F), \<Gamma> \<Rightarrow>\<^sub>n" (is "?t2")
proof -
    have GO(* get out *)[simp]:
    "F,G,S \<Rightarrow>\<^sub>n \<Longrightarrow> G,F,S \<Rightarrow>\<^sub>n"
    for F G H I J S by(simp_all add: add_mset_commute)
    show ?t1 ?t2 by(auto dest!: LSC_invs)
qed

lemma LSC_sim_Resolution1:
  assumes R: "S \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n"
  shows "Atom k \<^bold>\<or> S, (\<^bold>\<not>(Atom k)) \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n"
proof -
  from R have r: "T, \<Gamma> \<Rightarrow>\<^sub>n" "S, \<Gamma> \<Rightarrow>\<^sub>n" by(auto dest: LSC_invs)
  show ?thesis proof(rule LHCut[where F="Atom k"])
    have 2: "T, Atom k, Atom k \<^bold>\<or> S, \<Gamma> \<Rightarrow>\<^sub>n" using LSC_weaken r(1) by auto
    hence " \<^bold>\<not> (Atom k) \<^bold>\<or> T, Atom k, Atom k \<^bold>\<or> S, \<Gamma> \<Rightarrow>\<^sub>n" by auto
    thus "Atom k, Atom k \<^bold>\<or> S, \<^bold>\<not> (Atom k) \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n"
      by(auto dest!: LSC_invs) (metis add_mset_commute)
  next text\<open>analogously\<close>(*<*)
    have 2: "S, \<^bold>\<not>(Atom k), \<^bold>\<not>(Atom k) \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n" using LSC_weaken r(2) by auto
    hence "Atom k \<^bold>\<or> S, \<^bold>\<not> (Atom k), \<^bold>\<not> (Atom k) \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n" using LSC_weaken
      by(auto dest!: LSC_invs) blast
    from this (*>*)
    show "\<^bold>\<not> (Atom k), Atom k \<^bold>\<or> S, \<^bold>\<not> (Atom k) \<^bold>\<or> T, \<Gamma> \<Rightarrow>\<^sub>n" by simp
  qed
qed

lemma
  LSC_need_it_once_have_many:
  assumes el: "A \<in> set F"
  assumes once: "form_of_lit A \<^bold>\<or> disj_of_clause (removeAll A F),\<Gamma> \<Rightarrow>\<^sub>n"
  shows "disj_of_clause F,\<Gamma> \<Rightarrow>\<^sub>n"
using assms
proof(induction F)
  case Nil hence False by simp thus ?case ..
next (* there might be a smarter way to prove this by splitting F into two lists\<dots> but nah. *)
  case (Cons f F)
  thus ?case proof(cases "A = f")
    case True
    with Cons.prems have ihm: "form_of_lit A \<^bold>\<or> disj_of_clause (removeAll A F), \<Gamma> \<Rightarrow>\<^sub>n" by simp
    with True have split: "form_of_lit f, \<Gamma> \<Rightarrow>\<^sub>n" "disj_of_clause (removeAll A F), \<Gamma> \<Rightarrow>\<^sub>n"
      by (auto dest!: LSC_invs(2))
    from Cons.IH[OF _ ihm] have "A \<in> set F \<Longrightarrow> disj_of_clause F, \<Gamma> \<Rightarrow>\<^sub>n" .
    with split(2) have "disj_of_clause F, \<Gamma> \<Rightarrow>\<^sub>n" by(cases "A \<in> set F") simp_all
    with split(1) show ?thesis by auto
  next
    case False
    with Cons.prems(2) have prem: "form_of_lit A, \<Gamma> \<Rightarrow>\<^sub>n" "form_of_lit f, \<Gamma> \<Rightarrow>\<^sub>n" "disj_of_clause (removeAll A F), \<Gamma> \<Rightarrow>\<^sub>n"
       by (auto dest!: LSC_invs(2))
    hence d: "form_of_lit A \<^bold>\<or> disj_of_clause (removeAll A F), \<Gamma> \<Rightarrow>\<^sub>n" by blast
    from False Cons.prems have el: "A \<in> set F"  by simp
    from Cons.IH[OF el d] have "disj_of_clause F, \<Gamma> \<Rightarrow>\<^sub>n" .
    with prem(2) show ?thesis by auto
 qed
qed

(* LSC_sim_Resolution1 is the naive summer child that requires everything to be in the right order. Here comes the real fun *)
lemma LSC_Sim_resolution_la:
  fixes k :: 'a
  assumes R: "disj_of_clause (removeAll (k\<^sup>+) F @ removeAll (k\<inverse>) G), \<Gamma> \<Rightarrow>\<^sub>n"
  assumes el: "k\<^sup>+ \<in> set F" "k\<inverse> \<in> set G"
  shows "disj_of_clause F, disj_of_clause G, \<Gamma> \<Rightarrow>\<^sub>n"
proof -
  have LSC_or_assoc: "(F \<^bold>\<or> G) \<^bold>\<or> H, \<Gamma> \<Rightarrow>\<^sub>n \<longleftrightarrow> F \<^bold>\<or> (G \<^bold>\<or> H), \<Gamma> \<Rightarrow>\<^sub>n" if "is_nnf F" "is_nnf G" "is_nnf H" for F G H
    using that by(auto dest!: LSC_invs(2))
  have dd: "disj_of_clause (F @ G), \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> disj_of_clause F \<^bold>\<or> disj_of_clause G, \<Gamma> \<Rightarrow>\<^sub>n" for F G
    by(induction F) (auto dest!: LSC_invs(2) simp add: LSC_or_assoc)
  from LSC_sim_Resolution1[OF dd[OF R]]
  have unord: "Atom k \<^bold>\<or> disj_of_clause (removeAll (k\<^sup>+) F), \<^bold>\<not> (Atom k) \<^bold>\<or> disj_of_clause (removeAll (k\<inverse>) G), \<Gamma> \<Rightarrow>\<^sub>n" .
  show ?thesis
    using LSC_need_it_once_have_many[OF el(1)] LSC_need_it_once_have_many[OF el(2)] unord
    by(simp add: add_mset_commute del: sc_insertion_ordering)
qed

lemma two_list_induct[case_names Nil Cons]: "P [] [] \<Longrightarrow> (\<And>a S T. P S T \<Longrightarrow> P (a # S) T &&& P S (a # T)) \<Longrightarrow> P S T"
  apply(induction S)
   apply(induction T)
    apply(simp_all)
done

lemma distrib1: "\<lbrakk>F, \<Gamma> \<Rightarrow>\<^sub>n; image_mset disj_of_clause (mset G) + \<Gamma> \<Rightarrow>\<^sub>n\<rbrakk>
    \<Longrightarrow> mset (map (\<lambda>d. F \<^bold>\<or> disj_of_clause d) G) + \<Gamma> \<Rightarrow>\<^sub>n"
(* surprisingly, the proof having a \<^bold>\<and> instead of the \<^bold>\<or> looks very similar. Yes, I mistook the two at some point\<dots> and downstream, where this is used, I only had to do a few text replacements. makes you really wonder whether what you're proving is meaningful. *)
proof(induction G arbitrary: \<Gamma>)
  have GO(* get out *)[simp]:
   "NO_MATCH ({#I\<^bold>\<or>J#}) H \<Longrightarrow> H+{#F\<^bold>\<or>G#}+S = F\<^bold>\<or>G,H+S"
   for F G H S I J by(simp_all add: add_mset_commute)
  case (Cons g G)
  from \<open>F, \<Gamma> \<Rightarrow>\<^sub>n\<close> have 1: "F, disj_of_clause g, \<Gamma> \<Rightarrow>\<^sub>n" by (metis LSC_weaken add_mset_commute)
  from \<open>image_mset disj_of_clause (mset (g # G)) + \<Gamma> \<Rightarrow>\<^sub>n\<close>
  have 2: "image_mset disj_of_clause (mset G) + (disj_of_clause g, \<Gamma>) \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
  from Cons.IH[OF 1 2] have IH: "disj_of_clause g, mset (map (\<lambda>d. F \<^bold>\<or> disj_of_clause d) G) + \<Gamma> \<Rightarrow>\<^sub>n"
    by(simp add: add_mset_commute)
  from \<open>F, \<Gamma> \<Rightarrow>\<^sub>n\<close> have 3: "F, mset (map (\<lambda>d. F \<^bold>\<or> disj_of_clause d) G) + \<Gamma> \<Rightarrow>\<^sub>n"
    using LSC_weaken_set by (metis add.assoc add.commute add_mset_add_single)
  from IH 3 show ?case by auto
qed simp

lemma mset_concat_map_cons:
  "mset (concat (map (\<lambda>c. F c # G c) S)) = mset (map F S) + mset (concat (map G S))"
by(induction S; simp add: add_mset_commute)

lemma distrib: "
  image_mset disj_of_clause (mset F) + \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow>
  image_mset disj_of_clause (mset G) + \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow>
  mset [disj_of_clause c \<^bold>\<or> disj_of_clause d. c \<leftarrow> F, d \<leftarrow> G] + \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction F G arbitrary: \<Gamma> rule: two_list_induct)
  case (Cons a F G)
  case 1
  from \<open>image_mset disj_of_clause (mset (a # F)) + \<Gamma> \<Rightarrow>\<^sub>n\<close>
  have a: "disj_of_clause a, image_mset disj_of_clause (mset F) + \<Gamma> \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
  from \<open>image_mset disj_of_clause (mset G) + \<Gamma> \<Rightarrow>\<^sub>n\<close>
  have b: "image_mset disj_of_clause (mset G) + (image_mset disj_of_clause (mset F) + \<Gamma>) \<Rightarrow>\<^sub>n"
   and c: "image_mset disj_of_clause (mset G) + (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) G) + \<Gamma>) \<Rightarrow>\<^sub>n"
    using LSC_weaken_set by (metis add.commute union_assoc)+
  from distrib1[OF a b]
  have "image_mset disj_of_clause (mset F) + (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) G) + \<Gamma>) \<Rightarrow>\<^sub>n"
    by (simp add: union_lcomm)
  from Cons[OF this c]
  have "mset (concat (map (\<lambda>c. map (\<lambda>d. disj_of_clause c \<^bold>\<or> disj_of_clause d) G) F)) +
  (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) G) + \<Gamma>) \<Rightarrow>\<^sub>n" .
  thus ?case by(simp add: add.commute union_assoc)
next
  case (Cons a F G) case 2 text\<open>Just the whole thing again, with slightly more mset magic and swapping things around.\<close>
  from \<open>image_mset disj_of_clause (mset (a # G)) + \<Gamma> \<Rightarrow>\<^sub>n\<close>
  have a: "disj_of_clause a, image_mset disj_of_clause (mset G) + \<Gamma> \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
  from \<open>image_mset disj_of_clause (mset F) + \<Gamma> \<Rightarrow>\<^sub>n\<close>
  have b: "image_mset disj_of_clause (mset F) + (image_mset disj_of_clause (mset G) + \<Gamma>) \<Rightarrow>\<^sub>n"
   and c: "image_mset disj_of_clause (mset F) + (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma>) \<Rightarrow>\<^sub>n"
    using LSC_weaken_set by (metis add.commute union_assoc)+
  have list_commute: "(mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma>) \<Rightarrow>\<^sub>n =
  (mset (map (\<lambda>d. disj_of_clause d \<^bold>\<or> disj_of_clause a) F) + \<Gamma>) \<Rightarrow>\<^sub>n" for \<Gamma>
  proof(induction F arbitrary: \<Gamma>) (* meh, I should have only prooved one direction, would have been easier *)
    case (Cons f F)
    have "mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) (f # F)) + \<Gamma> \<Rightarrow>\<^sub>n =
      disj_of_clause a \<^bold>\<or> disj_of_clause f, mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma> \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
    also have "\<dots> = disj_of_clause f \<^bold>\<or> disj_of_clause a, mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma> \<Rightarrow>\<^sub>n"
      by(auto dest!: LSC_invs)
    also have "\<dots> = mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + (disj_of_clause f \<^bold>\<or> disj_of_clause a, \<Gamma>) \<Rightarrow>\<^sub>n" by (simp add: add_mset_commute)
    also have "\<dots> = mset (map (\<lambda>d. disj_of_clause d \<^bold>\<or> disj_of_clause a) F) + (disj_of_clause f \<^bold>\<or> disj_of_clause a, \<Gamma>) \<Rightarrow>\<^sub>n" using Cons.IH
      by (metis disj_of_clause_is_nnf insert_iff is_nnf.simps(3) set_mset_add_mset_insert)
      (* this was the step that shows why I'm doing this *)
    finally show ?case by simp
  qed simp
  from distrib1[OF a b]
  have "image_mset disj_of_clause (mset G) + (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma>) \<Rightarrow>\<^sub>n"
    by(auto simp add: add.left_commute)
  from Cons[OF c this ]
  have "mset (concat (map (\<lambda>c. map (\<lambda>d. disj_of_clause c \<^bold>\<or> disj_of_clause d) G) F)) +
  (mset (map (\<lambda>d. disj_of_clause a \<^bold>\<or> disj_of_clause d) F) + \<Gamma>) \<Rightarrow>\<^sub>n" .
  thus ?case using list_commute by (simp add: mset_concat_map_cons add.assoc add.left_commute)
qed simp

lemma LSC_BigAndL: "mset F + \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<And>F, \<Gamma> \<Rightarrow>\<^sub>n"
  by(induction F arbitrary: \<Gamma>; simp add: LSC_weaken) (metis LSC.AndL add_mset_commute union_mset_add_mset_right)
lemma LSC_Top_unused: "\<lbrakk>\<Gamma> \<Rightarrow>\<^sub>n; is_nnf_mset \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n"
proof(induction rule: LSC.induct)
  case Ax thus ?case by (metis LSC.Ax add.commute diff_union_swap formula.distinct(1,3) formula.inject(2))
next
 case BotL thus ?case by (metis LSC.BotL add.commute diff_union_swap formula.distinct(11))
next
  case (AndL F G \<Gamma>)
  hence "(F, G, \<Gamma>) - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n" by simp_all
  hence "F \<^bold>\<and> G, \<Gamma> - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n"
    by (metis AndL.hyps LSC.AndL diff_single_trivial diff_union_swap2)
  thus ?case by (metis add.commute diff_union_swap formula.distinct(19))
next
  case (OrL F \<Gamma> G)
  hence "(F, \<Gamma>) - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n" "(G, \<Gamma>) - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n" by simp_all
  hence "F \<^bold>\<or> G, \<Gamma> - {#\<^bold>\<not> \<bottom>#} \<Rightarrow>\<^sub>n" by (metis LSC.OrL OrL.hyps(1) OrL.hyps(2) diff_single_trivial diff_union_swap2)
  thus ?case by (metis diff_union_swap formula.distinct(21))
qed auto

lemma LSC_BigAndL_inv: "\<^bold>\<And>F, \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<forall>f \<in> set F. is_nnf f \<Longrightarrow> is_nnf_mset \<Gamma> \<Longrightarrow> mset F + \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction F arbitrary: \<Gamma>)
  case Nil
  then show ?case using LSC_Top_unused by fastforce
next
  case (Cons a F)
  hence "\<^bold>\<And>F, a, \<Gamma> \<Rightarrow>\<^sub>n" by(auto dest: LSC_invs simp: add_mset_commute)
  with Cons have "mset F + (a, \<Gamma>) \<Rightarrow>\<^sub>n" by fastforce
  then show ?case by simp
qed

lemma LSC_reassociate_Ands: "{#disj_of_clause c \<^bold>\<or> disj_of_clause d. (c, d) \<in># C#} + \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow>
   is_nnf_mset \<Gamma> \<Longrightarrow>
  {#disj_of_clause (c @ d). (c, d) \<in># C#} + \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction C arbitrary: \<Gamma>)
  case (add x C)
  obtain a b where [simp]: "x = (a, b)" by(cases x)
  from add.prems have a: "(disj_of_clause a \<^bold>\<or> disj_of_clause b), {#disj_of_clause c \<^bold>\<or> disj_of_clause d. (c, d) \<in># C#} + \<Gamma> \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
  hence "(disj_of_clause (a@b)), {#disj_of_clause c \<^bold>\<or> disj_of_clause d. (c, d) \<in># C#} + \<Gamma> \<Rightarrow>\<^sub>n" proof -
    have pn: "is_nnf_mset ({#disj_of_clause c \<^bold>\<or> disj_of_clause d. (c, d) \<in># C#} + \<Gamma>)"
      using \<open>is_nnf_mset \<Gamma>\<close> by auto
    have "disj_of_clause a \<^bold>\<or> disj_of_clause b, \<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> is_nnf_mset \<Gamma> \<Longrightarrow> disj_of_clause (a @ b), \<Gamma> \<Rightarrow>\<^sub>n" for \<Gamma>
      by(induction a) (auto dest!: LSC_invs)
    from this[OF _ pn] a show ?thesis .
  qed
  hence "{#disj_of_clause c \<^bold>\<or> disj_of_clause d. (c, d) \<in># C#} + ((disj_of_clause (a@b)),\<Gamma>) \<Rightarrow>\<^sub>n" by(simp add: add_mset_commute)
  with add.IH have "{#disj_of_clause (c @ d). (c, d) \<in># C#} + (disj_of_clause (a @ b), \<Gamma>) \<Rightarrow>\<^sub>n"
    using \<open>is_nnf_mset \<Gamma>\<close> by fastforce
  thus ?case by(simp add: add_mset_commute)
qed simp

lemma LSC_cnf: "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> is_nnf_mset \<Gamma> \<Longrightarrow> image_mset cnf_form_of \<Gamma> \<Rightarrow>\<^sub>n"
proof(induction "\<Gamma>" rule: LSC.induct)
  have [simp]: "NO_MATCH (And I J) F \<Longrightarrow> NO_MATCH (\<^bold>\<not>\<bottom>) F \<Longrightarrow> F,\<^bold>\<not>\<bottom>,\<Gamma> = \<^bold>\<not>\<bottom>,F,\<Gamma>" for F I J \<Gamma> by simp
  have [intro!]: "\<Gamma> \<Rightarrow>\<^sub>n \<Longrightarrow> \<^bold>\<not>\<bottom>, \<Gamma> \<Rightarrow>\<^sub>n" for \<Gamma> by (simp add: LSC_weaken)
  case Ax thus ?case by(auto simp: cnf_form_of_defs)
next
  case BotL show ?case by(auto simp: cnf_form_of_defs)
next
  have GO[simp]:
    "NO_MATCH ({#\<^bold>\<And>I#}) F \<Longrightarrow> F + (\<^bold>\<And>G, S) = \<^bold>\<And>G, (F + S)"
    for F G H S I J a b by(simp_all add: add_mset_commute)
  case (AndL F G \<Gamma>) thus ?case
  by(auto dest!: LSC_BigAndL_inv intro!: LSC_BigAndL simp add: cnf_form_of_defs) (simp add: add_ac)
next
  case (OrL F \<Gamma> G)
  have 2: "image_mset disj_of_clause (mset (concat (map (\<lambda>f. map ((@) f) (cnf_lists G)) (cnf_lists F)))) + \<Gamma> \<Rightarrow>\<^sub>n"
    if pig: "is_nnf_mset \<Gamma>" and a:
      "mset (concat (map (\<lambda>c. map (\<lambda>d. disj_of_clause c \<^bold>\<or> disj_of_clause d) (cnf_lists G)) (cnf_lists F))) + \<Gamma> \<Rightarrow>\<^sub>n"
    (* just some nasty modification of the conjunction *) for \<Gamma>
  proof -
    note cms[simp] = mset_map[symmetric] map_concat comp_def
    from a have "image_mset (\<lambda>(c,d). disj_of_clause c \<^bold>\<or> disj_of_clause d) (
      mset (concat (map (\<lambda>c. map (\<lambda>d. (c,d)) (cnf_lists G)) (cnf_lists F)))) + \<Gamma> \<Rightarrow>\<^sub>n" by simp
    hence "image_mset (\<lambda>(c,d). disj_of_clause (c@d)) (
      mset (concat (map (\<lambda>c. map (\<lambda>d. (c,d)) (cnf_lists G)) (cnf_lists F)))) + \<Gamma> \<Rightarrow>\<^sub>n"
      using LSC_reassociate_Ands pig by blast
    thus ?thesis by simp
  qed
  have 1: "\<lbrakk>\<^bold>\<And> (map disj_of_clause (cnf_lists F)), \<Gamma> \<Rightarrow>\<^sub>n; \<^bold>\<And> (map disj_of_clause (cnf_lists G)), \<Gamma> \<Rightarrow>\<^sub>n\<rbrakk>
    \<Longrightarrow> is_nnf_mset \<Gamma>
    \<Longrightarrow> \<^bold>\<And> (map disj_of_clause (concat (map (\<lambda>f. map ((@) f) (cnf_lists G)) (cnf_lists F)))), \<Gamma> \<Rightarrow>\<^sub>n"
    (* the actual disjunction is happening here *)
      for \<Gamma> using distrib[where 'a='a] 2 by(auto dest!: LSC_BigAndL_inv intro!: LSC_BigAndL)
  from OrL show ?case
    by(auto elim!: 1 simp add: cnf_form_of_def form_of_cnf_def)
qed auto

end


header {* \isachapter{Static Intraprocedural Slicing}

  Static Slicing analyses a CFG prior to execution. Whereas dynamic
  slicing can provide better results for certain inputs (i.e.\ trace and
  initial state), static slicing is more conservative but provides
  results independent of inputs.

  Correctness for static slicing is
  defined differently than correctness of dynamic slicing by a weak
  simulation between nodes and states when traversing the original and
  the sliced graph. The weak simulation property demands that if a
  (node,state) tuples $(n_1,s_1)$ simulates $(n_2,s_2)$
  and making an observable move in the original graph leads from
  $(n_1,s_1)$ to $(n_1',s_1')$, this tuple simulates a
  tuple $(n_2,s_2)$ which is the result of making an
  observable move in the sliced graph beginning in $(n_2',s_2')$.

  We also show how a ``dynamic slicing style'' correctness criterion for
  static slicing of a given trace and initial state could look like.

  This formalization of static intraprocedural slicing is instantiable
  with three different kinds of control dependences: standard control,
  weak control and weak order dependence. The correctness proof for
  slicing is independent of the control dependence used, it bases only
  on one property every control dependence definition hass to fulfill.

  \isaheader{Distance of Paths} *}

theory Distance imports "../Basic/CFG" begin

context CFG begin

inductive distance :: "'node \<Rightarrow> 'node \<Rightarrow> nat \<Rightarrow> bool"
where distanceI:
  "\<lbrakk>n -as\<rightarrow>* n'; length as = x; \<forall>as'. n -as'\<rightarrow>* n' \<longrightarrow> x \<le> length as'\<rbrakk>
  \<Longrightarrow> distance n n' x"

lemma every_path_distance:
  assumes "n -as\<rightarrow>* n'"
  obtains x where "distance n n' x" and "x \<le> length as"
proof -
  have "\<exists>x. distance n n' x \<and> x \<le> length as"
  proof(cases "\<exists>as'. n -as'\<rightarrow>* n' \<and>
                     (\<forall>asx. n -asx\<rightarrow>* n' \<longrightarrow> length as' \<le> length asx)")
    case True
    then obtain as'
      where "n -as'\<rightarrow>* n' \<and> (\<forall>asx. n -asx\<rightarrow>* n' \<longrightarrow> length as' \<le> length asx)"
      by blast
    hence "n -as'\<rightarrow>* n'" and all:"\<forall>asx. n -asx\<rightarrow>* n' \<longrightarrow> length as' \<le> length asx"
      by simp_all
    hence "distance n n' (length as')" by(fastforce intro:distanceI)
    from `n -as\<rightarrow>* n'` all have "length as' \<le> length as" by fastforce
    with `distance n n' (length as')` show ?thesis by blast
  next
    case False
    hence all:"\<forall>as'. n -as'\<rightarrow>* n' \<longrightarrow> (\<exists>asx. n -asx\<rightarrow>* n' \<and> length as' > length asx)"
      by fastforce
    have "wf (measure length)" by simp
    from `n -as\<rightarrow>* n'` have "as \<in> {as. n -as\<rightarrow>* n'}" by simp
    with `wf (measure length)` obtain as' where "as' \<in> {as. n -as\<rightarrow>* n'}"
      and notin:"\<And>as''. (as'',as') \<in> (measure length) \<Longrightarrow> as'' \<notin> {as. n -as\<rightarrow>* n'}"
      by(erule wfE_min)
    from `as' \<in> {as. n -as\<rightarrow>* n'}` have "n -as'\<rightarrow>* n'" by simp
    with all obtain asx where "n -asx\<rightarrow>* n'"
      and "length as' > length asx"
      by blast
    with notin have  "asx \<notin> {as. n -as\<rightarrow>* n'}" by simp
    hence "\<not> n -asx\<rightarrow>* n'" by simp
    with `n -asx\<rightarrow>* n'` have False by simp
    thus ?thesis by simp
  qed
  with that show ?thesis by blast
qed

lemma distance_det:
  "\<lbrakk>distance n n' x; distance n n' x'\<rbrakk> \<Longrightarrow> x = x'"
apply(erule distance.cases)+ apply clarsimp
apply(erule_tac x="asa" in allE) apply(erule_tac x="as" in allE)
by simp

lemma only_one_SOME_dist_edge:
  assumes valid:"valid_edge a" and dist:"distance (targetnode a) n' x"
  shows "\<exists>!a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') n' x \<and>
               valid_edge a' \<and>
               targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                              distance (targetnode a') n' x \<and>
                                              valid_edge a' \<and> targetnode a' = nx)"
proof(rule ex_ex1I)
  show "\<exists>a'. sourcenode a = sourcenode a' \<and>
             distance (targetnode a') n' x \<and> valid_edge a' \<and>
             targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                            distance (targetnode a') n' x \<and>
                                            valid_edge a' \<and> targetnode a' = nx)"
  proof -
    have "(\<exists>a'. sourcenode a = sourcenode a' \<and>
                distance (targetnode a') n' x \<and> valid_edge a' \<and>
                targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                               distance (targetnode a') n' x \<and>
                                               valid_edge a' \<and> targetnode a' = nx)) =
      (\<exists>nx. \<exists>a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') n' x \<and>
                 valid_edge a' \<and> targetnode a' = nx)"
      apply(unfold some_eq_ex[of "\<lambda>nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                distance (targetnode a') n' x \<and>valid_edge a' \<and>  targetnode a' = nx"])
      by simp
    also have "\<dots>" using valid dist by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a' \<and>
    distance (targetnode a') n' x \<and> valid_edge a' \<and>
    targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                   distance (targetnode a') n' x \<and>
                                   valid_edge a' \<and> targetnode a' = nx)"
    and "sourcenode a = sourcenode ax \<and>
    distance (targetnode ax) n' x \<and> valid_edge ax \<and>
    targetnode ax = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                   distance (targetnode a') n' x \<and>
                                   valid_edge a' \<and> targetnode a' = nx)"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed

lemma distance_successor_distance:
  assumes "distance n n' x" and "x \<noteq> 0"
  obtains a where "valid_edge a" and "n = sourcenode a"
  and "distance (targetnode a) n' (x - 1)"
  and "targetnode a = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') n' (x - 1) \<and>
                                     valid_edge a' \<and> targetnode a' = nx)"
proof -
  have "\<exists>a. valid_edge a \<and> n = sourcenode a \<and> distance (targetnode a) n' (x - 1) \<and>
    targetnode a = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                  distance (targetnode a') n' (x - 1) \<and>
                                  valid_edge a' \<and> targetnode a' = nx)"
  proof(rule ccontr)
    assume "\<not> (\<exists>a. valid_edge a \<and> n = sourcenode a \<and>
                   distance (targetnode a) n' (x - 1) \<and>
                   targetnode a = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') n' (x - 1) \<and>
                                                 valid_edge a' \<and> targetnode a' = nx))"
    hence imp:"\<forall>a. valid_edge a \<and> n = sourcenode a \<and>
                   targetnode a = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') n' (x - 1) \<and>
                                                 valid_edge a' \<and> targetnode a' = nx)
                 \<longrightarrow> \<not> distance (targetnode a) n' (x - 1)" by blast
    from `distance n n' x` obtain as where "n -as\<rightarrow>* n'" and "x = length as"
      and "\<forall>as'. n -as'\<rightarrow>* n' \<longrightarrow> x \<le> length as'"
      by(auto elim:distance.cases)
    thus False using imp
    proof(induct rule:path.induct)
      case (empty_path n)
      from `x = length []` `x \<noteq> 0` show False by simp
    next
      case (Cons_path n'' as n' a n)
      note imp = `\<forall>a. valid_edge a \<and> n = sourcenode a \<and>
                      targetnode a = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') n' (x - 1) \<and>
                                                 valid_edge a' \<and> targetnode a' = nx)
                    \<longrightarrow> \<not> distance (targetnode a) n' (x - 1)`
      note all = `\<forall>as'. n -as'\<rightarrow>* n' \<longrightarrow> x \<le> length as'`
      from `n'' -as\<rightarrow>* n'` obtain y where "distance n'' n' y"
        and "y \<le> length as" by(erule every_path_distance)
      from `distance n'' n' y` obtain as' where "n'' -as'\<rightarrow>* n'"
        and "y = length as'"
        by(auto elim:distance.cases)
      show False
      proof(cases "y < length as")
        case True
        from `valid_edge a` `sourcenode a = n` `targetnode a = n''` `n'' -as'\<rightarrow>* n'`
        have "n -a#as'\<rightarrow>* n'" by -(rule path.Cons_path)
        with all have "x \<le> length (a#as')" by blast
        with `x = length (a#as)` True `y = length as'` show False by simp
      next
        case False
        with `y \<le> length as` `x = length (a#as)` have "y = x - 1" by simp
        from `targetnode a = n''` `distance n'' n' y`
        have "distance (targetnode a) n' y" by simp
        with `valid_edge a`
        obtain a' where "sourcenode a = sourcenode a'"
          and "distance (targetnode a') n' y" and "valid_edge a'"
          and "targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                              distance (targetnode a') n' y \<and>
                                              valid_edge a' \<and> targetnode a' = nx)"
          by(auto dest:only_one_SOME_dist_edge)
        with imp `sourcenode a = n` `y = x - 1` show False by fastforce
      qed
    qed
  qed
  with that show ?thesis by blast
qed

end

end