\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsubsection \<open>Galois Relator\<close>
theory Transport_Functions_Galois_Relator
  imports
    Transport_Functions_Relation_Simplifications
begin

paragraph \<open>Dependent Function Relator\<close>

context transport_Dep_Fun_Rel
begin

interpretation flip : transport_Dep_Fun_Rel R1 L1 r1 l1 R2 L2 r2 l2
  rewrites "flip.t1.counit \<equiv> \<eta>\<^sub>1" by (simp only: t1.flip_counit_eq_unit)

lemma Dep_Fun_Rel_Galois_if_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and mono_r2: "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and L2_le2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and ge_L2_r2_le2: "\<And>x x' y'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x (l1 x)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x x'\<^esub> y')"
  and trans_L2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  and "f \<^bsub>L\<^esub>\<lessapprox> g"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
proof (intro Dep_Fun_Rel_relI)
  fix x x' assume "x \<^bsub>L1\<^esub>\<lessapprox> x'"
  show "f x \<^bsub>L2 x x'\<^esub>\<lessapprox> g x'"
  proof (intro t2.GaloisI)
    from \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close> \<open>((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1\<close> have "x \<le>\<^bsub>L1\<^esub> r1 x'" "l1 x \<le>\<^bsub>R1\<^esub> x'"
      by auto
    with \<open>g \<le>\<^bsub>R\<^esub> g\<close> have "g (l1 x) \<le>\<^bsub>R2 (l1 x) x'\<^esub> g x'" by blast
    then show "in_codom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>) (g x')" by blast

    from \<open>f \<^bsub>L\<^esub>\<lessapprox> g\<close> have "f \<le>\<^bsub>L\<^esub> r g" by blast
    moreover from refl_L1 \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close> have "x \<le>\<^bsub>L1\<^esub> x" by blast
    ultimately have "f x \<le>\<^bsub>L2 x x\<^esub> (r g) x" by blast
    with L2_le2 \<open>x \<le>\<^bsub>L1\<^esub> r1 x'\<close> have "f x \<le>\<^bsub>L2 x (r1 x')\<^esub> (r g) x" by blast
    then have "f x \<le>\<^bsub>L2 x (r1 x')\<^esub> r2\<^bsub>x (l1 x)\<^esub> (g (l1 x))" by simp
    with ge_L2_r2_le2 have "f x \<le>\<^bsub>L2 x (r1 x')\<^esub> r2\<^bsub>x x'\<^esub> (g (l1 x))"
      using \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close> \<open>g (l1 x) \<le>\<^bsub>R2 (l1 x) x'\<^esub> _\<close> by blast
    moreover have "... \<le>\<^bsub>L2 x (r1 x')\<^esub> r2\<^bsub>x x'\<^esub> (g x')"
      using mono_r2 \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close> \<open>g (l1 x) \<le>\<^bsub>R2 (l1 x) x'\<^esub> g x'\<close> by blast
    ultimately show "f x \<le>\<^bsub>L2 x (r1 x')\<^esub> r2\<^bsub>x x'\<^esub> (g x')"
      using trans_L2 \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close> by blast
  qed
qed

lemma left_rel_right_if_Dep_Fun_Rel_GaloisI:
  assumes mono_l1: "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and half_galois_prop_right1: "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and L2_unit_le2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and ge_L2_r2_le1: "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  and rel_f_g: "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  shows "f \<le>\<^bsub>L\<^esub> r g"
proof (intro left_relI)
  fix x1 x2 assume "x1 \<le>\<^bsub>L1\<^esub> x2"
  with mono_l1 half_galois_prop_right1 have "x1 \<^bsub>L1\<^esub>\<lessapprox> l1 x2"
    by (intro t1.Galois_left_if_left_relI) auto
  with rel_f_g have "f x1 \<^bsub>L2 x1 (l1 x2)\<^esub>\<lessapprox> g (l1 x2)" by blast
  then have "in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) (g (l1 x2))"
    "f x1 \<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub> r2\<^bsub>x1 (l1 x2)\<^esub> (g (l1 x2))" by auto
  with L2_unit_le2 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "f x1 \<le>\<^bsub>L2 x1 x2\<^esub> r2\<^bsub>x1 (l1 x2)\<^esub> (g (l1 x2))" by blast
  with ge_L2_r2_le1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> \<open>in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) (g (l1 x2))\<close>
    have "f x1 \<le>\<^bsub>L2 x1 x2\<^esub> r2\<^bsub>x2 (l1 x2)\<^esub> (g (l1 x2))" by blast
  then show "f x1 \<le>\<^bsub>L2 x1 x2\<^esub> r g x2" by simp
qed

lemma Galois_if_Dep_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  and "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms by (intro GaloisI left_rel_right_if_Dep_Fun_Rel_GaloisI) auto

lemma left_right_rel_if_Dep_Fun_Rel_GaloisI:
  assumes mono_r1: "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and half_galois_prop_left2: "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and R2_le1: "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and R2_l2_le1: "\<And>x1' x2' y. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) y \<Longrightarrow>
    (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub> y) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x1' (r1 x1')\<^esub> y)"
  and rel_f_g: "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  shows "l f \<le>\<^bsub>R\<^esub> g"
proof (rule flip.left_relI)
  fix x1' x2' assume "x1' \<le>\<^bsub>R1\<^esub> x2'"
  with mono_r1 have "r1 x1' \<^bsub>L1\<^esub>\<lessapprox> x2'" by blast
  with rel_f_g have "f (r1 x1') \<^bsub>L2 (r1 x1') x2'\<^esub>\<lessapprox> g x2'" by blast
  with half_galois_prop_left2[OF \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close>]
    have "l2\<^bsub>x2' (r1 x1')\<^esub> (f (r1 x1')) \<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub> g x2'" by auto
  with R2_le1 \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> have "l2\<^bsub>x2' (r1 x1')\<^esub> (f (r1 x1')) \<le>\<^bsub>R2 x1' x2'\<^esub> g x2'"
    by blast
  with R2_l2_le1 \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> \<open>f (r1 x1') \<^bsub>L2 (r1 x1') x2'\<^esub>\<lessapprox> _\<close>
    have "l2\<^bsub>x1' (r1 x1')\<^esub> (f (r1 x1')) \<le>\<^bsub>R2 x1' x2'\<^esub> g x2'" by blast
  then show "l f x1' \<le>\<^bsub>R2 x1' x2'\<^esub> g x2'" by simp
qed

lemma Galois_if_Dep_Fun_Rel_GaloisI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  and "\<And>x1' x2' y. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) y \<Longrightarrow>
    (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub> y) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x1' (r1 x1')\<^esub> y)"
  and "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms by (intro Galois_if_Dep_Fun_Rel_GaloisI in_codomI[where ?x="l f"])
  (auto intro!: left_right_rel_if_Dep_Fun_Rel_GaloisI)

lemma Galois_iff_Dep_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  and "\<And>x x' y'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x (l1 x)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x x'\<^esub> y')"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro iffI)
  (auto intro!: Dep_Fun_Rel_Galois_if_GaloisI Galois_if_Dep_Fun_Rel_GaloisI)

lemma Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I:
  assumes "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  shows "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  using assms by blast

lemma Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I':
  assumes "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x (l1 x)\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  shows "\<And>x x' y'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x (l1 x)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x x'\<^esub> y')"
  using assms by blast

lemma Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_codom_rightI:
  assumes mono_l1: "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and half_galois_prop_right1: "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and L2_le_unit2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and mono_r2: "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "x1 \<le>\<^bsub>L1\<^esub> x2"
  shows "([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
proof (intro Dep_Fun_Rel_predI)
  from mono_l1 half_galois_prop_right1 refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close>
  have "l1 x2 \<le>\<^bsub>R1\<^esub> l1 x2" "x2 \<^bsub>L1\<^esub>\<lessapprox> l1 x2"
    by (blast intro: t1.Galois_left_if_left_relI)+
  fix y' assume "in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y'"
  with Dep_Fun_Rel_relD[OF
    dep_mono_wrt_relD[OF mono_r2 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close>] \<open>l1 x2 \<le>\<^bsub>R1\<^esub> l1 x2\<close>]
    have "r2\<^bsub>x1 (l1 x2)\<^esub> y' \<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub> r2\<^bsub>x2 (l1 x2)\<^esub> y'"
    using \<open>x2 \<^bsub>L1\<^esub>\<lessapprox> l1 x2\<close> by (auto dest: in_field_if_in_codom)
  with L2_le_unit2 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> show "r2\<^bsub>x1 (l1 x2)\<^esub> y' \<le>\<^bsub>L2 x1 x2\<^esub> r2\<^bsub>x2 (l1 x2)\<^esub> y'"
    by blast
qed

lemma Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_dom_rightI:
  assumes mono_l1: "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and half_galois_prop_right1: "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and mono_r2: "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "x \<^bsub>L1\<^esub>\<lessapprox> x'"
  shows "([in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x (l1 x)\<^esub>) (r2\<^bsub>x x'\<^esub>)"
proof -
  from mono_l1 half_galois_prop_right1 refl_L1 \<open>x \<^bsub>L1\<^esub>\<lessapprox> x'\<close>
    have "x \<le>\<^bsub>L1\<^esub> x" "l1 x \<le>\<^bsub>R1\<^esub> x'" "x \<^bsub>L1\<^esub>\<lessapprox> l1 x"
    by (auto intro!: t1.half_galois_prop_leftD t1.Galois_left_if_left_relI)
  with Dep_Fun_Rel_relD[OF dep_mono_wrt_relD[OF mono_r2 \<open>x \<le>\<^bsub>L1\<^esub> x\<close>] \<open>l1 x \<le>\<^bsub>R1\<^esub> x'\<close>]
    show ?thesis by blast
qed

lemma Galois_iff_Dep_Fun_Rel_Galois_if_monoI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_GaloisI
    Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I
    Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I'
    Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_dom_rightI
    Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_codom_rightI)
  (auto intro: reflexive_on_if_le_pred_if_reflexive_on in_field_if_in_dom
    in_field_if_in_codom)

lemma Galois_iff_Dep_Fun_Rel_Galois_left_rel2_le_assmI:
  assumes refl_L1: "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and mono_L2: "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "x1 \<le>\<^bsub>L1\<^esub> x2"
  shows "(\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
proof -
  from refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x1 \<le>\<^bsub>L1\<^esub> x1" by blast
  with dep_mono_wrt_relD[OF dep_mono_wrt_predD[OF mono_L2] \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close>]
    show "(\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)" by auto
qed

lemma Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assmI:
  assumes mono_l1: "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and half_galois_prop_right1: "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and antimono_L2:
    "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 x3 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x1 \<le>\<^bsub>L1\<^esub> x2 \<and> x3 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2)] \<Rrightarrow>\<^sub>m (\<ge>)) L2"
  and "x1 \<le>\<^bsub>L1\<^esub> x2"
  shows "(\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
proof -
  from mono_l1 half_galois_prop_right1 refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x2 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2"
    by (blast intro: t1.rel_unit_if_reflexive_on_if_half_galois_prop_right_if_mono_wrt_rel)
  with refl_L1 have "\<eta>\<^sub>1 x2 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2" by blast
  with dep_mono_wrt_relD[OF dep_mono_wrt_predD[OF antimono_L2] \<open>x2 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2\<close>]
    show "(\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)" using \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> by auto
qed

lemma Galois_iff_Dep_Fun_Rel_Galois_if_monoI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 x3 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x1 \<le>\<^bsub>L1\<^esub> x2 \<and> x3 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2)] \<Rrightarrow>\<^sub>m (\<ge>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_monoI
    Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assmI
    Galois_iff_Dep_Fun_Rel_Galois_left_rel2_le_assmI)
  (auto intro: reflexive_on_if_le_pred_if_reflexive_on in_field_if_in_codom
    in_field_if_in_dom)

corollary Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 x3 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x1 \<le>\<^bsub>L1\<^esub> x2 \<and> x3 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2)] \<Rrightarrow>\<^sub>m (\<ge>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_monoI') auto

lemma Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assm_if_galois_equivI:
  assumes galois_equiv1: "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and mono_L2: "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "x1 \<le>\<^bsub>L1\<^esub> x2"
  shows "(\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
proof -
  from refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x1 \<le>\<^bsub>L1\<^esub> x1" by blast
  from galois_equiv1 refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "\<eta>\<^sub>1 x2 \<le>\<^bsub>L1\<^esub> x2" by (intro
    flip.t1.counit_rel_if_reflexive_on_if_half_galois_prop_left_if_mono_wrt_rel)
    blast+
  from galois_equiv1 refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x1 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2"
    by (fastforce intro: t1.rel_unit_if_left_rel_if_mono_wrt_relI)
  with dep_mono_wrt_relD[OF dep_mono_wrt_predD[OF mono_L2] \<open>\<eta>\<^sub>1 x2 \<le>\<^bsub>L1\<^esub> x2\<close>]
    show "(\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)" by auto
qed

lemma Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro
    Galois_iff_Dep_Fun_Rel_Galois_if_monoI
    Galois_iff_Dep_Fun_Rel_Galois_left_rel2_le_assmI
    Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assm_if_galois_equivI)
  auto

corollary Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI
    reflexive_on_in_field_mono_assm_left2I)
  auto

corollary Galois_iff_Dep_Fun_Rel_Galois_if_preorder_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^bsub>pre\<^esub> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI')
  auto

subparagraph \<open>Simplification of Restricted Function Relator\<close>

lemma Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2' y. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) y \<Longrightarrow>
    (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub> y) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>) (l2\<^bsub>x1' (r1 x1')\<^esub> y)"
  and "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>
    = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))"
  using assms by (intro ext iffI restrict_leftI restrict_rightI
    in_domI[where ?y="r _"] left_rel_right_if_Dep_Fun_Rel_GaloisI
    in_codomI[where ?x="l _"] left_right_rel_if_Dep_Fun_Rel_GaloisI)
  auto

lemma Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x2 \<le>\<^bsub>L1\<^esub> x3 \<and> x4 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x3)] \<Rrightarrow> (\<ge>)) L2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | \<epsilon>\<^sub>1 x2' \<le>\<^bsub>R1\<^esub> x1'] \<Rrightarrow>\<^sub>m [x3' x4' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2' \<le>\<^bsub>R1\<^esub> x3'] \<Rrightarrow> (\<le>)) R2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>
    = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))"
  using assms by (intro
    Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI
    left_rel_right_iff_left_right_rel_if_galois_prop_le_assms_leftI
    reflexive_on_in_field_mono_assm_left2I
    left_rel_right_iff_left_right_rel_if_galois_prop_le_assms_rightI
    mono_wrt_rel_left_in_dom_mono_left_assm
    galois_connection_left_right_if_galois_connection_mono_assms_leftI
    galois_connection_left_right_if_galois_connection_mono_assms_rightI
    Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I)
  auto

text \<open>Simplification of Restricted Function Relator for Nested Transports\<close>

lemma Dep_Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq:
  fixes S :: "'a1 \<Rightarrow> 'a2 \<Rightarrow> 'b1 \<Rightarrow> 'b2 \<Rightarrow> bool"
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (S x x')\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L2 x (r1 x')\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)\<^esub>)
      \<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> =
    ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> S x x')\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>" (is "?lhs = ?rhs")
proof -
  have "?lhs =
    ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (S x x')\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)\<^esub>)
      \<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
    by (subst restrict_left_right_eq_restrict_right_left,
      subst restrict_left_Dep_Fun_Rel_rel_restrict_left_eq)
    auto
  also have "... = ?rhs"
    using assms by (subst restrict_left_right_eq_restrict_right_left,
      subst restrict_right_Dep_Fun_Rel_rel_restrict_right_eq)
    (auto elim!: in_codomE t1.GaloisE
      simp only: restrict_left_right_eq_restrict_right_left)
  finally show ?thesis .
qed

end

paragraph \<open>Function Relator\<close>

context transport_Fun_Rel
begin

corollary Fun_Rel_Galois_if_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) r2"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  and "f \<^bsub>L\<^esub>\<lessapprox> g"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  using assms by (intro tdfr.Dep_Fun_Rel_Galois_if_GaloisI) simp_all

corollary Galois_if_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  and "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms by (intro tdfr.Galois_if_Dep_Fun_Rel_GaloisI) simp_all

lemma Galois_if_Fun_Rel_GaloisI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "((\<le>\<^bsub>L2\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms by (intro tdfr.Galois_if_Dep_Fun_Rel_GaloisI') simp_all

corollary Galois_iff_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) r2"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  and "g \<le>\<^bsub>R\<^esub> g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  using assms by (intro tdfr.Galois_iff_Dep_Fun_Rel_GaloisI) simp_all

subparagraph \<open>Simplification of Restricted Function Relator\<close>

lemma Fun_Rel_Galois_restrict_left_right_eq_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "((\<le>\<^bsub>L2\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> = ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))"
  using assms
  by (intro tdfr.Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI)
  simp_all

text \<open>Simplification of Restricted Function Relator for Nested Transports\<close>

lemma Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq:
  fixes S :: "'b1 \<Rightarrow> 'b2 \<Rightarrow> bool"
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> S\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L2\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R2\<^esub>)\<^esub>)\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> =
    ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> S)\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms
  by (intro tdfr.Dep_Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq)
  simp_all

end

paragraph \<open>Monotone Dependent Function Relator\<close>

context transport_Mono_Dep_Fun_Rel
begin

lemma Dep_Fun_Rel_Galois_if_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x x' y'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> in_dom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x (l1 x)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x (r1 x')\<^esub>) (r2\<^bsub>x x'\<^esub> y')"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "f \<^bsub>L\<^esub>\<lessapprox> g"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms unfolding left_rel_eq_tdfr_left_Refl_Rel right_rel_eq_tdfr_right_Refl_Rel
  by (intro tdfr.Dep_Fun_Rel_Galois_if_GaloisI tdfr.GaloisI)
  (auto elim!: galois_rel.GaloisE in_codomE)

lemma Galois_if_Dep_Fun_Rel_GaloisI:
  assumes "(tdfr.R \<Rrightarrow>\<^sub>m tdfr.L) r"
  and "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2 y'. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y' \<Longrightarrow>
    (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<ge>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub> y')"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  and "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms unfolding left_rel_eq_tdfr_left_Refl_Rel right_rel_eq_tdfr_right_Refl_Rel
  by (intro tdfr.Galois_Refl_RelI tdfr.Galois_if_Dep_Fun_Rel_GaloisI)
  (auto simp: in_codom_eq_in_dom_if_reflexive_on_in_field)

lemma Galois_iff_Dep_Fun_Rel_GaloisI:
  assumes "(tdfr.R \<Rrightarrow>\<^sub>m tdfr.L) r"
  and "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro iffI Dep_Fun_Rel_Galois_if_GaloisI
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I'
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_dom_rightI)
  (auto intro!: Galois_if_Dep_Fun_Rel_GaloisI
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_codom_rightI
    intro: reflexive_on_if_le_pred_if_reflexive_on
      in_field_if_in_dom in_field_if_in_codom)

lemma Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI:
  assumes galois_conn1: "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 x1\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and L2_le_unit2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and mono_r2: "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and trans_L2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g" (is "?lhs \<longleftrightarrow> ?rhs")
proof -
  have "(\<le>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub> y') \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>) (r2\<^bsub>x1 (l1 x1)\<^esub> y')"
    if hyps: "x1 \<le>\<^bsub>L1\<^esub> x2" "in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y'" for x1 x2 y'
  proof -
    have "([in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x1)\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
    proof (intro Dep_Fun_Rel_predI)
      from galois_conn1 refl_L1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close>
        have "x1 \<le>\<^bsub>L1\<^esub> x1" "l1 x1 \<le>\<^bsub>R1\<^esub> l1 x2" "x1 \<^bsub>L1\<^esub>\<lessapprox> l1 x1"
        by (blast intro: t1.Galois_left_if_left_relI)+
      fix y' assume "in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) y'"
      with Dep_Fun_Rel_relD[OF dep_mono_wrt_relD[OF mono_r2 \<open>x1 \<le>\<^bsub>L1\<^esub> x1\<close>]
        \<open>l1 x1 \<le>\<^bsub>R1\<^esub> l1 x2\<close>]
        have "r2\<^bsub>x1 (l1 x1)\<^esub> y' \<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub> r2\<^bsub>x1 (l1 x2)\<^esub> y'"
        using \<open>x1 \<^bsub>L1\<^esub>\<lessapprox> l1 x1\<close> by (auto dest: in_field_if_in_dom)
      with L2_le_unit2 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> show "r2\<^bsub>x1 (l1 x1)\<^esub> y' \<le>\<^bsub>L2 x1 x2\<^esub> r2\<^bsub>x1 (l1 x2)\<^esub> y'"
        by blast
    qed
    with hyps show ?thesis using trans_L2 by blast
  qed
  then show ?thesis using assms
    using assms by (intro Galois_iff_Dep_Fun_Rel_GaloisI
      tdfr.mono_wrt_rel_rightI tdfr.mono_wrt_rel_right2_if_mono_wrt_rel_right2_if_GaloisI
      tdfr.Galois_iff_Dep_Fun_Rel_Galois_ge_left_rel2I
      tdfr.Galois_iff_Dep_Fun_Rel_Galois_mono_assm_in_codom_rightI)
    (auto intro: reflexive_on_if_le_pred_if_reflexive_on in_field_if_in_codom)
qed

corollary Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 x3 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x1 \<le>\<^bsub>L1\<^esub> x2 \<and> x3 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2)] \<Rrightarrow>\<^sub>m (\<ge>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g" (is "?lhs \<longleftrightarrow> ?rhs")
  using assms by (intro
    Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assmI
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_left_rel2_le_assmI)
  auto

corollary Galois_eq_Dep_Fun_Rel_Galois_restrict_if_mono_if_galois_connectionI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 _ \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x2] \<Rrightarrow>\<^sub>m (\<le>)) L2"
  and "([x1 \<Colon> \<top>] \<Rrightarrow>\<^sub>m [x2 x3 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x1 \<le>\<^bsub>L1\<^esub> x2 \<and> x3 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x2)] \<Rrightarrow>\<^sub>m (\<ge>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  shows "(\<^bsub>L\<^esub>\<lessapprox>) = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms by (intro ext iffI restrict_leftI restrict_rightI
    iffD1[OF Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI'])
  (auto intro!:
    iffD2[OF Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI'])

lemma Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_mono_if_galois_connectionI
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_left_rel2_le_assmI
    tdfr.reflexive_on_in_field_mono_assm_left2I
    tdfr.Galois_iff_Dep_Fun_Rel_Galois_left_rel2_unit1_le_assm_if_galois_equivI)
  auto

theorem Galois_eq_Dep_Fun_Rel_Galois_restrict_if_galois_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  shows "(\<^bsub>L\<^esub>\<lessapprox>) = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms by (intro ext iffI restrict_leftI restrict_rightI
    iffD1[OF Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI])
  (auto elim!: GaloisE intro!:
    iffD2[OF Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI])

corollary Galois_iff_Dep_Fun_Rel_Galois_if_preorder_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^bsub>pre\<^esub> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>)) f g"
  using assms by (intro Galois_iff_Dep_Fun_Rel_Galois_if_galois_equivalenceI)
  auto

corollary Galois_eq_Dep_Fun_Rel_Galois_restrict_if_preorder_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^bsub>pre\<^esub> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x) x'\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x (r1 x')\<^esub>)) (r2\<^bsub>x x'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  shows "(\<^bsub>L\<^esub>\<lessapprox>) = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms by (intro ext iffI restrict_leftI restrict_rightI
    iffD1[OF Galois_iff_Dep_Fun_Rel_Galois_if_preorder_equivalenceI])
  (auto elim!: GaloisE intro!:
    iffD2[OF Galois_iff_Dep_Fun_Rel_Galois_if_preorder_equivalenceI])

subparagraph \<open>Simplification of Restricted Function Relator\<close>

lemma Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_Galois_if_reflexive_onI:
  assumes "reflexive_on (in_field tdfr.L) tdfr.L"
  and "reflexive_on (in_field tdfr.R) tdfr.R"
  and "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x2 \<le>\<^bsub>L1\<^esub> x3 \<and> x4 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x3)] \<Rrightarrow> (\<ge>)) L2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | \<epsilon>\<^sub>1 x2' \<le>\<^bsub>R1\<^esub> x1'] \<Rrightarrow>\<^sub>m [x3' x4' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2' \<le>\<^bsub>R1\<^esub> x3'] \<Rrightarrow> (\<le>)) R2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>
    = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))"
  using assms by (auto simp only: left_rel_eq_tdfr_left_rel_if_reflexive_on
      right_rel_eq_tdfr_right_rel_if_reflexive_on
    intro!: tdfr.Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI')

interpretation flip : transport_Dep_Fun_Rel R1 L1 r1 l1 R2 L2 r2 l2
  rewrites "flip.t1.unit \<equiv> \<epsilon>\<^sub>1" by (simp only: t1.flip_unit_eq_counit)

lemma Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^bsub>pre\<^esub> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (r2\<^bsub>(r1 x1') x2'\<^esub>)"
  and "([x1 x2 \<Colon> (\<ge>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x1 \<le>\<^bsub>L1\<^esub> x3] \<Rrightarrow> (\<le>)) L2"
  and "([x1' x2' \<Colon> (\<ge>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x3' x4' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x1' \<le>\<^bsub>R1\<^esub> x3'] \<Rrightarrow> (\<le>)) R2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and PERS: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> partial_equivalence_rel (\<le>\<^bsub>L2 x1 x2\<^esub>)"
    "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> partial_equivalence_rel (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>
    = ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (\<^bsub>L2 x x'\<^esub>\<lessapprox>))"
  using assms by (intro
    Dep_Fun_Rel_Galois_restrict_left_right_eq_Dep_Fun_Rel_Galois_if_reflexive_onI
    tdfr.reflexive_on_in_field_left_if_equivalencesI
    flip.reflexive_on_in_field_left_if_equivalencesI
    tdfr.galois_equivalence_if_mono_if_galois_equivalence_mono_assms_leftI
    flip.galois_equivalence_if_mono_if_galois_equivalence_mono_assms_leftI)
  (auto dest!: PERS)

text \<open>Simplification of Restricted Function Relator for Nested Transports\<close>

lemma Dep_Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq:
  fixes S :: "'a1 \<Rightarrow> 'a2 \<Rightarrow> 'b1 \<Rightarrow> 'b2 \<Rightarrow> bool"
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  shows "([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> (S x x')\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L2 x (r1 x')\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)\<^esub>)
      \<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> =
    ([x x' \<Colon> (\<^bsub>L1\<^esub>\<lessapprox>)] \<Rrightarrow> S x x')\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
    (is "?lhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub> = ?rhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub>")
proof (intro ext)
  fix f g
  have "?lhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub> f g \<longleftrightarrow> ?lhs f g \<and> ?DL f \<and> ?CR g" by blast
  also have "... \<longleftrightarrow> ?lhs\<restriction>\<^bsub>in_dom tdfr.L\<^esub>\<upharpoonleft>\<^bsub>in_codom tdfr.R\<^esub> f g \<and> ?DL f \<and> ?CR g"
    unfolding left_rel_eq_tdfr_left_Refl_Rel right_rel_eq_tdfr_right_Refl_Rel
    by blast
  also with assms have "... \<longleftrightarrow> ?rhs\<restriction>\<^bsub>in_dom tdfr.L\<^esub>\<upharpoonleft>\<^bsub>in_codom tdfr.R\<^esub> f g \<and> ?DL f \<and> ?CR g"
    by (simp only:
      tdfr.Dep_Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq)
  also have "... \<longleftrightarrow> ?rhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub> f g"
    unfolding left_rel_eq_tdfr_left_Refl_Rel right_rel_eq_tdfr_right_Refl_Rel
    by blast
  finally show "?lhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub> f g \<longleftrightarrow> ?rhs\<restriction>\<^bsub>?DL\<^esub>\<upharpoonleft>\<^bsub>?CR\<^esub> f g" .
qed

end

paragraph \<open>Monotone Function Relator\<close>

context transport_Mono_Fun_Rel
begin

corollary Fun_Rel_Galois_if_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) (r2)"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  and "f \<^bsub>L\<^esub>\<lessapprox> g"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  using assms by (intro tpdfr.Dep_Fun_Rel_Galois_if_GaloisI) simp_all

interpretation flip : transport_Mono_Fun_Rel R1 L1 r1 l1 R2 L2 r2 l2 .

lemma Galois_if_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) r2"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  and "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g"
  using assms
  by (intro tpdfr.Galois_if_Dep_Fun_Rel_GaloisI flip.tfr.mono_wrt_rel_leftI)
  simp_all

corollary Galois_iff_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) (r2)"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  and "in_dom (\<le>\<^bsub>L\<^esub>) f"
  and "in_codom (\<le>\<^bsub>R\<^esub>) g"
  shows "f \<^bsub>L\<^esub>\<lessapprox> g \<longleftrightarrow> ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>)) f g"
  using assms by (intro iffI Fun_Rel_Galois_if_GaloisI)
  (auto intro!: Galois_if_Fun_Rel_GaloisI)

theorem Galois_eq_Fun_Rel_Galois_restrictI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) r2"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  shows "(\<^bsub>L\<^esub>\<lessapprox>) = ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms by (intro ext iffI restrict_leftI restrict_rightI
    iffD1[OF Galois_iff_Fun_Rel_GaloisI])
  (auto elim!: tpdfr.GaloisE intro!: iffD2[OF Galois_iff_Fun_Rel_GaloisI])

subparagraph \<open>Simplification of Restricted Function Relator\<close>

lemma Fun_Rel_Galois_restrict_left_right_eq_Fun_Rel_Galois_if_reflexive_onI:
  assumes "reflexive_on (in_field tfr.tdfr.L) tfr.tdfr.L"
  and "reflexive_on (in_field tfr.tdfr.R) tfr.tdfr.R"
  and "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "((\<le>\<^bsub>L2\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> = ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))"
  using assms by (auto simp only: tpdfr.left_rel_eq_tdfr_left_rel_if_reflexive_on
      tpdfr.right_rel_eq_tdfr_right_rel_if_reflexive_on
    intro!: tfr.Fun_Rel_Galois_restrict_left_right_eq_Fun_Rel_GaloisI)

lemma Fun_Rel_Galois_restrict_left_right_eq_Fun_Rel_GaloisI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) l1" and "((\<le>\<^bsub>R1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L1\<^esub>)) r1"
  and "((\<le>\<^bsub>L1\<^esub>) \<unlhd>\<^sub>h (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "((\<le>\<^bsub>L2\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and "partial_equivalence_rel (\<le>\<^bsub>L2\<^esub>)"
  and "partial_equivalence_rel (\<le>\<^bsub>R2\<^esub>)"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> = ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> (\<^bsub>L2\<^esub>\<lessapprox>))"
  using assms by (intro
    Fun_Rel_Galois_restrict_left_right_eq_Fun_Rel_Galois_if_reflexive_onI
    tfr.reflexive_on_in_field_leftI
    flip.tfr.reflexive_on_in_field_leftI)
  auto

text \<open>Simplification of Restricted Function Relator for Nested Transports\<close>

lemma Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq:
  fixes S :: "'b1 \<Rightarrow> 'b2 \<Rightarrow> bool"
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  shows "((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> S\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L2\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R2\<^esub>)\<^esub>)\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub> =
    ((\<^bsub>L1\<^esub>\<lessapprox>) \<Rrightarrow> S)\<restriction>\<^bsub>in_dom (\<le>\<^bsub>L\<^esub>)\<^esub>\<upharpoonleft>\<^bsub>in_codom (\<le>\<^bsub>R\<^esub>)\<^esub>"
  using assms
  by (intro tpdfr.Dep_Fun_Rel_Galois_restrict_left_right_restrict_left_right_eq)
  simp_all

end

end


theory Lift_Fst
  imports "../Lifter"
begin

(*
 * fst
 *)

definition fst_l ::
  "('x, 'a, 'b1 :: Pord_Weak) lifting \<Rightarrow>
   ('x, 'a, 'b1 * ('b2 :: Pord_Weakb)) lifting" where
"fst_l t =
  LMake (\<lambda> s a b . (case b of (b1, b2) \<Rightarrow> (LUpd t s a b1, b2)))
            (\<lambda> s x . (LOut t s (fst x)))
            (\<lambda> s . (LBase t s, \<bottom>))"

definition fst_l_S :: "('x, 'b1 :: Pord_Weak) valid_set \<Rightarrow> ('x, ('b1 * 'b2 :: Pord_Weakb)) valid_set" where
"fst_l_S S s =
  { b . case b of (b1, _) \<Rightarrow> (b1 \<in> S s) }"

locale fst_l_valid_weak = lifting_valid_weak

sublocale fst_l_valid_weak \<subseteq> out:lifting_valid_weak "fst_l l" "fst_l_S S"
proof
  fix s a
  fix b :: "('c :: Pord_Weak) * ('e :: Pord_Weakb)"
  show "LOut (fst_l l) s (LUpd (fst_l l) s a b) = a"
    using put_get
    by(auto simp add: fst_l_def split:prod.splits)
next
  fix s
  fix b :: "('c :: Pord_Weak) * ('e :: Pord_Weakb)"
  assume  Hb : "b \<in> fst_l_S S s"
  thus "b <[ LUpd (fst_l l) s (LOut (fst_l l) s b) b"
    using get_put_weak
    by(auto simp add: fst_l_def prod_pleq leq_refl fst_l_S_def split:prod.splits)
next
  fix s a
  fix b :: "('c :: Pord_Weak) * ('e :: Pord_Weakb)"
  show "LUpd (fst_l l) s a b \<in> fst_l_S S s"
    using put_S
    by(auto simp add: fst_l_def prod_pleq leq_refl fst_l_S_def split:prod.splits)
qed

lemma (in fst_l_valid_weak) ax:
  shows "lifting_valid_weak (fst_l l) (fst_l_S S)"
  using out.lifting_valid_weak_axioms
  by auto

lemma (in fst_l_valid_weak) ax_g :
  assumes H : "\<And> x . S' x = fst_l_S S x"
  shows "lifting_valid_weak (fst_l l) S'"
proof-
  have "S' = fst_l_S S" using assms by auto
  then show ?thesis using out.lifting_valid_weak_axioms assms
    by auto
qed

locale fst_l_valid_ext = lifting_valid_ext

sublocale fst_l_valid_ext \<subseteq> out : lifting_valid_ext "fst_l l" "fst_l_S S"
proof
  fix s a
  fix b :: "('c :: Pord_Weak) * ('e :: Pord_Weakb)"
  (*assume  Hb : "b \<in> fst_l_S S s"*)
  show "b <[ LUpd (fst_l l) s a b"
    using get_put
    by(auto simp add: fst_l_def prod_pleq fst_l_S_def leq_refl split:prod.splits)
qed

lemma (in fst_l_valid_ext) ax:
  shows "lifting_valid_ext (fst_l l)"
  using out.lifting_valid_ext_axioms
  by auto

locale fst_l_valid_base_ext = lifting_valid_base_ext

sublocale fst_l_valid_base_ext \<subseteq> out : lifting_valid_base_ext "fst_l l" "fst_l_S S"
proof
  fix s
  show "LBase (fst_l l) s = \<bottom>" using base
    by(auto simp add: fst_l_def prod_bot)
qed

lemma (in fst_l_valid_base_ext) ax :
  shows "lifting_valid_base_ext (fst_l l)"
  using out.lifting_valid_base_ext_axioms
  by auto

locale fst_l_valid_ok_ext = lifting_valid_ok_ext
sublocale fst_l_valid_ok_ext \<subseteq> out : lifting_valid_ok_ext "fst_l l" "fst_l_S S"
proof
  fix s

  show "ok_S \<subseteq> fst_l_S S s" using ok_S_valid
    by(auto simp add: prod_ok_S fst_l_S_def)
next
  fix s a
  fix b :: "('c * 'd)"
  assume B: "b \<in> ok_S"
  then show "LUpd (fst_l l) s a b \<in> ok_S" using ok_S_put
    by(auto simp add: fst_l_def prod_ok_S)
qed

lemma (in fst_l_valid_ok_ext) ax :
  shows "lifting_valid_ok_ext (fst_l l) (fst_l_S S)"
  using out.lifting_valid_ok_ext_axioms by auto

lemma (in fst_l_valid_ok_ext) ax_g :
  assumes H: "\<And> x . S' x = fst_l_S S x"
  shows "lifting_valid_ok_ext (fst_l l) S'"
proof-
  have "S' = fst_l_S S" using assms by auto
  then show ?thesis using out.lifting_valid_ok_ext_axioms assms
    by auto
qed

locale fst_l_valid_pres_ext = lifting_valid_pres_ext
sublocale fst_l_valid_pres_ext \<subseteq> out : lifting_valid_pres_ext "fst_l l" "fst_l_S S"
proof
  fix v supr :: "('c * 'd)"
  fix V f s

  assume HV : "v \<in> V"
  assume HS : "V \<subseteq> fst_l_S S s"
  assume Hsupr : "is_sup V supr"
  assume Hsupr_S : "supr \<in> fst_l_S S s"
  show "is_sup (LMap (fst_l l) f s ` V) (LMap (fst_l l) f s supr)"
  proof(rule is_supI)

    fix x

    assume Xin : "x \<in> LMap (fst_l l) f s ` V"

    obtain x1 x2 where X: "x = (x1, x2)" by(cases x; auto)

    obtain xi xi1 xi2 where Xi : "xi = (xi1, xi2)" "xi \<in> V" "LMap (fst_l l) f s xi = x"
      using Xin
      by auto

    obtain supr1 supr2 where Supr : "supr = (supr1, supr2)" by(cases supr; auto)

    have "xi <[ supr" using is_supD1[OF Hsupr Xi(2)] by simp

    hence "xi1 <[ supr1" "xi2 <[ supr2"
      using Xi Supr
      by(auto simp add: prod_pleq split: prod.splits)

    have "x2 = xi2" using Xi X
      by(cases l; auto simp add: fst_l_def)

    have "x1 = LMap l f s xi1"
      using Xi X
      by(cases l; auto simp add: fst_l_def)

    have "LMap (fst_l l) f s supr = (LMap l f s supr1, supr2)"
      using Supr
      by(cases l; auto simp add: fst_l_def)

    have Xi1_in : "xi1 \<in> fst ` V"
      using imageI[OF `xi \<in> V`, of fst] Xi
      by(auto simp add: fst_l_S_def)

    have Fst_V_sub : "fst ` V \<subseteq> S s"
      using HS
      by(auto simp add: fst_l_S_def)

    have "supr1 \<in> S s"
      using Hsupr_S Supr
      by(auto simp add: fst_l_S_def)

    have Supr1_sup : "is_sup (fst ` V) supr1"
    proof(rule is_supI)
      fix w1
      assume "w1 \<in> fst ` V"

      then obtain w2 where "(w1, w2) \<in> V"
        by auto

      hence "(w1, w2) <[ supr" using is_supD1[OF Hsupr, of "(w1, w2)"] by auto

      thus "w1 <[ supr1" using Supr by(auto simp add: prod_pleq)
    next

      fix z1

      assume Hub : "is_ub (fst ` V) z1"

      have "is_ub V (z1, supr2)"
      proof(rule is_ubI)
        fix w
        assume "w \<in> V"

        obtain w1 w2 where W: "w = (w1, w2)" by(cases w; auto)

        have "w1 \<in> (fst ` V)"
          using imageI[OF `w \<in> V`, of fst] W by auto

        hence "w1 <[ z1" using is_ubE[OF Hub] by auto

        have "w2 <[ supr2" using is_supD1[OF Hsupr `w \<in> V`] Supr W
          by(auto simp add: prod_pleq)

        then show "w <[ (z1, supr2)" using W `w1 <[ z1`
          by(auto simp add: prod_pleq)
      qed

      show "supr1 <[ z1"
        using is_supD2[OF Hsupr `is_ub V (z1, supr2)`] Supr
        by(auto simp add: prod_pleq)
    qed

    have Supr1_map : "is_sup (LMap l f s ` fst ` V) (LMap l f s supr1)"
      using pres using pres[OF Xi1_in Fst_V_sub Supr1_sup `supr1 \<in> S s` , of f]
      by simp

    have X1_in : "x1 \<in> LMap l f s ` fst ` V"
      using X Xi imageI[OF `xi \<in> V`, of fst]
      by(cases l; auto simp add: fst_l_def)

    have "x1 <[ LMap l f s supr1"
      using is_supD1[OF Supr1_map X1_in]
      by simp

    have "x2 <[ supr2" using `x2 = xi2` `xi2 <[ supr2` by simp

    then show "x <[ LMap (fst_l l) f s supr"
      using X Supr `x1 <[ LMap l f s supr1`
      by(cases l; auto simp add: fst_l_def prod_pleq)
  next
    fix x

    assume Xub : "is_ub (LMap (fst_l l) f s ` V) x"

    obtain supr1 supr2 where Supr : "supr = (supr1, supr2)" by(cases supr; auto)

  (* TODO: copy-pasted from first case *)
    have "LMap (fst_l l) f s supr = (LMap l f s supr1, supr2)"
      using Supr
      by(cases l; auto simp add: fst_l_def)

    have Fst_V_sub : "fst ` V \<subseteq> S s"
      using HS
      by(auto simp add: fst_l_S_def)

    have "supr1 \<in> S s"
      using Hsupr_S Supr
      by(auto simp add: fst_l_S_def)

    have Supr1_sup : "is_sup (fst ` V) supr1"
    proof(rule is_supI)
      fix w1
      assume "w1 \<in> fst ` V"

      then obtain w2 where "(w1, w2) \<in> V"
        by auto

      hence "(w1, w2) <[ supr" using is_supD1[OF Hsupr, of "(w1, w2)"] by auto

      thus "w1 <[ supr1" using Supr by(auto simp add: prod_pleq)
    next

      fix z1

      assume Hub : "is_ub (fst ` V) z1"

      have "is_ub V (z1, supr2)"
      proof(rule is_ubI)
        fix w
        assume "w \<in> V"

        obtain w1 w2 where W: "w = (w1, w2)" by(cases w; auto)

        have "w1 \<in> (fst ` V)"
          using imageI[OF `w \<in> V`, of fst] W by auto

        hence "w1 <[ z1" using is_ubE[OF Hub] by auto

        have "w2 <[ supr2" using is_supD1[OF Hsupr `w \<in> V`] Supr W
          by(auto simp add: prod_pleq)

        then show "w <[ (z1, supr2)" using W `w1 <[ z1`
          by(auto simp add: prod_pleq)
      qed

      show "supr1 <[ z1"
        using is_supD2[OF Hsupr `is_ub V (z1, supr2)`] Supr
        by(auto simp add: prod_pleq)
    qed

    obtain v1 v2 where V : "v = (v1, v2)" "v1 \<in> fst ` V"
      using imageI[OF HV, of fst]
      by(cases v; auto)

    have Supr1_map : "is_sup (LMap l f s ` fst ` V) (LMap l f s supr1)"
      using pres[OF V(2) Fst_V_sub Supr1_sup `supr1 \<in> S s` ]
      by simp

    obtain x1 x2 where X: "x = (x1, x2)" by(cases x; auto)

    have X1_ub : "is_ub (LMap l f s ` fst ` V) x1"
    proof
      fix w1

      assume W1: "w1 \<in> LMap l f s ` fst ` V"

      then obtain wi wi1 wi2  where Wi : "wi \<in> V" "LMap l f s wi1 = w1" "wi = (wi1, wi2)"
        by(auto)

      have Wi_in : "LMap (fst_l l) f s wi \<in> LMap (fst_l l) f s ` V"
        using imageI[OF Wi(1), of "LMap (fst_l l) f s"] by simp

      have "LMap (fst_l l) f s wi <[ x"
        using is_ubE[OF Xub Wi_in]
        by simp

      then show "w1 <[ x1"
        using W1 Wi X
        by(cases l; auto simp add: prod_pleq fst_l_def)
    qed

    have "LMap l f s supr1 <[ x1"
      using is_supD2[OF Supr1_map X1_ub]
      by simp

    have "is_ub V (supr1, x2)"
    proof(rule is_ubI)
      fix w

      assume Win : "w \<in> V"

      obtain w1 w2 where W: "w = (w1, w2)" by(cases w; auto)

      have W1_in : "w1 \<in> fst ` V"
        using imageI[OF Win, of fst] W by simp

      have "w1 <[ supr1"
        using is_supD1[OF Supr1_sup W1_in] by simp

      have "LMap (fst_l l) f s w <[ x"
        using is_ubE[OF Xub imageI[OF Win]] by simp

      hence "w2 <[ x2" using W X
        by(cases l; auto simp add: fst_l_def prod_pleq)

      show "w <[ (supr1, x2)"
        using `w1 <[ supr1` `w2 <[ x2` W
        by(auto simp add: prod_pleq)
    qed

    have "supr2 <[ x2"
      using is_supD2[OF Hsupr `is_ub V (supr1, x2)`] Supr
      by(auto simp add: prod_pleq)

    show "LMap (fst_l l) f s supr <[ x"
      using `LMap l f s supr1 <[ x1` `supr2 <[ x2` X Supr
      by(cases l; auto simp add: fst_l_def prod_pleq)
  qed
qed

lemma (in fst_l_valid_pres_ext) ax :
  shows "lifting_valid_pres_ext (fst_l l) (fst_l_S S)"
  using out.lifting_valid_pres_ext_axioms
  by auto

lemma (in fst_l_valid_pres_ext) ax_g :
  assumes H: "\<And> x . S' x = fst_l_S S x"
  shows "lifting_valid_pres_ext (fst_l l) S'"
proof-
  have "S' = fst_l_S S" using assms by auto
  then show ?thesis using out.lifting_valid_pres_ext_axioms
    by auto
qed

locale fst_l_valid_base_pres_ext = fst_l_valid_pres_ext + fst_l_valid_base_ext + lifting_valid_base_pres_ext

sublocale fst_l_valid_base_pres_ext \<subseteq> out : lifting_valid_base_pres_ext "fst_l l" "fst_l_S S"
proof
  fix s
  show "\<bottom> \<notin> fst_l_S S s"
    using bot_bad[of s]
    by(auto simp add: fst_l_S_def prod_bot)
qed

lemma (in fst_l_valid_base_pres_ext) ax :
  shows "lifting_valid_base_pres_ext (fst_l l) (fst_l_S S)"
  using out.lifting_valid_base_pres_ext_axioms
  by auto

lemma (in fst_l_valid_base_pres_ext) ax_g :
  assumes H : "\<And> x . S' x = fst_l_S S x"
  shows "lifting_valid_base_pres_ext (fst_l l) S'"
proof-
  have "S' = fst_l_S S" using assms by auto
  then show ?thesis using out.lifting_valid_base_pres_ext_axioms
    by auto
qed

locale fst_l_ortho = l_ortho

sublocale fst_l_ortho \<subseteq> out : l_ortho "fst_l l1" "fst_l_S S1" "fst_l l2" "fst_l_S S2"
proof
  fix s
  show "LBase (fst_l l1) s = LBase (fst_l l2) s"
    using eq_base
    by(auto simp add: fst_l_def)
next

  fix b :: "'c * 'e"
  fix s
  fix a1 :: 'b
  fix a2 :: 'd

  obtain b1 b2 where B: "b = (b1, b2)"
    by(cases b; auto)
  have Compat1 : "LUpd l1 s a1 (LUpd l2 s a2 b1) = LUpd l2 s a2 (LUpd l1 s a1 b1)"
    using compat[of s a1 a2 b1]
    by(auto)

  then show "LUpd (fst_l l1) s a1 (LUpd (fst_l l2) s a2 b) =
       LUpd (fst_l l2) s a2 (LUpd (fst_l l1) s a1 b)"
    using B
    by(auto simp add: fst_l_def)
next

  fix b :: "('c * 'e)"
  fix a1
  fix s

  obtain b1 b2 where B: "b = (b1, b2)"
    by(cases b; auto)

  have Compat1 : "LOut l2 s (LUpd l1 s a1 b1) = LOut l2 s b1"
    using put1_get2
    by auto

  then show "LOut (fst_l l2) s (LUpd (fst_l l1) s a1 b) = LOut (fst_l l2) s b"
    using B
    by (auto simp add: fst_l_def)
next
  fix b :: "('c * 'e)"
  fix s a2

  obtain b1 b2 where B: "b = (b1, b2)"
    by(cases b; auto)

  have Compat1 : "LOut l1 s (LUpd l2 s a2 b1) = LOut l1 s b1"
    using put2_get1
    by auto

  then show "LOut (fst_l l1) s
        (LUpd (fst_l l2) s a2 b) =
       LOut (fst_l l1) s b"
    using B
    by(auto simp add: fst_l_def)
next
  fix b :: "'c * 'e"
  fix s a1

  assume B_in : "b \<in> fst_l_S S2 s"

  then obtain b1 b2 where B : "b = (b1, b2)" "b1 \<in> S2 s"
    by(auto simp add: fst_l_S_def)

  have Compat1 : "LUpd l1 s a1 b1 \<in> S2 s"
    using put1_S2[OF B(2)] by auto

  then show "LUpd (fst_l l1) s a1 b \<in> fst_l_S S2 s"
    using B
    by(auto simp add: fst_l_def fst_l_S_def)
next
  fix b :: "'c * 'e"
  fix s a2

  assume B_in : "b \<in> fst_l_S S1 s"
  then obtain b1 b2 where B : "b = (b1, b2)" "b1 \<in> S1 s"
    by(auto simp add: fst_l_S_def)

  have Compat2 : "LUpd l2 s a2 b1 \<in> S1 s"
    using put2_S1[OF B(2)]
    by auto

  then show "LUpd (fst_l l2) s a2 b \<in> fst_l_S S1 s"
    using B
    by(auto simp add: fst_l_def fst_l_S_def)
qed

lemma (in fst_l_ortho) ax :
  shows "l_ortho (fst_l l1) (fst_l_S S1) (fst_l l2) (fst_l_S S2)"
  using out.l_ortho_axioms
  by auto

lemma (in fst_l_ortho) ax_g :
  assumes H1 : "\<And> x . S'1 x = fst_l_S S1 x"
  assumes H2 : "\<And> x . S'2 x = fst_l_S S2 x"
  shows "l_ortho (fst_l l1) S'1 (fst_l l2) S'2"
proof-
  have H1' : "S'1 = fst_l_S S1"
    using H1 by auto

  have H2' : "S'2 = fst_l_S S2"
    using H2 by auto

  show ?thesis using ax unfolding H1' H2'
    by auto
qed

locale fst_l_ortho_base_ext = l_ortho_base_ext

sublocale fst_l_ortho_base_ext \<subseteq> out : l_ortho_base_ext "fst_l l1" "fst_l l2"
proof
  fix s
  show "LBase (fst_l l1) s = \<bottom>"
    using compat_base1
    by(auto simp add: fst_l_def prod_bot)
  fix s
  show "LBase (fst_l l2) s = \<bottom>"
    using compat_base2
    by(auto simp add: fst_l_def prod_bot)
qed

lemma (in fst_l_ortho_base_ext) ax :
  shows "l_ortho_base_ext (fst_l l1) (fst_l l2)"
  using out.l_ortho_base_ext_axioms
  by auto

locale fst_l_ortho_ok_ext = l_ortho_ok_ext

sublocale fst_l_ortho_ok_ext \<subseteq> out : l_ortho_ok_ext "fst_l l1" "fst_l l2" .

(*
locale fst_l_ortho_pres = l_ortho_pres_ext

sublocale fst_l_ortho_pres \<subseteq> l_ortho_pres "fst_l l1" "fst_l_S S1" "fst_l l2" "fst_l_S S2"
proof
 fix a1 a2 s
  fix x :: "('c * 'e)"

  obtain x1 x2 where X : "x = (x1, x2)"
    by(cases x; auto)

  have Sup :
    "is_sup {LUpd (l1) s a1 x1, LUpd (l2) s a2 x1}
        (LUpd (l1) s a1 (LUpd (l2) s a2 x1))"
    using compat_pres_sup
    by auto

  have Conc' :
    "is_sup ((\<lambda>w. (w, x2)) ` {LUpd l1 s a1 x1, LUpd l2 s a2 x1}) (LUpd l1 s a1 (LUpd l2 s a2 x1), x2)"
    using is_sup_fst[OF _ Sup]
    by auto

  then show "is_sup {LUpd (fst_l l1) s a1 x, LUpd (fst_l l2) s a2 x}
        (LUpd (fst_l l1) s a1 (LUpd (fst_l l2) s a2 x))"
    using X
    by(auto simp add: fst_l_def)
qed
*)

end