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

    Copyright (C) 2005 - 2009  Slawomir Kolodynski

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

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

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

*)

section \<open>More on ordered groups\<close>

theory OrderedGroup_ZF_1 imports OrderedGroup_ZF

begin

text\<open>In this theory we continue the \<open>OrderedGroup_ZF\<close>
  theory development.\<close>

subsection\<open>Absolute value and the triangle inequality\<close>

text\<open>The goal of this section is to prove the triangle inequality for
  ordered groups.\<close>

text\<open>Absolute value maps $G$ into $G$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L1:
  shows "AbsoluteValue(G,P,r) : G\<rightarrow>G"
proof -
  let ?f = "id(G\<^sup>+)"
  let ?g = "restrict(GroupInv(G,P),G-G\<^sup>+)"
  have "?f : G\<^sup>+\<rightarrow>G\<^sup>+" using id_type by simp
  then have "?f : G\<^sup>+\<rightarrow>G" using OrderedGroup_ZF_1_L4E fun_weaken_type
    by blast
  moreover have "?g : G-G\<^sup>+\<rightarrow>G"
  proof -
    from ordGroupAssum have "GroupInv(G,P) : G\<rightarrow>G"
      using IsAnOrdGroup_def group0_2_T2 by simp
    moreover have "G-G\<^sup>+ \<subseteq> G" by auto
    ultimately show ?thesis using restrict_type2 by simp
  qed
  moreover have "G\<^sup>+\<inter>(G-G\<^sup>+) = 0" by blast
  ultimately have "?f \<union> ?g : G\<^sup>+\<union>(G-G\<^sup>+)\<rightarrow>G\<union>G"
    by (rule fun_disjoint_Un)
  moreover have "G\<^sup>+\<union>(G-G\<^sup>+) = G" using OrderedGroup_ZF_1_L4E
    by auto
  ultimately show "AbsoluteValue(G,P,r) : G\<rightarrow>G"
    using AbsoluteValue_def by simp
qed

text\<open>If $a\in G^+$, then $|a| = a$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L2:
  assumes A1: "a\<in>G\<^sup>+" shows "|a| = a"
proof -
  from ordGroupAssum have "GroupInv(G,P) : G\<rightarrow>G"
    using IsAnOrdGroup_def group0_2_T2 by simp
  with A1 show ?thesis using
    func1_1_L1 OrderedGroup_ZF_1_L4E fun_disjoint_apply1
    AbsoluteValue_def id_conv by simp
qed

text\<open>The absolute value of the unit is the unit. In the
  additive totation that would be $|0| = 0$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L2A:
  shows "|\<one>| = \<one>" using OrderedGroup_ZF_1_L3A OrderedGroup_ZF_3_L2
  by simp

text\<open>If $a$ is positive, then $|a| = a$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L2B:
  assumes "a\<in>G\<^sub>+" shows "|a| = a"
  using assms PositiveSet_def Nonnegative_def OrderedGroup_ZF_3_L2
  by auto

text\<open>If $a\in G\setminus G^+$, then $|a| = a^{-1}$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3:
   assumes A1: "a \<in> G-G\<^sup>+" shows "|a| = a\<inverse>"
proof -
  have "domain(id(G\<^sup>+)) = G\<^sup>+"
    using id_type func1_1_L1 by auto
  with A1 show ?thesis using fun_disjoint_apply2 AbsoluteValue_def
    restrict by simp
qed

text\<open>For elements that not greater than the unit, the absolute value is
  the inverse.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3A:
  assumes A1: "a\<lsq>\<one>"
  shows "|a| = a\<inverse>"
proof -
  { assume "a=\<one>" then have "|a| = a\<inverse>"
      using OrderedGroup_ZF_3_L2A OrderedGroup_ZF_1_L1 group0.group_inv_of_one
      by simp }
  moreover
  { assume "a\<noteq>\<one>"
    with A1 have "|a| = a\<inverse>" using OrderedGroup_ZF_1_L4C OrderedGroup_ZF_3_L3
      by simp }
  ultimately show "|a| = a\<inverse>" by blast
qed

text\<open>In linearly ordered groups the absolute value of any element
  is in $G^+$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3B:
  assumes A1: "r {is total on} G" and A2: "a\<in>G"
  shows "|a| \<in> G\<^sup>+"
proof -
  { assume "a \<in> G\<^sup>+" then have "|a| \<in> G\<^sup>+"
      using OrderedGroup_ZF_3_L2 by simp }
  moreover
  { assume "a \<notin> G\<^sup>+"
    with A1 A2 have "|a| \<in> G\<^sup>+" using OrderedGroup_ZF_3_L3
      OrderedGroup_ZF_1_L6 by simp }
  ultimately show "|a| \<in> G\<^sup>+" by blast
qed

text\<open>For linearly ordered groups (where the order is total), the absolute
  value maps the group into the positive set.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3C:
  assumes A1: "r {is total on} G"
  shows "AbsoluteValue(G,P,r) : G\<rightarrow>G\<^sup>+"
proof-
  have "AbsoluteValue(G,P,r) : G\<rightarrow>G" using OrderedGroup_ZF_3_L1
    by simp
  moreover from A1 have T2:
    "\<forall>g\<in>G. AbsoluteValue(G,P,r)`(g)  \<in> G\<^sup>+"
    using OrderedGroup_ZF_3_L3B by simp
  ultimately show ?thesis by (rule func1_1_L1A)
qed

text\<open>If the absolute value is the unit, then the elemnent is the unit.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3D:
  assumes A1: "a\<in>G" and A2: "|a| = \<one>"
  shows "a = \<one>"
proof -
  { assume "a \<in> G\<^sup>+"
    with A2 have "a = \<one>" using OrderedGroup_ZF_3_L2 by simp }
  moreover
  { assume "a \<notin> G\<^sup>+"
    with A1 A2 have "a = \<one>" using
      OrderedGroup_ZF_3_L3 OrderedGroup_ZF_1_L1 group0.group0_2_L8A
      by auto }
  ultimately show "a = \<one>" by blast
qed

text\<open>In linearly ordered groups the unit is not greater than the absolute
  value of any element.\<close>

lemma (in group3) OrderedGroup_ZF_3_L3E:
  assumes "r {is total on} G" and "a\<in>G"
  shows "\<one> \<lsq> |a|"
  using assms OrderedGroup_ZF_3_L3B OrderedGroup_ZF_1_L2 by simp

text\<open>If $b$ is greater than both $a$ and $a^{-1}$, then $b$ is greater than
  $|a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L4:
  assumes A1: "a\<lsq>b" and A2: "a\<inverse>\<lsq> b"
  shows "|a|\<lsq> b"
proof -
  { assume "a\<in>G\<^sup>+"
    with A1 have "|a|\<lsq> b" using OrderedGroup_ZF_3_L2 by simp }
  moreover
  { assume "a\<notin>G\<^sup>+"
    with A1 A2 have "|a|\<lsq> b"
      using OrderedGroup_ZF_1_L4 OrderedGroup_ZF_3_L3 by simp }
  ultimately show "|a|\<lsq> b" by blast
qed

text\<open>In linearly ordered groups $a\leq |a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L5:
  assumes A1: "r {is total on} G" and A2: "a\<in>G"
  shows "a \<lsq> |a|"
proof -
  { assume "a \<in> G\<^sup>+"
    with A2 have "a \<lsq> |a|"
      using OrderedGroup_ZF_3_L2 OrderedGroup_ZF_1_L3 by simp }
  moreover
  { assume "a \<notin> G\<^sup>+"
    with A1 A2 have "a \<lsq> |a|"
      using OrderedGroup_ZF_3_L3B OrderedGroup_ZF_1_L4B by simp }
  ultimately show "a \<lsq> |a|" by blast
qed

text\<open> $a^{-1}\leq |a|$ (in additive notation it would be $-a\leq |a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L6:
  assumes A1: "a\<in>G" shows "a\<inverse> \<lsq> |a|"
proof -
  { assume "a \<in> G\<^sup>+"
    then have T1: "\<one>\<lsq>a" and T2: "|a| = a" using OrderedGroup_ZF_1_L2
      OrderedGroup_ZF_3_L2 by auto
    then have "a\<inverse>\<lsq>\<one>\<inverse>" using OrderedGroup_ZF_1_L5 by simp
    then have T3: "a\<inverse>\<lsq>\<one>"
      using OrderedGroup_ZF_1_L1 group0.group_inv_of_one by simp
    from T3 T1 have "a\<inverse>\<lsq>a" by (rule Group_order_transitive)
    with T2 have "a\<inverse> \<lsq> |a|" by simp }
  moreover
  { assume A2: "a \<notin> G\<^sup>+"
    from A1 have "|a| \<in> G"
      using OrderedGroup_ZF_3_L1 apply_funtype by auto
    with ordGroupAssum have "|a| \<lsq> |a|"
      using IsAnOrdGroup_def IsPartOrder_def refl_def by simp
    with A1 A2 have "a\<inverse> \<lsq> |a|" using OrderedGroup_ZF_3_L3 by simp }
  ultimately show "a\<inverse> \<lsq> |a|" by blast
qed

text\<open>Some inequalities about the product of two elements of a linearly
  ordered group and its absolute value.\<close>

lemma (in group3) OrderedGroup_ZF_3_L6A:
  assumes "r {is total on} G" and "a\<in>G"  "b\<in>G"
  shows
  "a\<cdot>b \<lsq>|a|\<cdot>|b|"
  "a\<cdot>b\<inverse> \<lsq>|a|\<cdot>|b|"
  "a\<inverse>\<cdot>b \<lsq>|a|\<cdot>|b|"
  "a\<inverse>\<cdot>b\<inverse> \<lsq>|a|\<cdot>|b|"
  using assms OrderedGroup_ZF_3_L5 OrderedGroup_ZF_3_L6
    OrderedGroup_ZF_1_L5B by auto

text\<open> $|a^{-1}|\leq |a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7:
  assumes "r {is total on} G" and "a\<in>G"
  shows "|a\<inverse>|\<lsq>|a|"
  using assms OrderedGroup_ZF_3_L5 OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
    OrderedGroup_ZF_3_L6 OrderedGroup_ZF_3_L4 by simp

text\<open>$|a^{-1}| = |a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7A:
  assumes A1: "r {is total on} G" and A2: "a\<in>G"
  shows "|a\<inverse>| = |a|"
proof -
  from A2 have "a\<inverse>\<in>G" using OrderedGroup_ZF_1_L1 group0.inverse_in_group
    by simp
  with A1 have "|(a\<inverse>)\<inverse>| \<lsq> |a\<inverse>|" using OrderedGroup_ZF_3_L7 by simp
  with A1 A2 have "|a\<inverse>| \<lsq> |a|"  "|a| \<lsq> |a\<inverse>|"
    using OrderedGroup_ZF_1_L1 group0.group_inv_of_inv OrderedGroup_ZF_3_L7
    by auto
  then show ?thesis by (rule group_order_antisym)
qed

text\<open> $|a\cdot b^{-1}| = |b\cdot a^{-1}|$. It doesn't look so strange in the
  additive notation: $|a-b| = |b-a|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7B:
  assumes A1: "r {is total on} G" and A2: "a\<in>G" "b\<in>G"
  shows "|a\<cdot>b\<inverse>| = |b\<cdot>a\<inverse>|"
proof -
  from A1 A2 have "|(a\<cdot>b\<inverse>)\<inverse>| = |a\<cdot>b\<inverse>|" using
    OrderedGroup_ZF_1_L1 group0.inverse_in_group group0.group0_2_L1
    monoid0.group0_1_L1 OrderedGroup_ZF_3_L7A by simp
  moreover from A2 have "(a\<cdot>b\<inverse>)\<inverse> =  b\<cdot>a\<inverse>"
    using OrderedGroup_ZF_1_L1 group0.group0_2_L12 by simp
  ultimately show ?thesis by simp
qed

text\<open>Triangle inequality for linearly ordered abelian groups.
  It would be nice to drop commutativity or give an example that shows we
  can't do that.\<close>

theorem (in group3) OrdGroup_triangle_ineq:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and A3: "a\<in>G"  "b\<in>G"
  shows "|a\<cdot>b| \<lsq> |a|\<cdot>|b|"
proof -
  from A1 A2 A3 have
    "a \<lsq> |a|" "b \<lsq> |b|" "a\<inverse> \<lsq> |a|" "b\<inverse> \<lsq> |b|"
    using OrderedGroup_ZF_3_L5 OrderedGroup_ZF_3_L6 by auto
  then have "a\<cdot>b \<lsq> |a|\<cdot>|b|" "a\<inverse>\<cdot>b\<inverse> \<lsq> |a|\<cdot>|b|"
    using OrderedGroup_ZF_1_L5B by auto
  with A1 A3 show "|a\<cdot>b| \<lsq> |a|\<cdot>|b|"
    using OrderedGroup_ZF_1_L1 group0.group_inv_of_two IsCommutative_def
    OrderedGroup_ZF_3_L4 by simp
qed

text\<open>We can multiply the sides of an inequality with absolute value.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7C:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and A3: "a\<in>G" "b\<in>G"
  and A4: "|a| \<lsq> c"  "|b| \<lsq> d"
  shows "|a\<cdot>b| \<lsq> c\<cdot>d"
proof -
  from A1 A2 A3 A4 have "|a\<cdot>b| \<lsq> |a|\<cdot>|b|"
    using OrderedGroup_ZF_1_L4 OrdGroup_triangle_ineq
    by simp
  moreover from A4 have "|a|\<cdot>|b| \<lsq> c\<cdot>d"
    using OrderedGroup_ZF_1_L5B by simp
  ultimately show ?thesis by (rule Group_order_transitive)
qed

text\<open>A version of the \<open>OrderedGroup_ZF_3_L7C\<close>
  but with multiplying by the inverse.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7CA:
  assumes "P {is commutative on} G"
  and "r {is total on} G" and "a\<in>G"  "b\<in>G"
  and "|a| \<lsq> c"  "|b| \<lsq> d"
  shows "|a\<cdot>b\<inverse>| \<lsq> c\<cdot>d"
  using assms OrderedGroup_ZF_1_L1 group0.inverse_in_group
  OrderedGroup_ZF_3_L7A OrderedGroup_ZF_3_L7C by simp

text\<open>Triangle inequality with three integers.\<close>

lemma (in group3) OrdGroup_triangle_ineq3:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and A3: "a\<in>G"  "b\<in>G"  "c\<in>G"
  shows "|a\<cdot>b\<cdot>c| \<lsq> |a|\<cdot>|b|\<cdot>|c|"
proof -
  from A3 have T: "a\<cdot>b \<in> G"  "|c| \<in> G"
    using OrderedGroup_ZF_1_L1 group0.group_op_closed
      OrderedGroup_ZF_3_L1 apply_funtype by auto
  with A1 A2 A3 have "|a\<cdot>b\<cdot>c| \<lsq> |a\<cdot>b|\<cdot>|c|"
    using OrdGroup_triangle_ineq by simp
  moreover from ordGroupAssum A1 A2 A3 T have
    "|a\<cdot>b|\<cdot>|c| \<lsq> |a|\<cdot>|b|\<cdot>|c|"
    using OrdGroup_triangle_ineq IsAnOrdGroup_def by simp
  ultimately show "|a\<cdot>b\<cdot>c| \<lsq> |a|\<cdot>|b|\<cdot>|c|"
    by (rule Group_order_transitive)
qed

text\<open>Some variants of the triangle inequality.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7D:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and A3: "a\<in>G"  "b\<in>G"
  and A4: "|a\<cdot>b\<inverse>| \<lsq> c"
  shows
  "|a| \<lsq> c\<cdot>|b|"
  "|a| \<lsq> |b|\<cdot>c"
  "c\<inverse>\<cdot>a \<lsq> b"
  "a\<cdot>c\<inverse> \<lsq> b"
  "a \<lsq> b\<cdot>c"
proof -
  from A3 A4 have
    T: "a\<cdot>b\<inverse> \<in> G"  "|b| \<in> G"  "c\<in>G"  "c\<inverse> \<in> G"
    using OrderedGroup_ZF_1_L1
      group0.inverse_in_group group0.group0_2_L1 monoid0.group0_1_L1
      OrderedGroup_ZF_3_L1 apply_funtype  OrderedGroup_ZF_1_L4
    by auto
  from A3 have "|a| = |a\<cdot>b\<inverse>\<cdot>b|"
    using OrderedGroup_ZF_1_L1 group0.inv_cancel_two
    by simp
  with A1 A2 A3 T have "|a| \<lsq> |a\<cdot>b\<inverse>|\<cdot>|b|"
    using OrdGroup_triangle_ineq by simp
  with T A4 show "|a| \<lsq> c\<cdot>|b|" using OrderedGroup_ZF_1_L5C
    by blast
  with T A1 show "|a| \<lsq> |b|\<cdot>c"
    using IsCommutative_def by simp
  from A2 T have "a\<cdot>b\<inverse> \<lsq> |a\<cdot>b\<inverse>|"
    using OrderedGroup_ZF_3_L5 by simp
  moreover note A4
  ultimately have I: "a\<cdot>b\<inverse> \<lsq> c"
    by (rule Group_order_transitive)
  with A3 show "c\<inverse>\<cdot>a \<lsq> b"
    using OrderedGroup_ZF_1_L5H by simp
  with A1 A3 T show "a\<cdot>c\<inverse> \<lsq> b"
    using IsCommutative_def by simp
  from A1 A3 T I show "a \<lsq> b\<cdot>c"
    using OrderedGroup_ZF_1_L5H IsCommutative_def
    by auto
qed

text\<open>Some more variants of the triangle inequality.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7E:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and A3: "a\<in>G"  "b\<in>G"
  and A4: "|a\<cdot>b\<inverse>| \<lsq> c"
  shows "b\<cdot>c\<inverse> \<lsq> a"
proof -
  from A3 have "a\<cdot>b\<inverse> \<in> G"
    using OrderedGroup_ZF_1_L1
      group0.inverse_in_group group0.group_op_closed
    by auto
  with A2 have "|(a\<cdot>b\<inverse>)\<inverse>| = |a\<cdot>b\<inverse>|"
    using OrderedGroup_ZF_3_L7A by simp
  moreover from A3 have "(a\<cdot>b\<inverse>)\<inverse> = b\<cdot>a\<inverse>"
    using OrderedGroup_ZF_1_L1 group0.group0_2_L12
    by simp
  ultimately have "|b\<cdot>a\<inverse>| = |a\<cdot>b\<inverse>|"
    by simp
  with A1 A2 A3 A4 show "b\<cdot>c\<inverse> \<lsq> a"
    using OrderedGroup_ZF_3_L7D by simp
qed

text\<open>An application of the triangle inequality with four group
  elements.\<close>

lemma (in group3) OrderedGroup_ZF_3_L7F:
  assumes A1: "P {is commutative on} G"
  and A2: "r {is total on} G" and
  A3: "a\<in>G"  "b\<in>G"  "c\<in>G"  "d\<in>G"
  shows "|a\<cdot>c\<inverse>| \<lsq> |a\<cdot>b|\<cdot>|c\<cdot>d|\<cdot>|b\<cdot>d\<inverse>|"
proof -
  from A3 have T:
    "a\<cdot>c\<inverse> \<in> G"  "a\<cdot>b \<in> G"  "c\<cdot>d \<in> G"  "b\<cdot>d\<inverse> \<in> G"
    "(c\<cdot>d)\<inverse> \<in> G"  "(b\<cdot>d\<inverse>)\<inverse> \<in> G"
    using OrderedGroup_ZF_1_L1
      group0.inverse_in_group group0.group_op_closed
    by auto
  with A1 A2 have "|(a\<cdot>b)\<cdot>(c\<cdot>d)\<inverse>\<cdot>(b\<cdot>d\<inverse>)\<inverse>| \<lsq> |a\<cdot>b|\<cdot>|(c\<cdot>d)\<inverse>|\<cdot>|(b\<cdot>d\<inverse>)\<inverse>|"
    using OrdGroup_triangle_ineq3 by simp
  moreover from A2 T have "|(c\<cdot>d)\<inverse>| =|c\<cdot>d|" and "|(b\<cdot>d\<inverse>)\<inverse>| = |b\<cdot>d\<inverse>|"
    using OrderedGroup_ZF_3_L7A by auto
  moreover from A1 A3 have "(a\<cdot>b)\<cdot>(c\<cdot>d)\<inverse>\<cdot>(b\<cdot>d\<inverse>)\<inverse> = a\<cdot>c\<inverse>"
    using OrderedGroup_ZF_1_L1 group0.group0_4_L8
    by simp
  ultimately show "|a\<cdot>c\<inverse>| \<lsq> |a\<cdot>b|\<cdot>|c\<cdot>d|\<cdot>|b\<cdot>d\<inverse>|"
    by simp
qed

text\<open>$|a|\leq L$ implies $L^{-1} \leq a$
  (it would be $-L \leq a$ in the additive notation).\<close>

lemma (in group3) OrderedGroup_ZF_3_L8:
  assumes A1:  "a\<in>G" and A2: "|a|\<lsq>L"
   shows
  "L\<inverse>\<lsq>a"
proof -
  from A1 have I: "a\<inverse> \<lsq> |a|" using OrderedGroup_ZF_3_L6 by simp
  from I A2 have "a\<inverse> \<lsq> L" by (rule Group_order_transitive)
  then have "L\<inverse>\<lsq>(a\<inverse>)\<inverse>" using OrderedGroup_ZF_1_L5 by simp
  with A1 show "L\<inverse>\<lsq>a" using OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
    by simp
qed

text\<open>In linearly ordered groups $|a|\leq L$ implies $a \leq L$
  (it would be $a \leq L$ in the additive notation).\<close>

lemma (in group3) OrderedGroup_ZF_3_L8A:
  assumes A1: "r {is total on} G"
  and A2: "a\<in>G" and A3: "|a|\<lsq>L"
  shows
  "a\<lsq>L"
  "\<one>\<lsq>L"
proof -
  from A1 A2 have I: "a \<lsq> |a|" using OrderedGroup_ZF_3_L5 by simp
  from I A3 show "a\<lsq>L" by (rule Group_order_transitive)
  from A1 A2 A3 have "\<one> \<lsq> |a|"  "|a|\<lsq>L"
     using OrderedGroup_ZF_3_L3B OrderedGroup_ZF_1_L2 by auto
   then show "\<one>\<lsq>L" by (rule Group_order_transitive)
qed

text\<open>A somewhat generalized version of the above lemma.\<close>

lemma (in group3) OrderedGroup_ZF_3_L8B:
  assumes A1: "a\<in>G" and A2: "|a|\<lsq>L" and A3: "\<one>\<lsq>c"
  shows "(L\<cdot>c)\<inverse> \<lsq> a"
proof -
  from A1 A2 A3 have "c\<inverse>\<cdot>L\<inverse> \<lsq> \<one>\<cdot>a"
    using OrderedGroup_ZF_3_L8 OrderedGroup_ZF_1_L5AB
    OrderedGroup_ZF_1_L5B by simp
  with A1 A2 A3 show "(L\<cdot>c)\<inverse> \<lsq> a"
    using OrderedGroup_ZF_1_L4 OrderedGroup_ZF_1_L1
      group0.group_inv_of_two group0.group0_2_L2
    by simp
qed

text\<open>If $b$ is between $a$ and $a\cdot c$, then $b\cdot a^{-1}\leq c$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L8C:
  assumes A1: "a\<lsq>b" and A2: "c\<in>G" and A3: "b\<lsq>c\<cdot>a"
  shows "|b\<cdot>a\<inverse>| \<lsq> c"
proof -
  from A1 A2 A3 have "b\<cdot>a\<inverse> \<lsq> c"
    using OrderedGroup_ZF_1_L9C OrderedGroup_ZF_1_L4
    by simp
  moreover have "(b\<cdot>a\<inverse>)\<inverse> \<lsq> c"
  proof -
    from A1 have T: "a\<in>G"  "b\<in>G"
      using OrderedGroup_ZF_1_L4 by auto
    with A1 have "a\<cdot>b\<inverse> \<lsq> \<one>"
      using OrderedGroup_ZF_1_L9 by blast
    moreover
    from A1 A3 have "a\<lsq>c\<cdot>a"
      by (rule Group_order_transitive)
    with ordGroupAssum T have "a\<cdot>a\<inverse> \<lsq> c\<cdot>a\<cdot>a\<inverse>"
      using OrderedGroup_ZF_1_L1 group0.inverse_in_group
      IsAnOrdGroup_def by simp
    with T A2 have "\<one> \<lsq> c"
      using OrderedGroup_ZF_1_L1
	group0.group0_2_L6 group0.inv_cancel_two
      by simp
    ultimately have "a\<cdot>b\<inverse> \<lsq> c"
      by (rule Group_order_transitive)
    with T show "(b\<cdot>a\<inverse>)\<inverse> \<lsq> c"
      using OrderedGroup_ZF_1_L1 group0.group0_2_L12
      by simp
  qed
  ultimately show "|b\<cdot>a\<inverse>| \<lsq> c"
    using OrderedGroup_ZF_3_L4 by simp
qed

text\<open>For linearly ordered groups if the absolute values of elements in a set
  are bounded, then the set is bounded.\<close>

lemma (in group3) OrderedGroup_ZF_3_L9:
  assumes A1: "r {is total on} G"
  and A2: "A\<subseteq>G" and A3: "\<forall>a\<in>A. |a| \<lsq> L"
  shows "IsBounded(A,r)"
proof -
  from A1 A2 A3 have
    "\<forall>a\<in>A. a\<lsq>L"  "\<forall>a\<in>A. L\<inverse>\<lsq>a"
    using OrderedGroup_ZF_3_L8 OrderedGroup_ZF_3_L8A by auto
  then show "IsBounded(A,r)" using
    IsBoundedAbove_def IsBoundedBelow_def IsBounded_def
    by auto
qed

text\<open>A slightly more general version of the previous lemma, stating the same
  fact for a set defined by separation.\<close>

lemma (in group3) OrderedGroup_ZF_3_L9A:
  assumes A1: "r {is total on} G"
  and A2: "\<forall>x\<in>X. b(x)\<in>G \<and> |b(x)|\<lsq>L"
  shows "IsBounded({b(x). x\<in>X},r)"
proof -
  from A2 have "{b(x). x\<in>X} \<subseteq> G" "\<forall>a\<in>{b(x). x\<in>X}. |a| \<lsq> L"
    by auto
  with A1 show ?thesis using OrderedGroup_ZF_3_L9 by blast
qed

text\<open>A special form of the previous lemma stating a similar fact for an
  image of a set by a function with values in a linearly ordered group.\<close>

lemma (in group3) OrderedGroup_ZF_3_L9B:
  assumes A1: "r {is total on} G"
  and A2: "f:X\<rightarrow>G" and A3: "A\<subseteq>X"
  and A4: "\<forall>x\<in>A. |f`(x)| \<lsq> L"
  shows "IsBounded(f``(A),r)"
proof -
  from A2 A3 A4 have "\<forall>x\<in>A. f`(x) \<in> G \<and>  |f`(x)| \<lsq> L"
    using apply_funtype by auto
  with A1 have  "IsBounded({f`(x). x\<in>A},r)"
    by (rule OrderedGroup_ZF_3_L9A)
  with A2 A3 show "IsBounded(f``(A),r)"
    using func_imagedef by simp
qed

text\<open>For linearly ordered groups if $l\leq a\leq u$ then
  $|a|$ is smaller than the greater of $|l|,|u|$.\<close>

lemma (in group3) OrderedGroup_ZF_3_L10:
  assumes A1: "r {is total on} G"
  and A2: "l\<lsq>a"  "a\<lsq>u"
  shows
  "|a| \<lsq> GreaterOf(r,|l|,|u|)"
proof -
  from A2 have T1: "|l| \<in> G" "|a| \<in> G" "|u| \<in> G"
    using OrderedGroup_ZF_1_L4 OrderedGroup_ZF_3_L1 apply_funtype
    by auto
  { assume A3: "a\<in>G\<^sup>+"
    with A2 have "\<one>\<lsq>a" "a\<lsq>u"
      using OrderedGroup_ZF_1_L2 by auto
    then have "\<one>\<lsq>u" by (rule Group_order_transitive)
    with A2 A3 have "|a|\<lsq>|u|"
      using OrderedGroup_ZF_1_L2 OrderedGroup_ZF_3_L2 by simp
    moreover from A1 T1 have "|u| \<lsq> GreaterOf(r,|l|,|u|)"
      using Order_ZF_3_L2 by simp
    ultimately have "|a| \<lsq> GreaterOf(r,|l|,|u|)"
      by (rule Group_order_transitive) }
  moreover
  { assume A4: "a\<notin>G\<^sup>+"
    with A2 have T2:
      "l\<in>G" "|l| \<in> G" "|a| \<in> G" "|u| \<in> G" "a \<in> G-G\<^sup>+"
      using OrderedGroup_ZF_1_L4 OrderedGroup_ZF_3_L1 apply_funtype
      by auto
    with A2 have "l \<in> G-G\<^sup>+" using OrderedGroup_ZF_1_L4D by fast
    with T2 A2 have "|a| \<lsq> |l|"
      using OrderedGroup_ZF_3_L3 OrderedGroup_ZF_1_L5
      by simp
    moreover from A1 T2 have "|l| \<lsq> GreaterOf(r,|l|,|u|)"
      using Order_ZF_3_L2 by simp
    ultimately have "|a| \<lsq> GreaterOf(r,|l|,|u|)"
      by (rule Group_order_transitive) }
  ultimately show ?thesis by blast
qed

text\<open>For linearly ordered groups if a set is bounded then the absolute
  values are bounded.\<close>

lemma (in group3) OrderedGroup_ZF_3_L10A:
  assumes A1: "r {is total on} G"
  and A2: "IsBounded(A,r)"
  shows "\<exists>L. \<forall>a\<in>A. |a| \<lsq> L"
proof -
  { assume "A = 0" then have ?thesis by auto }
  moreover
  { assume A3: "A\<noteq>0"
    with A2 have "\<exists>u. \<forall>g\<in>A. g\<lsq>u" and "\<exists>l.\<forall>g\<in>A. l\<lsq>g"
      using IsBounded_def IsBoundedAbove_def IsBoundedBelow_def
      by auto
    then obtain u l where "\<forall>g\<in>A. l\<lsq>g \<and>  g\<lsq>u"
      by auto
    with A1 have "\<forall>a\<in>A. |a| \<lsq> GreaterOf(r,|l|,|u|)"
      using OrderedGroup_ZF_3_L10 by simp
    then have ?thesis by auto }
  ultimately show ?thesis by blast
qed

text\<open>A slightly more general version of the previous lemma, stating the same
  fact for a set defined by separation.\<close>

lemma (in group3) OrderedGroup_ZF_3_L11:
  assumes "r {is total on} G"
  and "IsBounded({b(x).x\<in>X},r)"
  shows "\<exists>L. \<forall>x\<in>X. |b(x)| \<lsq> L"
  using assms OrderedGroup_ZF_3_L10A by blast

text\<open>Absolute values of elements of a finite image of a nonempty set are
  bounded by an element of the group.\<close>

lemma (in group3) OrderedGroup_ZF_3_L11A:
  assumes A1: "r {is total on} G"
  and A2: "X\<noteq>0" and A3: "{b(x). x\<in>X} \<in> Fin(G)"
  shows "\<exists>L\<in>G. \<forall>x\<in>X. |b(x)| \<lsq> L"
proof -
  from A1 A3 have "\<exists>L. \<forall>x\<in>X. |b(x)| \<lsq> L"
     using  ord_group_fin_bounded OrderedGroup_ZF_3_L11
     by simp
  then obtain L where I: "\<forall>x\<in>X. |b(x)| \<lsq> L"
    using OrderedGroup_ZF_3_L11 by auto
  from A2 obtain x where "x\<in>X" by auto
  with I show ?thesis using OrderedGroup_ZF_1_L4
    by blast
qed

text\<open>In totally oredered groups the absolute value of a
  nonunit element is in \<open>G\<^sub>+\<close>.\<close>

lemma (in group3) OrderedGroup_ZF_3_L12:
  assumes A1: "r {is total on} G"
  and A2: "a\<in>G"  and A3: "a\<noteq>\<one>"
  shows "|a| \<in> G\<^sub>+"
proof -
  from A1 A2 have "|a| \<in> G"  "\<one> \<lsq> |a|"
    using OrderedGroup_ZF_3_L1 apply_funtype
      OrderedGroup_ZF_3_L3B OrderedGroup_ZF_1_L2
    by auto
  moreover from A2 A3 have "|a| \<noteq> \<one>"
    using OrderedGroup_ZF_3_L3D by auto
  ultimately show "|a| \<in> G\<^sub>+"
    using PositiveSet_def by auto
qed

subsection\<open>Maximum absolute value of a set\<close>

text\<open>Quite often when considering inequalities we prefer to talk about
  the absolute values instead of raw elements of a set. This section formalizes
  some material that is useful for that.\<close>

text\<open>If a set has a maximum and minimum, then the greater of the
  absolute value of the maximum and minimum belongs to the image of the set
  by the absolute value function.\<close>

lemma (in group3) OrderedGroup_ZF_4_L1:
  assumes "A \<subseteq> G"
  and "HasAmaximum(r,A)" "HasAminimum(r,A)"
  and "M = GreaterOf(r,|Minimum(r,A)|,|Maximum(r,A)|)"
  shows "M \<in> AbsoluteValue(G,P,r)``(A)"
  using ordGroupAssum assms IsAnOrdGroup_def IsPartOrder_def
    Order_ZF_4_L3 Order_ZF_4_L4 OrderedGroup_ZF_3_L1
    func_imagedef GreaterOf_def by auto

text\<open>If a set has a maximum and minimum, then the greater of the
  absolute value of the maximum and minimum bounds absolute values of all
  elements of the set.\<close>

lemma (in group3) OrderedGroup_ZF_4_L2:
  assumes A1: "r {is total on} G"
  and A2: "HasAmaximum(r,A)"  "HasAminimum(r,A)"
  and A3: "a\<in>A"
  shows "|a|\<lsq> GreaterOf(r,|Minimum(r,A)|,|Maximum(r,A)|)"
proof -
  from ordGroupAssum A2 A3 have
    "Minimum(r,A)\<lsq> a" "a\<lsq> Maximum(r,A)"
    using IsAnOrdGroup_def IsPartOrder_def Order_ZF_4_L3 Order_ZF_4_L4
    by auto
  with A1 show ?thesis by (rule OrderedGroup_ZF_3_L10)
qed

text\<open>If a set has a maximum and minimum, then the greater of the
  absolute value of the maximum and minimum bounds absolute values of all
  elements of the set. In this lemma the absolute values of ekements of a
  set are represented as the elements of the image of the set by the absolute
  value function.\<close>

lemma (in group3) OrderedGroup_ZF_4_L3:
  assumes "r {is total on} G" and "A \<subseteq> G"
  and "HasAmaximum(r,A)" "HasAminimum(r,A)"
  and "b \<in> AbsoluteValue(G,P,r)``(A)"
  shows "b\<lsq> GreaterOf(r,|Minimum(r,A)|,|Maximum(r,A)|)"
  using assms OrderedGroup_ZF_3_L1 func_imagedef OrderedGroup_ZF_4_L2
  by auto

text\<open>If a set has a maximum and minimum, then the set of absolute values
  also has a maximum.\<close>

lemma (in group3) OrderedGroup_ZF_4_L4:
  assumes A1: "r {is total on} G" and A2: "A \<subseteq> G"
  and A3: "HasAmaximum(r,A)" "HasAminimum(r,A)"
  shows "HasAmaximum(r,AbsoluteValue(G,P,r)``(A))"
proof -
  let ?M = "GreaterOf(r,|Minimum(r,A)|,|Maximum(r,A)|)"
  from A2 A3 have "?M \<in> AbsoluteValue(G,P,r)``(A)"
    using OrderedGroup_ZF_4_L1 by simp
  moreover from A1 A2 A3 have
    "\<forall>b \<in> AbsoluteValue(G,P,r)``(A). b \<lsq> ?M"
    using OrderedGroup_ZF_4_L3 by simp
  ultimately show ?thesis using HasAmaximum_def by auto
qed

text\<open>If a set has a maximum and a minimum, then all absolute values are
  bounded by the maximum of the set of absolute values.\<close>

lemma (in group3) OrderedGroup_ZF_4_L5:
  assumes A1: "r {is total on} G" and A2: "A \<subseteq> G"
  and A3: "HasAmaximum(r,A)" "HasAminimum(r,A)"
  and A4: "a\<in>A"
  shows "|a| \<lsq> Maximum(r,AbsoluteValue(G,P,r)``(A))"
proof -
  from A2 A4 have "|a| \<in> AbsoluteValue(G,P,r)``(A)"
    using OrderedGroup_ZF_3_L1 func_imagedef by auto
  with ordGroupAssum A1 A2 A3 show ?thesis using
    IsAnOrdGroup_def IsPartOrder_def OrderedGroup_ZF_4_L4
    Order_ZF_4_L3 by simp
qed

subsection\<open>Alternative definitions\<close>

text\<open>Sometimes it is usful to define the order by prescibing the set
  of positive or nonnegative elements. This section deals with two such
  definitions. One takes a subset $H$ of $G$ that is closed under the group
  operation, $1\notin H$ and for every $a\in H$ we have either $a\in H$ or
  $a^{-1}\in H$. Then the order is defined as $a\leq b$ iff $a=b$ or
  $a^{-1}b \in H$. For abelian groups this makes a linearly ordered group.
  We will refer to order defined this way in the comments as the order
  defined by a positive set. The context used in this section is the
  \<open>group0\<close> context defined in \<open>Group_ZF\<close> theory. Recall that
  \<open>f\<close> in that context denotes the group operation (unlike in the
  previous sections where the group operation was denoted \<open>P\<close>.\<close>

text\<open>The order defined by a positive set is the same as the order defined by
  a nonnegative set.\<close>

lemma (in group0) OrderedGroup_ZF_5_L1:
  assumes A1: "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  shows "\<langle>a,b\<rangle> \<in> r  \<longleftrightarrow> a\<in>G \<and> b\<in>G \<and> a\<inverse>\<cdot>b \<in> H \<union> {\<one>}"
proof
  assume "\<langle>a,b\<rangle> \<in> r"
  with A1 show "a\<in>G \<and> b\<in>G \<and> a\<inverse>\<cdot>b \<in> H \<union> {\<one>}"
    using group0_2_L6 by auto
next assume "a\<in>G \<and> b\<in>G \<and> a\<inverse>\<cdot>b \<in> H \<union> {\<one>}"
   then have "a\<in>G \<and> b\<in>G \<and> b=(a\<inverse>)\<inverse> \<or>  a\<in>G \<and> b\<in>G \<and> a\<inverse>\<cdot>b \<in> H"
    using  inverse_in_group group0_2_L9 by auto
  with A1 show "\<langle>a,b\<rangle> \<in> r" using group_inv_of_inv
    by auto
qed

text\<open>The relation defined by a positive set is antisymmetric.\<close>

lemma (in group0) OrderedGroup_ZF_5_L2:
  assumes A1: "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  and A2: "\<forall>a\<in>G. a\<noteq>\<one> \<longrightarrow> (a\<in>H) Xor (a\<inverse>\<in>H)"
  shows "antisym(r)"
proof -
  { fix a b assume A3: "\<langle>a,b\<rangle> \<in> r"  "\<langle>b,a\<rangle> \<in> r"
    with A1 have T: "a\<in>G"  "b\<in>G" by auto
    { assume A4: "a\<noteq>b"
      with A1 A3 have "a\<inverse>\<cdot>b \<in> G"  "a\<inverse>\<cdot>b \<in> H"  "(a\<inverse>\<cdot>b)\<inverse> \<in> H"
	using inverse_in_group group0_2_L1 monoid0.group0_1_L1 group0_2_L12
	by auto
      with A2 have "a\<inverse>\<cdot>b = \<one>" using Xor_def by auto
      with T A4 have False using group0_2_L11 by auto
    } then have "a=b" by auto
  } then show "antisym(r)" by (rule antisymI)
qed

text\<open>The relation defined by a positive set is transitive.\<close>

lemma (in group0) OrderedGroup_ZF_5_L3:
  assumes A1: "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  and A2: "H\<subseteq>G"  "H {is closed under} P"
  shows "trans(r)"
proof -
  { fix a b c assume "\<langle>a,b\<rangle> \<in> r"  "\<langle>b,c\<rangle> \<in> r"
    with A1 have
      "a\<in>G \<and> b\<in>G \<and> a\<inverse>\<cdot>b \<in> H \<union> {\<one>}"
      "b\<in>G \<and> c\<in>G \<and> b\<inverse>\<cdot>c \<in> H \<union> {\<one>}"
      using OrderedGroup_ZF_5_L1 by auto
    with A2 have
      I: "a\<in>G"  "b\<in>G"  "c\<in>G"
      and "(a\<inverse>\<cdot>b)\<cdot>(b\<inverse>\<cdot>c) \<in>  H \<union> {\<one>}"
      using inverse_in_group group0_2_L17 IsOpClosed_def
      by auto
    moreover from I have "a\<inverse>\<cdot>c = (a\<inverse>\<cdot>b)\<cdot>(b\<inverse>\<cdot>c)"
      by (rule group0_2_L14A)
    ultimately have "\<langle>a,c\<rangle> \<in> G\<times>G"  "a\<inverse>\<cdot>c  \<in>  H \<union> {\<one>}"
      by auto
    with A1 have "\<langle>a,c\<rangle> \<in> r" using OrderedGroup_ZF_5_L1
      by auto
  } then have "\<forall> a b c. \<langle>a, b\<rangle> \<in> r \<and> \<langle>b, c\<rangle> \<in> r \<longrightarrow> \<langle>a, c\<rangle> \<in> r"
    by blast
  then show  "trans(r)" by (rule Fol1_L2)
qed

text\<open>The relation defined by a positive set is translation invariant.
  With our definition this step requires the group to be abelian.\<close>

lemma (in group0) OrderedGroup_ZF_5_L4:
  assumes A1: "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  and A2: "P {is commutative on} G"
  and A3: "\<langle>a,b\<rangle> \<in> r"  and A4: "c\<in>G"
  shows "\<langle>a\<cdot>c,b\<cdot>c\<rangle> \<in> r \<and> \<langle>c\<cdot>a,c\<cdot>b\<rangle> \<in> r"
proof
  from A1 A3 A4 have
    I: "a\<in>G"  "b\<in>G"  "a\<cdot>c \<in> G"  "b\<cdot>c \<in> G"
    and II: "a\<inverse>\<cdot>b \<in> H \<union> {\<one>}"
    using OrderedGroup_ZF_5_L1 group_op_closed
    by auto
  with A2 A4 have "(a\<cdot>c)\<inverse>\<cdot>(b\<cdot>c) \<in> H \<union> {\<one>}"
    using group0_4_L6D by simp
  with A1 I show "\<langle>a\<cdot>c,b\<cdot>c\<rangle> \<in> r" using  OrderedGroup_ZF_5_L1
    by auto
  with A2 A4 I show "\<langle>c\<cdot>a,c\<cdot>b\<rangle> \<in> r"
    using IsCommutative_def by simp
qed

text\<open>If $H\subseteq G$ is closed under the group operation
  $1\notin H$ and for every $a\in H$ we have either $a\in H$ or
  $a^{-1}\in H$, then the relation "$\leq$" defined by
  $a\leq b \Leftrightarrow a^{-1}b \in H$ orders the group $G$.
  In such order $H$ may be the set of positive or nonnegative
  elements.\<close>

lemma (in group0) OrderedGroup_ZF_5_L5:
  assumes A1: "P {is commutative on} G"
  and A2: "H\<subseteq>G"  "H {is closed under} P"
  and A3: "\<forall>a\<in>G. a\<noteq>\<one> \<longrightarrow> (a\<in>H) Xor (a\<inverse>\<in>H)"
  and A4: "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  shows
  "IsAnOrdGroup(G,P,r)"
  "r {is total on} G"
  "Nonnegative(G,P,r) = PositiveSet(G,P,r) \<union> {\<one>}"
proof -
  from groupAssum A2 A3 A4 have
    "IsAgroup(G,P)"  "r \<subseteq> G\<times>G"  "IsPartOrder(G,r)"
    using refl_def OrderedGroup_ZF_5_L2 OrderedGroup_ZF_5_L3
      IsPartOrder_def by auto
  moreover from A1 A4 have
    "\<forall>g\<in>G. \<forall>a b. \<langle> a,b\<rangle> \<in> r \<longrightarrow> \<langle>a\<cdot>g,b\<cdot>g\<rangle> \<in> r \<and> \<langle>g\<cdot>a,g\<cdot>b\<rangle> \<in> r"
    using OrderedGroup_ZF_5_L4 by blast
  ultimately show "IsAnOrdGroup(G,P,r)"
    using IsAnOrdGroup_def by simp
  then show "Nonnegative(G,P,r) = PositiveSet(G,P,r) \<union> {\<one>}"
    using group3_def group3.OrderedGroup_ZF_1_L24
    by simp
  { fix a b
    assume T: "a\<in>G"  "b\<in>G"
    then have T1: "a\<inverse>\<cdot>b \<in> G"
      using inverse_in_group group_op_closed by simp
    { assume "\<langle> a,b\<rangle> \<notin> r"
      with A4 T have I: "a\<noteq>b" and II: "a\<inverse>\<cdot>b \<notin> H"
	by auto
      from A3 T T1 I have "(a\<inverse>\<cdot>b \<in> H) Xor ((a\<inverse>\<cdot>b)\<inverse> \<in> H)"
	using group0_2_L11 by auto
      with A4 T II have "\<langle> b,a\<rangle> \<in> r"
	using Xor_def group0_2_L12 by simp
    } then have "\<langle> a,b\<rangle> \<in> r \<or> \<langle> b,a\<rangle> \<in> r" by auto
  } then show "r {is total on} G" using IsTotal_def
    by simp
qed

text\<open>If the set defined as in \<open>OrderedGroup_ZF_5_L4\<close> does not
  contain the neutral element, then it is the positive set for the resulting
  order.\<close>

lemma (in group0) OrderedGroup_ZF_5_L6:
  assumes "P {is commutative on} G"
  and "H\<subseteq>G" and "\<one> \<notin> H"
  and "r = {p \<in> G\<times>G. fst(p) = snd(p) \<or> fst(p)\<inverse>\<cdot>snd(p) \<in> H}"
  shows "PositiveSet(G,P,r) = H"
  using assms group_inv_of_one group0_2_L2 PositiveSet_def
  by auto

text\<open>The next definition describes how we construct an order relation
  from the prescribed set of positive elements.\<close>

definition
  "OrderFromPosSet(G,P,H) \<equiv>
  {p \<in> G\<times>G. fst(p) = snd(p) \<or> P`\<langle>GroupInv(G,P)`(fst(p)),snd(p)\<rangle> \<in> H }"

text\<open>The next theorem rephrases lemmas
  \<open>OrderedGroup_ZF_5_L5\<close> and \<open>OrderedGroup_ZF_5_L6\<close>
  using the definition of the order from the positive set
  \<open>OrderFromPosSet\<close>. To summarize, this is what it says:
  Suppose that $H\subseteq G$ is a set closed under that group operation
  such that $1\notin H$ and for every nonunit group element $a$ either $a\in H$
  or $a^{-1}\in H$. Define the order as $a\leq b$ iff $a=b$ or
  $a^{-1}\cdot b \in H$. Then this order makes $G$ into a linearly ordered
  group such $H$ is the set of positive elements (and then of course
  $H \cup \{1\}$ is the set of nonnegative elements).\<close>

theorem (in group0) Group_ord_by_positive_set:
  assumes "P {is commutative on} G"
  and "H\<subseteq>G"   "H {is closed under} P"   "\<one> \<notin> H"
  and "\<forall>a\<in>G. a\<noteq>\<one> \<longrightarrow> (a\<in>H) Xor (a\<inverse>\<in>H)"
  shows
  "IsAnOrdGroup(G,P,OrderFromPosSet(G,P,H))"
  "OrderFromPosSet(G,P,H) {is total on} G"
  "PositiveSet(G,P,OrderFromPosSet(G,P,H)) = H"
  "Nonnegative(G,P,OrderFromPosSet(G,P,H)) = H \<union> {\<one>}"
  using assms OrderFromPosSet_def OrderedGroup_ZF_5_L5 OrderedGroup_ZF_5_L6
  by auto

subsection\<open>Odd Extensions\<close>

text\<open>In this section we verify properties of odd extensions of functions
  defined on $G_+$. An odd extension of a function $f: G_+ \rightarrow G$
  is a function $f^\circ : G\rightarrow G$ defined by $f^\circ (x) = f(x)$
  if $x\in G_+$, $f(1) = 1$ and $f^\circ (x) = (f(x^{-1}))^{-1}$ for $x < 1$.
  Such function is the unique odd function that is equal to $f$ when
  restricted to $G_+$.\<close>

text\<open>The next lemma is just to see the definition of the odd extension
  in the notation used in the \<open>group1\<close> context.\<close>

lemma (in group3) OrderedGroup_ZF_6_L1:
  shows "f\<degree> = f \<union> {\<langle>a, (f`(a\<inverse>))\<inverse>\<rangle>. a \<in> \<sm>G\<^sub>+} \<union> {\<langle>\<one>,\<one>\<rangle>}"
  using OddExtension_def by simp

text\<open>A technical lemma that states that from a function defined on
  \<open>G\<^sub>+\<close> with values in $G$ we have $(f(a^{-1}))^{-1}\in G$.\<close>

lemma (in group3) OrderedGroup_ZF_6_L2:
  assumes "f: G\<^sub>+\<rightarrow>G" and "a\<in>\<sm>G\<^sub>+"
  shows
  "f`(a\<inverse>) \<in> G"
  "(f`(a\<inverse>))\<inverse> \<in> G"
  using assms OrderedGroup_ZF_1_L27 apply_funtype
    OrderedGroup_ZF_1_L1 group0.inverse_in_group
  by auto

text\<open>The main theorem about odd extensions. It basically says that the odd
  extension of a function is what we want to to be.\<close>

lemma (in group3) odd_ext_props:
  assumes A1: "r {is total on} G" and A2: "f: G\<^sub>+\<rightarrow>G"
  shows
  "f\<degree> : G \<rightarrow> G"
  "\<forall>a\<in>G\<^sub>+. (f\<degree>)`(a) = f`(a)"
  "\<forall>a\<in>(\<sm>G\<^sub>+). (f\<degree>)`(a) = (f`(a\<inverse>))\<inverse>"
  "(f\<degree>)`(\<one>) = \<one>"
proof -
  from A1 A2 have I:
    "f: G\<^sub>+\<rightarrow>G"
    "\<forall>a\<in>\<sm>G\<^sub>+. (f`(a\<inverse>))\<inverse> \<in> G"
    "G\<^sub>+\<inter>(\<sm>G\<^sub>+) = 0"
    "\<one> \<notin> G\<^sub>+\<union>(\<sm>G\<^sub>+)"
    "f\<degree> = f \<union> {\<langle>a, (f`(a\<inverse>))\<inverse>\<rangle>. a \<in> \<sm>G\<^sub>+} \<union> {\<langle>\<one>,\<one>\<rangle>}"
    using OrderedGroup_ZF_6_L2 OrdGroup_decomp2 OrderedGroup_ZF_6_L1
    by auto
  then have "f\<degree>: G\<^sub>+ \<union> (\<sm>G\<^sub>+) \<union> {\<one>} \<rightarrow>G\<union>G\<union>{\<one>}"
    by (rule func1_1_L11E)
  moreover from A1 have
    "G\<^sub>+ \<union> (\<sm>G\<^sub>+) \<union> {\<one>} = G"
    "G\<union>G\<union>{\<one>} = G"
    using OrdGroup_decomp2 OrderedGroup_ZF_1_L1 group0.group0_2_L2
    by auto
  ultimately show "f\<degree> : G \<rightarrow> G" by simp
  from I show "\<forall>a\<in>G\<^sub>+. (f\<degree>)`(a) = f`(a)"
    by (rule func1_1_L11E)
  from I show "\<forall>a\<in>(\<sm>G\<^sub>+). (f\<degree>)`(a) = (f`(a\<inverse>))\<inverse>"
    by (rule func1_1_L11E)
  from I show "(f\<degree>)`(\<one>) = \<one>"
    by (rule func1_1_L11E)
qed

text\<open>Odd extensions are odd, of course.\<close>

lemma (in group3) oddext_is_odd:
  assumes A1: "r {is total on} G" and A2: "f: G\<^sub>+\<rightarrow>G"
  and A3: "a\<in>G"
  shows "(f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
proof -
  from A1 A3 have "a\<in>G\<^sub>+ \<or> a \<in> (\<sm>G\<^sub>+) \<or> a=\<one>"
    using OrdGroup_decomp2 by blast
  moreover
  { assume "a\<in>G\<^sub>+"
    with A1 A2 have "a\<inverse> \<in> \<sm>G\<^sub>+" and  "(f\<degree>)`(a) = f`(a)"
      using OrderedGroup_ZF_1_L25 odd_ext_props by auto
    with A1 A2 have
      "(f\<degree>)`(a\<inverse>) = (f`((a\<inverse>)\<inverse>))\<inverse>"  and "(f`(a))\<inverse> = ((f\<degree>)`(a))\<inverse>"
      using odd_ext_props by auto
    with A3 have "(f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
      using OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
      by simp }
  moreover
  { assume A4: "a \<in> \<sm>G\<^sub>+"
    with A1 A2  have "a\<inverse> \<in> G\<^sub>+" and  "(f\<degree>)`(a) = (f`(a\<inverse>))\<inverse>"
      using OrderedGroup_ZF_1_L27 odd_ext_props
      by auto
    with A1 A2 A4 have "(f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
      using odd_ext_props OrderedGroup_ZF_6_L2
	OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
      by simp }
  moreover
  { assume "a = \<one>"
    with A1 A2 have "(f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
      using OrderedGroup_ZF_1_L1 group0.group_inv_of_one
	odd_ext_props by simp
  }
  ultimately show "(f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
    by auto
qed

text\<open>Another way of saying that odd extensions are odd.\<close>

lemma (in group3) oddext_is_odd_alt:
  assumes A1: "r {is total on} G" and A2: "f: G\<^sub>+\<rightarrow>G"
  and A3: "a\<in>G"
  shows "((f\<degree>)`(a\<inverse>))\<inverse> = (f\<degree>)`(a)"
proof -
  from A1 A2 have
    "f\<degree> : G \<rightarrow> G"
    "\<forall>a\<in>G. (f\<degree>)`(a\<inverse>) = ((f\<degree>)`(a))\<inverse>"
    using odd_ext_props oddext_is_odd by auto
  then have "\<forall>a\<in>G. ((f\<degree>)`(a\<inverse>))\<inverse> = (f\<degree>)`(a)"
    using OrderedGroup_ZF_1_L1 group0.group0_6_L2 by simp
  with A3 show "((f\<degree>)`(a\<inverse>))\<inverse> = (f\<degree>)`(a)" by simp
qed

subsection\<open>Functions with infinite limits\<close>

text\<open>In this section we consider functions $f: G\rightarrow G$ with the
  property that for $f(x)$ is arbitrarily large for large enough $x$.
  More precisely, for every $a\in G$ there exist $b\in G_+$ such that
  for every $x\geq b$ we have $f(x)\geq a$. In a sense this means that
  $\lim_{x\rightarrow \infty}f(x) = \infty$, hence the title of this section.
  We also prove dual statements for functions such that
  $\lim_{x\rightarrow -\infty}f(x) = -\infty$.
\<close>

text\<open>If an image of a set by a function with infinite positive limit
  is bounded above, then the set itself is bounded above.\<close>

lemma (in group3) OrderedGroup_ZF_7_L1:
  assumes A1: "r {is total on} G" and A2: "G \<noteq> {\<one>}" and
  A3: "f:G\<rightarrow>G" and
  A4: "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>x. b\<lsq>x \<longrightarrow> a \<lsq> f`(x)" and
  A5: "A\<subseteq>G" and
  A6: "IsBoundedAbove(f``(A),r)"
  shows "IsBoundedAbove(A,r)"
proof -
  { assume "\<not>IsBoundedAbove(A,r)"
    then have I: "\<forall>u. \<exists>x\<in>A. \<not>(x\<lsq>u)"
      using IsBoundedAbove_def by auto
    have "\<forall>a\<in>G. \<exists>y\<in>f``(A). a\<lsq>y"
    proof -
      { fix a assume "a\<in>G"
	with A4 obtain b where
	  II: "b\<in>G\<^sub>+" and III: "\<forall>x. b\<lsq>x \<longrightarrow> a \<lsq> f`(x)"
	  by auto
	from I obtain x where IV: "x\<in>A" and "\<not>(x\<lsq>b)"
	  by auto
	with A1 A5 II have
	  "r {is total on} G"
	  "x\<in>G"  "b\<in>G"  "\<not>(x\<lsq>b)"
	  using PositiveSet_def by auto
	with III have "a \<lsq> f`(x)"
	  using OrderedGroup_ZF_1_L8 by blast
	with A3 A5 IV have "\<exists>y\<in>f``(A). a\<lsq>y"
	  using func_imagedef by auto
      } thus ?thesis by simp
    qed
    with A1 A2 A6 have False using OrderedGroup_ZF_2_L2A
      by simp
  } thus ?thesis by auto
qed

text\<open>If an image of a set defined by separation
  by a function with infinite positive limit
  is bounded above, then the set itself is bounded above.\<close>

lemma (in group3) OrderedGroup_ZF_7_L2:
  assumes A1: "r {is total on} G" and A2: "G \<noteq> {\<one>}" and
  A3: "X\<noteq>0" and A4: "f:G\<rightarrow>G" and
  A5: "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> f`(y)" and
  A6: "\<forall>x\<in>X. b(x) \<in> G \<and> f`(b(x)) \<lsq> U"
  shows "\<exists>u.\<forall>x\<in>X. b(x) \<lsq> u"
proof -
  let ?A = "{b(x). x\<in>X}"
  from A6 have I: "?A\<subseteq>G" by auto
  moreover note assms
  moreover have "IsBoundedAbove(f``(?A),r)"
  proof -
    from A4 A6 I have "\<forall>z\<in>f``(?A). \<langle>z,U\<rangle> \<in> r"
      using func_imagedef by simp
    then show "IsBoundedAbove(f``(?A),r)"
      by (rule Order_ZF_3_L10)
  qed
  ultimately have "IsBoundedAbove(?A,r)" using OrderedGroup_ZF_7_L1
    by simp
  with A3 have "\<exists>u.\<forall>y\<in>?A. y \<lsq> u"
    using IsBoundedAbove_def by simp
  then show "\<exists>u.\<forall>x\<in>X. b(x) \<lsq> u" by auto
qed

text\<open>If the image of a set defined by separation
  by a function with infinite negative limit
  is bounded below, then the set itself is bounded above.
  This is dual to \<open>OrderedGroup_ZF_7_L2\<close>.\<close>

lemma (in group3) OrderedGroup_ZF_7_L3:
  assumes A1: "r {is total on} G" and A2: "G \<noteq> {\<one>}" and
  A3: "X\<noteq>0" and A4: "f:G\<rightarrow>G" and
  A5: "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> f`(y\<inverse>) \<lsq> a" and
  A6: "\<forall>x\<in>X. b(x) \<in> G \<and> L \<lsq> f`(b(x))"
  shows "\<exists>l.\<forall>x\<in>X. l \<lsq> b(x)"
proof -
  let ?g = "GroupInv(G,P) O f O GroupInv(G,P)"
  from ordGroupAssum have I: "GroupInv(G,P) : G\<rightarrow>G"
    using IsAnOrdGroup_def group0_2_T2 by simp
  with A4 have II: "\<forall>x\<in>G. ?g`(x) = (f`(x\<inverse>))\<inverse>"
    using func1_1_L18 by simp
  note A1 A2 A3
  moreover from A4 I have "?g : G\<rightarrow>G"
    using comp_fun by blast
  moreover have "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> ?g`(y)"
  proof -
  { fix a assume A7: "a\<in>G"
    then have "a\<inverse> \<in> G"
      using OrderedGroup_ZF_1_L1 group0.inverse_in_group
      by simp
    with A5 obtain b where
      III: "b\<in>G\<^sub>+" and "\<forall>y. b\<lsq>y \<longrightarrow> f`(y\<inverse>) \<lsq> a\<inverse>"
      by auto
    with II A7 have "\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> ?g`(y)"
      using OrderedGroup_ZF_1_L5AD OrderedGroup_ZF_1_L4
      by simp
    with III have "\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> ?g`(y)"
      by auto
  } then show "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> ?g`(y)"
    by simp
  qed
  moreover have "\<forall>x\<in>X. b(x)\<inverse> \<in> G \<and> ?g`(b(x)\<inverse>) \<lsq> L\<inverse>"
  proof-
    { fix x assume "x\<in>X"
      with A6 have
	T: "b(x) \<in> G"  "b(x)\<inverse> \<in> G" and "L \<lsq> f`(b(x))"
	using OrderedGroup_ZF_1_L1 group0.inverse_in_group
	by auto
      then have "(f`(b(x)))\<inverse> \<lsq> L\<inverse>"
	using OrderedGroup_ZF_1_L5 by simp
      moreover from II T have "(f`(b(x)))\<inverse> =  ?g`(b(x)\<inverse>)"
	using OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
	by simp
      ultimately have "?g`(b(x)\<inverse>) \<lsq> L\<inverse>" by simp
      with T have "b(x)\<inverse> \<in> G \<and> ?g`(b(x)\<inverse>) \<lsq> L\<inverse>"
	by simp
    } then show "\<forall>x\<in>X. b(x)\<inverse> \<in> G \<and> ?g`(b(x)\<inverse>) \<lsq> L\<inverse>"
      by simp
  qed
  ultimately have "\<exists>u.\<forall>x\<in>X. (b(x))\<inverse> \<lsq> u"
    by (rule OrderedGroup_ZF_7_L2)
  then have "\<exists>u.\<forall>x\<in>X. u\<inverse> \<lsq> (b(x)\<inverse>)\<inverse>"
    using OrderedGroup_ZF_1_L5 by auto
  with A6 show "\<exists>l.\<forall>x\<in>X. l \<lsq> b(x)"
    using OrderedGroup_ZF_1_L1 group0.group_inv_of_inv
    by auto
qed

text\<open>The next lemma combines \<open>OrderedGroup_ZF_7_L2\<close> and
  \<open>OrderedGroup_ZF_7_L3\<close> to show that if an image of a set
  defined by separation by a function with infinite limits is bounded,
  then the set itself i bounded.\<close>

lemma (in group3) OrderedGroup_ZF_7_L4:
  assumes A1: "r {is total on} G" and A2: "G \<noteq> {\<one>}" and
  A3: "X\<noteq>0" and A4: "f:G\<rightarrow>G" and
  A5: "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> a \<lsq> f`(y)" and
  A6: "\<forall>a\<in>G.\<exists>b\<in>G\<^sub>+.\<forall>y. b\<lsq>y \<longrightarrow> f`(y\<inverse>) \<lsq> a" and
  A7: "\<forall>x\<in>X. b(x) \<in> G \<and> L \<lsq> f`(b(x)) \<and> f`(b(x)) \<lsq> U"
shows "\<exists>M.\<forall>x\<in>X. |b(x)| \<lsq> M"
proof -
  from A7 have
    I: "\<forall>x\<in>X. b(x) \<in> G \<and> f`(b(x)) \<lsq> U" and
    II: "\<forall>x\<in>X. b(x) \<in> G \<and> L \<lsq> f`(b(x))"
    by auto
  from A1 A2 A3 A4 A5 I have "\<exists>u.\<forall>x\<in>X. b(x) \<lsq> u"
    by (rule OrderedGroup_ZF_7_L2)
  moreover from  A1 A2 A3 A4 A6 II have "\<exists>l.\<forall>x\<in>X. l \<lsq> b(x)"
    by (rule OrderedGroup_ZF_7_L3)
  ultimately have "\<exists>u l. \<forall>x\<in>X. l\<lsq>b(x) \<and> b(x) \<lsq> u"
    by auto
  with A1 have "\<exists>u l.\<forall>x\<in>X. |b(x)| \<lsq> GreaterOf(r,|l|,|u|)"
    using OrderedGroup_ZF_3_L10 by blast
  then show "\<exists>M.\<forall>x\<in>X. |b(x)| \<lsq> M"
    by auto
qed

end


theory FindP
  imports Verification "~~/src/HOL/Eisbach/Eisbach"
begin

definition while_loop :: "bool_expr \<Rightarrow> program \<Rightarrow> program" ("while _ do { _ }" [51] 55) where
  "while B do { P } \<equiv> (test B; P)\<^sup>\<star> ; test (BNot B)"

lemma while_loop_rule:
  assumes "R\<^sup>* \<subseteq> (preserve I)\<^sup>*"
  and "test (BNot B \<otimes> I) \<noteq> {}"
  and "test (I \<otimes> B) \<noteq> {}"
  and "test P \<subseteq> test I" and "test (BNot B \<otimes> I) \<subseteq> test Q"
  and "R, G \<turnstile> \<lbrace>I \<otimes> B\<rbrace> X \<lbrace>I\<rbrace>"
  shows "R, G \<turnstile> \<lbrace>P\<rbrace> while B do { X } \<lbrace>Q\<rbrace>"
  apply (simp add: while_loop_def sequential_composition_def)
  apply (rule_tac P = "I" and Q = "BNot B \<otimes> I" in weakening)
  apply (rule assms(4))
  apply (rule assms(5))
  apply (rule order.refl)
  apply (rule order.refl)
  apply (rule while_rule)
  apply (simp_all add: assms)
  done

definition if_statement :: "bool_expr \<Rightarrow> program \<Rightarrow> program \<Rightarrow> program" ("if _ { _ } else { _ }" [51,51,51] 55) where
  "if P { X } else { Y } \<equiv> (test P; X) \<union> (test (BNot P); Y)"

lemma if_statement_rule:
  "R\<^sup>* \<subseteq> (\<P> P)\<^sup>* \<Longrightarrow> \<T> Q \<noteq> {} \<Longrightarrow> R, G \<turnstile> \<lbrace>P \<otimes> B\<rbrace> X \<lbrace>Q\<rbrace> \<Longrightarrow> R, G \<turnstile> \<lbrace>P \<otimes> BNot B\<rbrace> Y \<lbrace>Q\<rbrace> \<Longrightarrow> R, G \<turnstile> \<lbrace>P\<rbrace> if B { X } else { Y } \<lbrace>Q\<rbrace>"
  apply (simp only: if_statement_def sequential_composition_def)
  apply (rule if_rule)
  by simp_all

definition lessthan :: "var \<Rightarrow> var \<Rightarrow> bool_expr" (infix "less than" 71) where
  "x less than y \<equiv> BExpr2 (op <) (Var x) (Var y)"

definition par_A :: "(nat \<Rightarrow> bool) \<Rightarrow> program" where
"par_A P \<equiv>
i\<^sub>A := Const 0;
while (i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B) do {
  if BExpr1 P (Lookup (Var i\<^sub>A)) {
    f\<^sub>A := Var i\<^sub>A
  } else {
    i\<^sub>A := BinOp (op +) (Var i\<^sub>A) (Const 2)
  }
}
"

definition par_B :: "(nat \<Rightarrow> bool) \<Rightarrow> program" where
"par_B P \<equiv>
i\<^sub>B := Const 1;
while (i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B) do {
  if BExpr1 P (Lookup (Var i\<^sub>B)) {
    f\<^sub>B := Var i\<^sub>B
  } else {
    i\<^sub>B := BinOp (op +) (Var i\<^sub>B) (Const 2)
  }
}
"

definition findp :: "(nat \<Rightarrow> bool) \<Rightarrow> program" where
"findp P \<equiv>
f\<^sub>A := ALen;
f\<^sub>B := ALen;
parallel {
  i\<^sub>A := Const 0;
  while (i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B) do {
    if BExpr1 P (Lookup (Var i\<^sub>A)) {
      f\<^sub>A := Var i\<^sub>A
    } else {
      i\<^sub>A := BinOp (op +) (Var i\<^sub>A) (Const 2)
    }
  }
} meanwhile {
  i\<^sub>B := Const 1;
  while (i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B) do {
    if BExpr1 P (Lookup (Var i\<^sub>B)) {
      f\<^sub>B := Var i\<^sub>B
    } else {
      i\<^sub>B := BinOp (op +) (Var i\<^sub>B) (Const 2)
    }
  }
};
fmax := BinOp min (Var f\<^sub>A) (Var f\<^sub>B)
"

lemma sequential_rule2: "R, G \<turnstile> \<lbrace>P\<rbrace> x \<lbrace>S\<rbrace> \<Longrightarrow> R, G \<turnstile> \<lbrace>S\<rbrace> y \<lbrace>Q\<rbrace> \<Longrightarrow> R, G \<turnstile> \<lbrace>P\<rbrace> x; y \<lbrace>Q\<rbrace>"
  by (metis sequential_composition_def sequential_rule)

definition "invariant_A P \<equiv>
  BArray (\<lambda>i arr. \<forall>i'. i' < i \<and> even i' \<longrightarrow> \<not> P (arr ! i')) (Var i\<^sub>A)
  \<otimes> BExpr1 even (Var i\<^sub>A)
  \<otimes> BArray (\<lambda>i arr. i < length arr \<longrightarrow> P (arr ! i)) (Var f\<^sub>A)
  \<otimes> BExpr2 (op <) (Var f\<^sub>A) (BinOp (op +) ALen (Const 1))"

definition "invariant_B P \<equiv>
  BArray (\<lambda>i arr. \<forall>i'. i' < i \<and> odd i' \<longrightarrow> \<not> P (arr ! i')) (Var i\<^sub>B)
  \<otimes> BExpr1 odd (Var i\<^sub>B)
  \<otimes> BArray (\<lambda>i arr. i < length arr \<longrightarrow> P (arr ! i)) (Var f\<^sub>B)
  \<otimes> BExpr2 (op <) (Var f\<^sub>B) (BinOp (op +) ALen (Const 1))"

definition "loop_post P \<equiv>
  BExpr2 (op <) (BinOp min (Var f\<^sub>A) (Var f\<^sub>B)) (BinOp (op +) ALen (Const 1))
  \<otimes> BArray (\<lambda>fmax arr. \<forall>i. i < fmax \<longrightarrow> \<not> P (arr ! i)) (BinOp min (Var f\<^sub>A) (Var f\<^sub>B))
  \<otimes> BArray (\<lambda>fmax arr. fmax < length arr \<longrightarrow> P (arr ! fmax)) (BinOp min (Var f\<^sub>A) (Var f\<^sub>B))"

lemma [simp]: "(x::nat) < y \<Longrightarrow> min x y = x"
  by auto

lemma
  findp_while_res1:
  "test (invariant_A P \<otimes> invariant_B P \<otimes> BNot ((i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B)) \<otimes> BNot ((i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B))) \<subseteq> test (loop_post P)"
  apply (simp add: invariant_A_def invariant_B_def loop_post_def lessthan_def)
  apply clarify
proof -
  fix s :: store

  def A \<equiv> "s_A s"
  def ia \<equiv> "s_i\<^sub>A s"
  def ib \<equiv> "s_i\<^sub>B s"
  def fa \<equiv> "s_f\<^sub>A s"
  def fb \<equiv> "s_f\<^sub>B s"

  thm A_def

  assume "\<forall>i'. i' < s_i\<^sub>A s \<and> even i' \<longrightarrow> \<not> P (s_A s ! i')"
  and "even (s_i\<^sub>A s)"
  and "s_f\<^sub>A s < length (s_A s) \<longrightarrow> P (s_A s ! s_f\<^sub>A s)"
  and "s_f\<^sub>A s < Suc (length (s_A s))"
  and "\<forall>i'. i' < s_i\<^sub>B s \<and> odd i' \<longrightarrow> \<not> P (s_A s ! i')"
  and "odd (s_i\<^sub>B s)"
  and "s_f\<^sub>B s < length (s_A s) \<longrightarrow> P (s_A s ! s_f\<^sub>B s)"
  and "s_f\<^sub>B s < Suc (length (s_A s))"
  and "\<forall>i'. i' < s_i\<^sub>A s \<and> even i' \<longrightarrow> \<not> P (s_A s ! i')"
  and "s_i\<^sub>A s < s_f\<^sub>A s \<longrightarrow> \<not> s_i\<^sub>A s < s_f\<^sub>B s"
  and "s_i\<^sub>B s < s_f\<^sub>A s \<longrightarrow> \<not> s_i\<^sub>B s < s_f\<^sub>B s"
  thus "min (s_f\<^sub>A s) (s_f\<^sub>B s) < Suc (length (s_A s)) \<and>
        (\<forall>i. i < s_f\<^sub>A s \<and> i < s_f\<^sub>B s \<longrightarrow> \<not> P (s_A s ! i)) \<and>
        (min (s_f\<^sub>A s) (s_f\<^sub>B s) < length (s_A s) \<longrightarrow> P (s_A s ! min (s_f\<^sub>A s) (s_f\<^sub>B s)))"
    apply -
    apply (simp only: A_def[symmetric] ia_def[symmetric] ib_def[symmetric] fa_def[symmetric] fb_def[symmetric])
    apply (cases "fa < fb")
    apply simp
    apply (intro conjI allI)
    apply (intro impI allI)
    apply (erule conjE)
    apply (subgoal_tac "even i \<or> odd i")
    prefer 2
    apply metis
    apply (erule disjE)
    apply (metis le_less_trans not_less)
    apply (metis le_less_trans not_less)
    apply (cases "fb < fa")
    apply simp
    apply (intro conjI allI)
    apply (metis min.commute min.strict_coboundedI2)
    apply (intro impI allI)
    apply (erule conjE)
    apply (subgoal_tac "even i \<or> odd i")
    prefer 2
    apply metis
    apply (erule disjE)
    apply (metis le_less_trans not_less)
    apply (metis le_less_trans not_less)
    apply (metis min_def)
    apply (subgoal_tac "fa = fb")
    prefer 2
    apply (metis linorder_neqE_nat)
    apply simp
    apply (intro conjI allI impI)
    by (metis le_less_trans not_less)
qed

lemma
  findp_parallel_postcondition:
  "test ((BNot ((i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B)) \<otimes> invariant_A P) \<otimes> (BNot ((i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B)) \<otimes> invariant_B P)) \<subseteq> test (loop_post P)"
  apply (rule subset_trans)
  prefer 2
  apply (rule findp_while_res1)
  by simp

lemma test_conj_split: "\<T> P \<subseteq> \<T> (Q \<otimes> S) \<longleftrightarrow> \<T> P \<subseteq> \<T> Q \<and> \<T> P \<subseteq> \<T> S"
  apply (auto simp add: test_def Language.test_def subset_iff)
  apply (metis llast_singleton prod.inject)
  apply (metis llast_singleton prod.inject)
  done

definition "rely_A P \<equiv> {(\<sigma>, \<sigma>') |\<sigma> \<sigma>'.
  s_A \<sigma> = s_A \<sigma>'
\<and> s_f\<^sub>A \<sigma> = s_f\<^sub>A \<sigma>'
\<and> s_i\<^sub>A \<sigma> = s_i\<^sub>A \<sigma>'
\<and> (((\<forall>v<s_f\<^sub>B \<sigma>'. odd v \<longrightarrow> \<not> P (s_A \<sigma>' ! v)) \<and> s_f\<^sub>B \<sigma>' < s_f\<^sub>B \<sigma> \<and> s_f\<^sub>B \<sigma>' = s_i\<^sub>B \<sigma>' \<and> s_i\<^sub>B \<sigma> = s_i\<^sub>B \<sigma>') \<or> (s_i\<^sub>B \<sigma>' < s_i\<^sub>B \<sigma> \<and> s_f\<^sub>B \<sigma> = length (s_A \<sigma>) \<longrightarrow> s_f\<^sub>B \<sigma>' = length (s_A \<sigma>')))}"

definition "rely_B P \<equiv> {(\<sigma>, \<sigma>') |\<sigma> \<sigma>'.
  s_A \<sigma> = s_A \<sigma>'
\<and> s_f\<^sub>B \<sigma> = s_f\<^sub>B \<sigma>'
\<and> s_i\<^sub>B \<sigma> = s_i\<^sub>B \<sigma>'
\<and> (((\<forall>v<s_f\<^sub>A \<sigma>'. even v \<longrightarrow> \<not> P (s_A \<sigma>' ! v)) \<and> s_f\<^sub>A \<sigma>' < s_f\<^sub>A \<sigma> \<and> s_f\<^sub>A \<sigma>' = s_i\<^sub>A \<sigma>' \<and> s_i\<^sub>A \<sigma> = s_i\<^sub>A \<sigma>') \<or> (s_i\<^sub>A \<sigma>' < s_i\<^sub>A \<sigma> \<and> s_f\<^sub>A \<sigma> = length (s_A \<sigma>) \<longrightarrow> s_f\<^sub>A \<sigma>' = length (s_A \<sigma>')))}"

lemma preserve_split: "X \<subseteq> \<P> P \<and> X \<subseteq> \<P> Q \<Longrightarrow> X \<subseteq> \<P> (P \<otimes> Q)"
  by (auto simp add: preserve_def subset_iff)

lemma state_existence: "\<T> X \<noteq> {} \<longleftrightarrow> (\<exists>\<sigma>. eval_bool_expr X \<sigma>)"
  by (auto simp add: test_def Language.test_def)

lemma par_A_proof:
  shows "rely_A P,
         rely_B P \<turnstile>
         \<lbrace>BExpr2 (op =) (Var f\<^sub>A) ALen\<rbrace>
           par_A P
         \<lbrace>BNot (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) \<otimes> invariant_A P\<rbrace>"
  apply (simp add: par_A_def)
  apply (rule_tac S = "BExpr2 (op =) (Var f\<^sub>A) ALen \<otimes> BExpr2 (op =) (Var i\<^sub>A) (Const 0)" in sequential_rule2)
  apply (rule assignment_rule)
  defer
  apply simp
  apply (rule rtrancl_mono)
  apply (simp add: subset_iff store.defs rely_B_def)
  apply simp
  apply (rule_tac I = "invariant_A P" in while_loop_rule)
  defer
  defer
  defer
  apply (simp add: invariant_A_def)
  defer
  apply (simp add: lessthan_def invariant_A_def)
  apply (rule_tac P = "BArray (\<lambda>i arr. \<forall>i'. i' < i \<and> even i' \<longrightarrow> \<not> P (arr ! i')) (Var i\<^sub>A) \<otimes> BExpr1 even (Var i\<^sub>A) \<otimes>
        BArray (\<lambda>i arr. i < length arr \<longrightarrow> P (arr ! i)) (Var f\<^sub>A) \<otimes>
        BExpr2 op < (Var f\<^sub>A) (BinOp op + ALen (Const (Suc 0))) \<otimes>
        BExpr2 op < (Var i\<^sub>A) (Var f\<^sub>A)" in weakening)
  apply simp
  apply (rule order_refl)
  apply (rule order_refl)
  apply (rule order_refl)
  apply (rule if_statement_rule)
  defer
  defer
  apply (rule_tac Q = "invariant_A P \<otimes> BExpr1 P (Lookup (Var i\<^sub>A))" in weakening)
  apply (rule order.refl)
  apply (simp add: invariant_A_def)
  apply (rule order.refl)
  apply (rule order.refl)
  apply (rule assignment_rule)
  defer
  apply (rule rtrancl_mono)
  apply (simp add: store.defs subset_iff lessthan_def invariant_A_def rely_B_def)
  apply (simp add: invariant_A_def)
  apply (rule assignment_rule)
  defer
  apply (rule rtrancl_mono)
  apply (simp add: store.defs subset_iff lessthan_def rely_B_def)
  apply (simp add: invariant_A_def)
  apply (metis even_Suc linorder_neqE_nat not_less_eq)
  prefer 5
  apply simp
  apply (rule rtrancl_mono)
  apply (simp add: rely_A_def preserve_def subset_iff)
  apply (rule rtrancl_mono)
  apply (simp add: rely_A_def preserve_def subset_iff invariant_A_def)
  prefer 3
  apply (rule rtrancl_mono)
  apply (simp add: rely_A_def preserve_def subset_iff)
  prefer 4
  apply (rule rtrancl_mono)
  apply (simp add: rely_A_def preserve_def subset_iff invariant_A_def)
  prefer 4
  apply (rule rtrancl_mono)
  apply (simp add: rely_A_def preserve_def subset_iff)
  apply (simp_all only: state_existence)
  apply (simp add: lessthan_def invariant_A_def)
  apply (rule_tac x = "store.make 0 0 0 0 0 []" in exI)
  apply (simp add: store.defs)
  apply (simp add: lessthan_def invariant_A_def)
  apply (rule_tac x = "store.make 1 1 0 0 0 [1]" in exI)
  apply (simp add: store.defs)
  apply (simp add: lessthan_def invariant_A_def)
  apply (rule_tac x = "store.make 0 0 0 0 0 []" in exI)
  by (simp add: store.defs)

lemma odd_Suc: "odd (Suc x) = even x"
  by (cases x) simp_all

lemma par_B_proof:
  shows "rely_B P,
         rely_A P \<turnstile>
         \<lbrace>BExpr2 (op =) (Var f\<^sub>B) ALen\<rbrace>
           par_B P
         \<lbrace>BNot (i\<^sub>B less than f\<^sub>A \<otimes> i\<^sub>B less than f\<^sub>B) \<otimes> invariant_B P\<rbrace>"
  apply (simp add: par_B_def)
  apply (rule_tac S = "BExpr2 (op =) (Var f\<^sub>B) ALen \<otimes> BExpr2 (op =) (Var i\<^sub>B) (Const 1)" in sequential_rule2)
  apply (rule assignment_rule)
  defer
  apply simp
  apply (rule rtrancl_mono)
  apply (simp add: subset_iff store.defs rely_A_def)
  apply simp
  apply (rule_tac I = "invariant_B P" in while_loop_rule)
  defer
  defer
  defer
  apply (simp add: invariant_B_def)
  defer
  apply (simp add: lessthan_def invariant_B_def)
  apply (rule_tac P = "BArray (\<lambda>i arr. \<forall>i'. i' < i \<and> odd i' \<longrightarrow> \<not> P (arr ! i')) (Var i\<^sub>B) \<otimes> BExpr1 odd (Var i\<^sub>B) \<otimes>
        BArray (\<lambda>i arr. i < length arr \<longrightarrow> P (arr ! i)) (Var f\<^sub>B) \<otimes>
        BExpr2 op < (Var f\<^sub>B) (BinOp op + ALen (Const (Suc 0))) \<otimes>
        BExpr2 op < (Var i\<^sub>B) (Var f\<^sub>B)" in weakening)
  apply (simp add: invariant_B_def lessthan_def)
  apply (rule order_refl)
  apply (rule order_refl)
  apply (rule order_refl)
  apply (rule if_statement_rule)
  defer
  defer
  apply (rule_tac Q = "invariant_B P \<otimes> BExpr1 P (Lookup (Var i\<^sub>B))" in weakening)
  apply (rule order.refl)
  apply (simp add: invariant_B_def)
  apply (rule order.refl)
  apply (rule order.refl)
  apply (rule assignment_rule)
  defer
  apply (rule rtrancl_mono)
  apply (simp add: store.defs subset_iff lessthan_def invariant_B_def rely_A_def)
  apply (simp add: invariant_B_def)
  apply (rule assignment_rule)
  defer
  apply (rule rtrancl_mono)
  apply (simp add: store.defs subset_iff lessthan_def rely_A_def)
  apply (simp add: invariant_B_def)
  apply (metis less_antisym odd_Suc)
  prefer 5
  apply simp
  apply (rule rtrancl_mono)
  apply (simp add: rely_B_def preserve_def subset_iff)
  apply (rule rtrancl_mono)
  apply (simp add: rely_B_def preserve_def subset_iff invariant_B_def)
  prefer 3
  apply (rule rtrancl_mono)
  apply (simp add: rely_B_def preserve_def subset_iff)
  prefer 4
  apply (rule rtrancl_mono)
  apply (simp add: rely_B_def preserve_def subset_iff invariant_B_def)
  prefer 4
  apply (rule rtrancl_mono)
  apply (simp add: rely_B_def preserve_def subset_iff)
  apply (simp_all only: state_existence)
  apply (simp add: lessthan_def invariant_B_def)
  apply (rule_tac x = "store.make 1 1 1 1 1 [1]" in exI)
  apply (simp add: store.defs)
  apply (rule_tac x = "store.make 3 3 1 1 3 [1,2,3]" in exI)
  apply (simp only: lessthan_def invariant_B_def store.defs)
  apply (simp add: invariant_B_def)
  apply (rule_tac x = "store.make 3 3 1 1 3 [1,2,3]" in exI)
  by (simp add: store.defs)

find_theorems name: parallel

lemma "
{},
UNIV \<turnstile>
\<lbrace>\<zero>\<rbrace>
  findp P
\<lbrace>BExpr2 (op <) (Var fmax) (BinOp (op +) ALen (Const 1))
 \<otimes> BArray (\<lambda>fmax arr. \<forall>i. i < fmax \<longrightarrow> \<not> P (arr ! i)) (Var fmax)
 \<otimes> BArray (\<lambda>fmax arr. fmax < length arr \<longrightarrow> P (arr ! fmax)) (Var fmax)\<rbrace>"
  apply (simp add: findp_def)
  apply (rule_tac S = "BExpr2 (op =) (Var f\<^sub>A) ALen" in sequential_rule2)
  apply (rule assignment_rule)
  apply simp
  apply simp
  apply simp
  apply (rule_tac S = "BExpr2 (op =) (Var f\<^sub>A) ALen \<otimes> BExpr2 (op =) (Var f\<^sub>B) ALen" in sequential_rule2)
  apply (rule assignment_rule)
  apply simp
  apply simp
  apply simp
  apply (rule_tac S = "loop_post P" in sequential_rule2)
  prefer 2
  apply (rule assignment_rule)
  apply simp
  apply simp
  apply (simp add: loop_post_def)
  apply (rule_tac R\<^sub>1 = "rely_A P" and G\<^sub>1 = "rely_B P" and R\<^sub>2 = "rely_B P" and G\<^sub>2 = "rely_A P" in parallel_statement_rule)
  apply simp
  apply simp
  apply simp
  apply (rule order_refl)
  apply (rule findp_parallel_postcondition)
  apply (simp_all only: par_A_def[symmetric] par_B_def[symmetric,simplified])
  apply (rule par_A_proof)
  apply (rule par_B_proof)
  done

no_notation Fixpoint.pleq (infix "\<sqsubseteq>" 50)

definition refinement_order :: "program \<Rightarrow> program \<Rightarrow> bool" (infix "\<sqsubseteq>" 50) where
  "x \<sqsubseteq> y \<equiv> y \<le> x"

lemma refine: "x \<le> y \<Longrightarrow> y \<sqsubseteq> x"
  by (simp add: refinement_order_def)

lemma refine_refl [simp]: "x \<sqsubseteq> x"
  by (auto intro: refine)

(* no_notation residual_r (infixr "\<rightarrow>" 60) *)
notation preimp (infixr "\<rightarrow>" 65)

lemma tactic_sequential: "\<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<sqsubseteq> (\<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> S \<inter> guar G)) ; (\<T> S \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G))"
  by (simp add: sequential_composition_def) (rule refine[OF refine_sequential])

lemma verify: "R, G \<turnstile> \<lbrace>P\<rbrace> X \<lbrace>Q\<rbrace> \<Longrightarrow> \<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<sqsubseteq> X"
  by (simp add: quintuple_def refinement_order_def)

lemma verify_refine: "R, G \<turnstile> \<lbrace>P\<rbrace> \<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<lbrace>Q\<rbrace>"
  by (simp add: quintuple_def)

lemma tactic_parallel:
  assumes "(R \<union> G\<^sub>1)\<^sup>* \<subseteq> R\<^sub>2\<^sup>*"
  and "(R \<union> G\<^sub>2)\<^sup>* \<subseteq> R\<^sub>1\<^sup>*"
  and "(G\<^sub>1 \<union> G\<^sub>2)\<^sup>* \<subseteq> G\<^sup>*"
  and "\<T> P \<subseteq> \<T> (P\<^sub>1 \<otimes> P\<^sub>2)"
  and "\<T> (Q\<^sub>1 \<otimes> Q\<^sub>2) \<subseteq> \<T> Q"
  shows "\<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<sqsubseteq>
         parallel {
           \<T> P\<^sub>1 \<rightarrow> (R\<^sub>1 \<rhd> \<F> \<cdot> \<T> Q\<^sub>1 \<inter> guar G\<^sub>1)
         } meanwhile {
           \<T> P\<^sub>2 \<rightarrow> (R\<^sub>2 \<rhd> \<F> \<cdot> \<T> Q\<^sub>2 \<inter> guar G\<^sub>2)
         }"
  apply (rule verify)
  apply (rule parallel_statement_rule[OF assms(1) assms(2) assms(3) assms(4) assms(5)])
  by (rule verify_refine)+

lemma tactic_while:
  assumes "\<T> P \<subseteq> \<T> I"
  and "R\<^sup>* \<subseteq> (\<P> I)\<^sup>*"
  and "\<T> (BNot B \<otimes> I) \<noteq> {}"
  and "\<T> (I \<otimes> B) \<noteq> {}"
  shows "\<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> (BNot B \<otimes> I) \<inter> guar G) \<sqsubseteq> while B do { \<T> (I \<otimes> B) \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> I \<inter> guar G) }"
  apply (rule verify)
  apply (rule while_loop_rule[OF assms(2) assms(3) assms(4) assms(1)])
  apply simp
  by (rule verify_refine)

lemma tactic_if:
  assumes "R\<^sup>* \<subseteq> (\<P> P)\<^sup>*"
  and "\<T> Q \<noteq> {}"
  shows "\<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<sqsubseteq>
         if B {
           \<T> (P \<otimes> B) \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G)
         } else {
           \<T> (P \<otimes> BNot B) \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G)
         }"
  apply (rule verify)
  apply (rule if_statement_rule[OF assms(1) assms(2)])
  by (rule verify_refine)+

lemma seq_isol: "X \<sqsubseteq> Z \<Longrightarrow> X; Y \<sqsubseteq> Z; Y"
  by (simp add: refinement_order_def sequential_composition_def) (simp add: l_prod_isol)

lemma seq_isor: "X \<sqsubseteq> Z \<Longrightarrow> Y; X \<sqsubseteq> Y; Z"
  by (simp add: refinement_order_def sequential_composition_def) (simp add: l_prod_isor)

lemma par_isol: "X \<sqsubseteq> Z \<Longrightarrow> parallel { X } meanwhile { Y } \<sqsubseteq> parallel { Z } meanwhile { Y }"
  by (simp add: refinement_order_def parallel_composition_def par.mult_isor)

lemma par_isor: "X \<sqsubseteq> Z \<Longrightarrow> parallel { Y } meanwhile { X } \<sqsubseteq> parallel { Y } meanwhile { Z }"
  by (simp add: refinement_order_def parallel_composition_def par.mult_isol)

lemma if_isol: "X \<sqsubseteq> Z \<Longrightarrow> if B { X } else { Y } \<sqsubseteq> if B { Z } else { Y }"
  apply (simp add: if_statement_def)
  by (metis l_prod_isor par.add_left_idem refinement_order_def sequential_composition_def sup.mono sup_ge2)

lemma if_isor: "X \<sqsubseteq> Z \<Longrightarrow> if B { Y } else { X } \<sqsubseteq> if B { Y } else { Z }"
  apply (simp add: if_statement_def)
  by (metis Un_upper1 l_prod_isor refinement_order_def sequential_composition_def sup.mono sup.right_idem)

lemma while_body_iso: "X \<sqsubseteq> Z \<Longrightarrow> while B do { X } \<sqsubseteq> while B do { Z }"
  apply (simp add: while_loop_def refinement_order_def sequential_composition_def)
  apply (rule l_prod_isol)
  apply (rule seq.star_iso[rule_format])
  apply (rule l_prod_isor)
  by simp

lemma [trans]: "X \<sqsubseteq> Y \<Longrightarrow> Y \<sqsubseteq> Z \<Longrightarrow> X \<sqsubseteq> Z"
  by (simp add: refinement_order_def)

method isotonicity =
  (rule seq_isol | rule seq_isor | rule par_isol | rule par_isor | rule while_body_iso | rule if_isol | rule if_isor)+

method refine uses add =
  isotonicity?;
  ( rule tactic_sequential
  | (rule tactic_parallel; (simp_all only: add)?; simp_all?)
  | rule tactic_while
  | rule tactic_if
  )

method verify uses add =
  isotonicity?;
  (rule verify);
  (rule assignment_rule);
  ((rule rtrancl_mono)?; (simp add: add))+

method verify_no_simp =
  isotonicity?;
  (rule verify);
  (rule assignment_rule);
  (rule rtrancl_mono)?

definition "postcondition P  \<equiv> BExpr2 (op <) (Var fmax) (BinOp (op +) ALen (Const 1)) \<otimes> BArray (\<lambda>fmax arr. \<forall>i. i < fmax \<longrightarrow> \<not> P (arr ! i)) (Var fmax) \<otimes> BArray (\<lambda>fmax arr. fmax < length arr \<longrightarrow> P (arr ! fmax)) (Var fmax)"

abbreviation equality_test (infix "equals" 71) where "x equals y \<equiv> BExpr2 (op =) x y"

abbreviation "MIN x y \<equiv> BinOp min x y"

abbreviation ADD_function (infix "ADD" 71) where "x ADD y \<equiv> BinOp (op +) x y"

lemma weaken_precondition: "\<T> P' \<le> \<T> P \<Longrightarrow> \<T> P' \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G) \<sqsubseteq> \<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G)"
  by (simp add: preimp_antitone refine)

lemma weaken_postcondition: "\<T> Q \<le> \<T> Q' \<Longrightarrow> \<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q' \<inter> guar G) \<sqsubseteq> \<T> P \<rightarrow> (R \<rhd> \<F> \<cdot> \<T> Q \<inter> guar G)"
  apply (rule refine)
  apply (rule preimp_iso)
  apply (rule Rely_mono)
  apply simp
  by (meson inter_isol l_prod_isor)

method weakening uses add =
  isotonicity?;
  (rule weaken_precondition | rule weaken_postcondition)

lemma findp_refine: "\<T> \<zero> \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV) \<sqsubseteq> findp P"
  (is "?specification \<sqsubseteq> _")
proof -
  have "?specification \<sqsubseteq>
    \<T> \<zero> \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (Var f\<^sub>A equals ALen) \<inter> guar UNIV);
    \<T> (Var f\<^sub>A equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV)"
    by refine
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    \<T> (Var f\<^sub>A equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV)"
    by verify
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    \<T> (Var f\<^sub>A equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (Var f\<^sub>A equals ALen \<otimes> Var f\<^sub>B equals ALen) \<inter> guar UNIV);
    \<T> (Var f\<^sub>A equals ALen \<otimes> Var f\<^sub>B equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV)"
    by refine
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    \<T> (Var f\<^sub>A equals ALen \<otimes> Var f\<^sub>B equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV)"
    by verify
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    \<T> (Var f\<^sub>A equals ALen \<otimes> Var f\<^sub>B equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (loop_post P) \<inter> guar UNIV);
    \<T> (loop_post P) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (postcondition P) \<inter> guar UNIV)"
    by refine
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    \<T> (Var f\<^sub>A equals ALen \<otimes> Var f\<^sub>B equals ALen) \<rightarrow> ({} \<rhd> \<F> \<cdot> \<T> (loop_post P) \<inter> guar UNIV);
    fmax := MIN (Var f\<^sub>A) (Var f\<^sub>B)"
    by (verify add: loop_post_def postcondition_def)
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    parallel {
      \<T> (Var f\<^sub>A equals ALen) \<rightarrow>
        (rely_A P \<rhd> \<F> \<cdot> \<T> (BNot ((i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B)) \<otimes> invariant_A P) \<inter> guar (rely_B P))
    } meanwhile {
      \<T> (Var f\<^sub>B equals ALen) \<rightarrow>
        (rely_B P \<rhd> \<F> \<cdot> \<T> (BNot ((i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B)) \<otimes> invariant_B P) \<inter> guar (rely_A P))
    };
    fmax := MIN (Var f\<^sub>A) (Var f\<^sub>B)"
    (is "_ \<sqsubseteq> _; _; parallel { ?specification_A } meanwhile { ?specification_B }; _")
    by (refine add: findp_parallel_postcondition)
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    parallel {
      par_A P
    } meanwhile {
      \<T> (Var f\<^sub>B equals ALen) \<rightarrow>
        (rely_B P \<rhd> \<F> \<cdot> \<T> (BNot ((i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B)) \<otimes> invariant_B P) \<inter> guar (rely_A P))
    };
    fmax := MIN (Var f\<^sub>A) (Var f\<^sub>B)"
  proof isotonicity
    let ?if_pre = "
        BArray (\<lambda>i arr. \<forall>i'. i' < i \<and> even i' \<longrightarrow> \<not> P (arr ! i')) (Var i\<^sub>A) \<otimes>
        BExpr1 even (Var i\<^sub>A) \<otimes>
        BArray (\<lambda>i arr. i < length arr \<longrightarrow> P (arr ! i)) (Var f\<^sub>A) \<otimes>
        BExpr2 op < (Var f\<^sub>A) (BinOp op + ALen (Const (Suc 0))) \<otimes>
        BExpr2 op < (Var i\<^sub>A) (Var f\<^sub>A)"

    have "?specification_A \<sqsubseteq>
      \<T> (Var f\<^sub>A equals ALen) \<rightarrow>
        (rely_A P \<rhd> \<F> \<cdot> \<T> (Var f\<^sub>A equals ALen \<otimes> Var i\<^sub>A equals Const 0) \<inter> guar (rely_B P));
      \<T> (Var f\<^sub>A equals ALen \<otimes> Var i\<^sub>A equals Const 0) \<rightarrow>
        (rely_A P \<rhd> \<F> \<cdot> \<T> (BNot (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) \<otimes> invariant_A P) \<inter> guar (rely_B P))"
      by refine
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      \<T> (Var f\<^sub>A equals ALen \<otimes> Var i\<^sub>A equals Const 0) \<rightarrow>
        (rely_A P \<rhd> \<F> \<cdot> \<T> (BNot (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) \<otimes> invariant_A P) \<inter> guar (rely_B P))"
      by (verify add: subset_iff preserve_def rely_A_def store.defs rely_B_def test_def Language.test_def)
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        \<T> (invariant_A P \<otimes> (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B)) \<rightarrow>
          (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
      }"
      apply refine
      apply (simp add: invariant_A_def)
      apply (rule rtrancl_mono)
      apply (simp add: preserve_def invariant_A_def subset_iff rely_A_def)
      apply (simp_all only: state_existence)
      apply (simp add: lessthan_def invariant_A_def)
      apply (rule_tac x = "store.make 0 0 0 0 0 []" in exI)
      apply (simp add: store.defs)
      apply (simp add: lessthan_def invariant_A_def)
      apply (rule_tac x = "store.make 1 1 0 0 0 [1]" in exI)
      by (simp add: store.defs)
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        \<T> ?if_pre \<rightarrow> (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
      }"
      by weakening (simp add: invariant_A_def lessthan_def)
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>A)) {
          \<T> (?if_pre \<otimes> BExpr1 P (Lookup (Var i\<^sub>A))) \<rightarrow>
            (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
        } else {
          \<T> (?if_pre \<otimes> BNot (BExpr1 P (Lookup (Var i\<^sub>A)))) \<rightarrow>
            (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
        }
      }"
      apply refine
      apply (rule rtrancl_mono)
      apply (simp add: rely_A_def preserve_def subset_iff)
      apply (simp add: state_existence invariant_A_def)
      apply (rule_tac x = "store.make 0 0 0 0 0 []" in exI)
      by (simp add: store.defs)
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>A)) {
          \<T> (?if_pre \<otimes> BExpr1 P (Lookup (Var i\<^sub>A))) \<rightarrow>
            (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P \<otimes> BExpr1 P (Lookup (Var i\<^sub>A))) \<inter> guar (rely_B P))
        } else {
          \<T> (?if_pre \<otimes> BNot (BExpr1 P (Lookup (Var i\<^sub>A)))) \<rightarrow>
            (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
        }
      }"
      by weakening simp
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>A)) {
          f\<^sub>A := Var i\<^sub>A
        } else {
          \<T> (?if_pre \<otimes> BNot (BExpr1 P (Lookup (Var i\<^sub>A)))) \<rightarrow>
            (rely_A P \<rhd> \<F> \<cdot> \<T> (invariant_A P) \<inter> guar (rely_B P))
        }
      }"
      apply (verify add: rely_A_def preserve_def subset_iff invariant_A_def
                         test_def Language.test_def rely_B_def store.defs)
      by auto
    also have "... \<sqsubseteq>
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A \<otimes> i\<^sub>A less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>A)) {
          f\<^sub>A := Var i\<^sub>A
        } else {
          i\<^sub>A := Var i\<^sub>A ADD Const 2
        }
      }"
      apply (verify add: rely_A_def preserve_def subset_iff invariant_A_def
                         test_def Language.test_def rely_B_def store.defs)
      using less_Suc_eq by auto
    also have "... \<sqsubseteq> par_A P"
      by (simp add: par_A_def)
    finally show "?specification_A \<sqsubseteq> par_A P" .
  qed
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    parallel {
      par_A P
    } meanwhile {
      par_B P
    };
    fmax := MIN (Var f\<^sub>A) (Var f\<^sub>B)"
    by isotonicity (auto intro: verify par_B_proof)
  also have "... \<sqsubseteq>
    f\<^sub>A := ALen;
    f\<^sub>B := ALen;
    parallel {
      i\<^sub>A := Const 0;
      while (i\<^sub>A less than f\<^sub>A) \<otimes> (i\<^sub>A less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>A)) {
          f\<^sub>A := Var i\<^sub>A
        } else {
          i\<^sub>A := Var i\<^sub>A ADD Const 2
        }
      }
    } meanwhile {
      i\<^sub>B := Const 1;
      while (i\<^sub>B less than f\<^sub>A) \<otimes> (i\<^sub>B less than f\<^sub>B) do {
        if BExpr1 P (Lookup (Var i\<^sub>B)) {
          f\<^sub>B := Var i\<^sub>B
        } else {
          i\<^sub>B := Var i\<^sub>B ADD Const 2
        }
      }
    };
    fmax := MIN (Var f\<^sub>A) (Var f\<^sub>B)"
    by (simp add: par_A_def par_B_def)
  also have "... \<sqsubseteq> findp P"
    by (simp add: findp_def)

  finally show "?specification \<sqsubseteq> findp P" .
qed


(* Copyright 2021 (C) Mihails Milehins *)

section\<open>\<open>GRPH\<close> as a digraph\<close>
theory CZH_DG_GRPH
  imports
    CZH_DG_DGHM
    CZH_DG_Small_Digraph
begin

subsection\<open>Background\<close>

text\<open>
Conventionally, \<open>GRPH\<close> defined as a category of digraphs and digraph
homomorphisms (e.g., see Chapter II-7 in \<^cite>\<open>"mac_lane_categories_2010"\<close>).
However, there is little that can prevent one from exposing \<open>GRPH\<close>
as a digraph and provide additional structure gradually later.
Thus, in this section, \<open>\<alpha>\<close>-\<open>GRPH\<close> is
defined as a digraph of digraphs and digraph homomorphisms in \<open>V\<^sub>\<alpha>\<close>.
\<close>

named_theorems GRPH_cs_simps
named_theorems GRPH_cs_intros

subsection\<open>Definition and elementary properties\<close>

definition dg_GRPH :: "V \<Rightarrow> V"
  where "dg_GRPH \<alpha> =
    [
      set {\<CC>. digraph \<alpha> \<CC>},
      all_dghms \<alpha>,
      (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>),
      (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)
    ]\<^sub>\<circ>"

text\<open>Components.\<close>

lemma dg_GRPH_components:
  shows "dg_GRPH \<alpha>\<lparr>Obj\<rparr> = set {\<CC>. digraph \<alpha> \<CC>}"
    and "dg_GRPH \<alpha>\<lparr>Arr\<rparr> = all_dghms \<alpha>"
    and "dg_GRPH \<alpha>\<lparr>Dom\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)"
    and "dg_GRPH \<alpha>\<lparr>Cod\<rparr> = (\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)"
  unfolding dg_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)

subsection\<open>Object\<close>

lemma dg_GRPH_ObjI:
  assumes "digraph \<alpha> \<AA>"
  shows "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
  using assms unfolding dg_GRPH_components by auto

lemma dg_GRPH_ObjD:
  assumes "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
  shows "digraph \<alpha> \<AA>"
  using assms unfolding dg_GRPH_components by auto

lemma dg_GRPH_ObjE:
  assumes "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
  obtains "digraph \<alpha> \<AA>"
  using assms unfolding dg_GRPH_components by auto

lemma dg_GRPH_Obj_iff[GRPH_cs_simps]:
  "\<AA> \<in>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr> \<longleftrightarrow> digraph \<alpha> \<AA>"
  unfolding dg_GRPH_components by auto

subsection\<open>Domain\<close>

mk_VLambda dg_GRPH_components(3)
  |vsv dg_GRPH_Dom_vsv[GRPH_cs_intros]|
  |vdomain dg_GRPH_Dom_vdomain[GRPH_cs_simps]|
  |app dg_GRPH_Dom_app[GRPH_cs_simps]|

lemma dg_GRPH_Dom_vrange: "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
  unfolding dg_GRPH_components by (rule vrange_VLambda_vsubset) auto

subsection\<open>Codomain\<close>

mk_VLambda dg_GRPH_components(4)
  |vsv dg_GRPH_Cod_vsv[GRPH_cs_intros]|
  |vdomain dg_GRPH_Cod_vdomain[GRPH_cs_simps]|
  |app dg_GRPH_Cod_app[GRPH_cs_simps]|

lemma dg_GRPH_Cod_vrange: "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>"
  unfolding dg_GRPH_components by (rule vrange_VLambda_vsubset) auto

subsection\<open>\<open>GRPH\<close> is a digraph\<close>

lemma (in \<Z>) tiny_digraph_dg_GRPH:
  assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
  shows "tiny_digraph \<beta> (dg_GRPH \<alpha>)"
proof(intro tiny_digraphI)
  show "vfsequence (dg_GRPH \<alpha>)" unfolding dg_GRPH_def by simp
  show "vcard (dg_GRPH \<alpha>) = 4\<^sub>\<nat>"
    unfolding dg_GRPH_def by (simp add: nat_omega_simps)
  show "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Dom\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_GRPH_Dom_vrange)
  show "\<R>\<^sub>\<circ> (dg_GRPH \<alpha>\<lparr>Cod\<rparr>) \<subseteq>\<^sub>\<circ> dg_GRPH \<alpha>\<lparr>Obj\<rparr>" by (simp add: dg_GRPH_Cod_vrange)
  show "dg_GRPH \<alpha>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
    unfolding dg_GRPH_components by (rule digraphs_in_Vset[OF assms])
  show "dg_GRPH \<alpha>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<beta>"
    unfolding dg_GRPH_components by (rule all_dghms_in_Vset[OF assms])
qed (auto simp: assms dg_GRPH_components)

subsection\<open>Arrow with a domain and a codomain\<close>

lemma dg_GRPH_is_arrI:
  assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
proof(intro is_arrI; unfold dg_GRPH_components)
  from assms show "\<FF> \<in>\<^sub>\<circ> all_dghms \<alpha>" by auto
  with assms show
    "(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomDom\<rparr>)\<lparr>\<FF>\<rparr> = \<AA>"
    "(\<lambda>\<FF>\<in>\<^sub>\<circ>all_dghms \<alpha>. \<FF>\<lparr>HomCod\<rparr>)\<lparr>\<FF>\<rparr> = \<BB>"
    by (auto simp: GRPH_cs_simps)
qed

lemma dg_GRPH_is_arrD:
  assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
  using assms by (elim is_arrE) (auto simp: dg_GRPH_components)

lemma dg_GRPH_is_arrE:
  assumes "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB>"
  obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
  using assms by (simp add: dg_GRPH_is_arrD)

lemma dg_GRPH_is_arr_iff[GRPH_cs_simps]:
  "\<FF> : \<AA> \<mapsto>\<^bsub>dg_GRPH \<alpha>\<^esub> \<BB> \<longleftrightarrow> \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^bsub>\<alpha>\<^esub> \<BB>"
  by (auto intro: dg_GRPH_is_arrI dest: dg_GRPH_is_arrD)

text\<open>\newpage\<close>

end