(* -------------------------------------------------------------------------- *)
section \<open>Möbius transformations\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Möbius transformations (also called homographic, linear fractional, or bilinear
transformations) are the fundamental transformations of the extended complex plane. Here they are
introduced algebraically. Each transformation is represented by a regular (non-singular,
non-degenerate) $2\times 2$ matrix that acts linearly on homogeneous coordinates. As proportional
homogeneous coordinates represent same points of $\mathbb{\overline{C}}$, proportional matrices will
represent the same Möbius transformation.\<close>

theory Moebius
imports Homogeneous_Coordinates
begin

(* -------------------------------------------------------------------------- *)
subsection \<open>Definition of Möbius transformations\<close>
(* -------------------------------------------------------------------------- *)

typedef moebius_mat = "{M::complex_mat. mat_det M \<noteq> 0}"
  by (rule_tac x="eye" in exI, simp)

setup_lifting type_definition_moebius_mat

definition moebius_cmat_eq :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> bool" where
  [simp]: "moebius_cmat_eq A B \<longleftrightarrow>  (\<exists> k::complex. k \<noteq> 0 \<and> B = k *\<^sub>s\<^sub>m A)"

lift_definition moebius_mat_eq :: "moebius_mat \<Rightarrow> moebius_mat \<Rightarrow> bool" is moebius_cmat_eq
  done

lemma moebius_mat_eq_refl [simp]:
  shows "moebius_mat_eq x x"
  by transfer simp

quotient_type moebius = moebius_mat / moebius_mat_eq
proof (rule equivpI)
  show "reflp moebius_mat_eq"
    unfolding reflp_def
    by transfer auto
next
  show "symp moebius_mat_eq"
    unfolding symp_def
    by transfer (auto simp add: symp_def, rule_tac x="1/k" in exI, simp)
next
  show "transp moebius_mat_eq"
    unfolding transp_def
    by transfer (auto simp add: transp_def, rule_tac x="ka*k" in exI, simp)
qed

definition mk_moebius_cmat :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex_mat" where
 [simp]: "mk_moebius_cmat a b c d =
           (let M = (a, b, c, d)
             in if mat_det M \<noteq> 0 then
                M
             else
                eye)"

lift_definition mk_moebius_mat :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> moebius_mat" is mk_moebius_cmat
  by simp

lift_definition mk_moebius :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> moebius" is mk_moebius_mat
  done

lemma ex_mk_moebius:
  shows "\<exists> a b c d. M = mk_moebius a b c d \<and> mat_det (a, b, c, d) \<noteq> 0"
proof (transfer, transfer)
  fix M :: complex_mat
  assume "mat_det M \<noteq> 0"
  obtain a b c d where "M = (a, b, c, d)"
    by (cases M, auto)
  hence "moebius_cmat_eq M (mk_moebius_cmat a b c d) \<and> mat_det (a, b, c, d) \<noteq> 0"
    using \<open>mat_det M \<noteq> 0\<close>
    by auto (rule_tac x=1 in exI, simp)
  thus "\<exists>a b c d. moebius_cmat_eq M (mk_moebius_cmat a b c d) \<and> mat_det (a, b, c, d) \<noteq> 0"
    by blast
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Action on points\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Möbius transformations are given as the action of Möbius group on the points of the
extended complex plane (in homogeneous coordinates).\<close>

definition moebius_pt_cmat_cvec :: "complex_mat \<Rightarrow> complex_vec \<Rightarrow> complex_vec" where
   [simp]: "moebius_pt_cmat_cvec M z = M *\<^sub>m\<^sub>v z"

lift_definition moebius_pt_mmat_hcoords :: "moebius_mat \<Rightarrow> complex_homo_coords \<Rightarrow> complex_homo_coords" is moebius_pt_cmat_cvec
  by auto algebra+

lift_definition moebius_pt :: "moebius \<Rightarrow> complex_homo \<Rightarrow> complex_homo" is moebius_pt_mmat_hcoords
proof transfer
  fix M M' x x'
  assume "moebius_cmat_eq M M'" "x \<approx>\<^sub>v x'"
  thus "moebius_pt_cmat_cvec M x \<approx>\<^sub>v moebius_pt_cmat_cvec M' x'"
    by (cases "M", cases "x", auto simp add: field_simps) (rule_tac x="k*ka" in exI, simp)
qed

lemma bij_moebius_pt [simp]:
  shows "bij (moebius_pt M)"
  unfolding bij_def inj_on_def surj_def
proof safe
  fix x y
  assume "moebius_pt M x = moebius_pt M y"
  thus "x = y"
  proof (transfer, transfer)
    fix M x y
    assume "mat_det M \<noteq> 0" "moebius_pt_cmat_cvec M x \<approx>\<^sub>v moebius_pt_cmat_cvec M y"
    thus "x \<approx>\<^sub>v y"
      using mult_sv_mv[of _ M x] mult_mv_inv[of _ M]
      unfolding moebius_pt_cmat_cvec_def
      by (metis complex_cvec_eq_def)
  qed
next
  fix y
  show "\<exists>x. y = moebius_pt M x"
  proof (transfer, transfer)
    fix y :: complex_vec and M :: complex_mat
    assume *: "y \<noteq> vec_zero" "mat_det M \<noteq> 0"
    let ?iM = "mat_inv M"
    let ?x = "?iM *\<^sub>m\<^sub>v y"
    have "?x \<noteq> vec_zero"
      using *
      by (metis mat_det_mult mat_eye_r mat_inv_r mult_cancel_right1 mult_mv_nonzero)
    moreover
    have "y \<approx>\<^sub>v moebius_pt_cmat_cvec M ?x"
      by (simp del: eye_def add: mat_inv_r[OF \<open>mat_det M \<noteq> 0\<close>])
    ultimately
    show "\<exists>x\<in>{v. v \<noteq> vec_zero}. y \<approx>\<^sub>v moebius_pt_cmat_cvec M x"
      by (rule_tac x="?x" in bexI, simp_all)
  qed
qed

lemma moebius_pt_eq_I:
  assumes "moebius_pt M z1 = moebius_pt M z2"
  shows "z1 = z2"
  using assms
  using bij_moebius_pt[of M]
  unfolding bij_def inj_on_def
  by blast

lemma moebius_pt_neq_I [simp]:
  assumes "z1 \<noteq> z2"
  shows "moebius_pt M z1 \<noteq> moebius_pt M z2"
  using assms
  by (auto simp add: moebius_pt_eq_I)

definition is_moebius :: "(complex_homo \<Rightarrow> complex_homo) \<Rightarrow> bool" where
  "is_moebius f \<longleftrightarrow> (\<exists> M. f = moebius_pt M)"

text \<open>In the classic literature Möbius transformations are often expressed in the form
$\frac{az+b}{cz+d}$. The following lemma shows that when restricted to finite points, the action
of Möbius transformations is bilinear.\<close>

lemma moebius_pt_bilinear:
  assumes "mat_det (a, b, c, d) \<noteq> 0"
  shows "moebius_pt (mk_moebius a b c d) z =
            (if z \<noteq> \<infinity>\<^sub>h then
                 ((of_complex a) *\<^sub>h z +\<^sub>h (of_complex b)) :\<^sub>h
                 ((of_complex c) *\<^sub>h z +\<^sub>h (of_complex d))
             else
                 (of_complex a) :\<^sub>h
                 (of_complex c))"
  unfolding divide_def
  using assms
proof (transfer, transfer)
  fix a b c d :: complex and z :: complex_vec
  obtain z1 z2 where zz: "z = (z1, z2)"
    by (cases z, auto)
  assume *: "mat_det (a, b, c, d) \<noteq> 0" "z \<noteq> vec_zero"
  let ?oc = "of_complex_cvec"
  show "moebius_pt_cmat_cvec (mk_moebius_cmat a b c d) z \<approx>\<^sub>v
       (if \<not> z \<approx>\<^sub>v \<infinity>\<^sub>v
        then (?oc a *\<^sub>v z +\<^sub>v ?oc b) *\<^sub>v
             reciprocal_cvec (?oc c *\<^sub>v z +\<^sub>v ?oc d)
        else ?oc a *\<^sub>v
             reciprocal_cvec (?oc c))"
  proof (cases "z \<approx>\<^sub>v \<infinity>\<^sub>v")
    case True
    thus ?thesis
      using zz *
      by auto
  next
    case False
    hence "z2 \<noteq> 0"
      using zz inf_cvec_z2_zero_iff \<open>z \<noteq> vec_zero\<close>
      by auto
    thus ?thesis
      using zz * False
      using regular_homogenous_system[of a b c d z1 z2]
      by auto
  qed
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Möbius group\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Möbius elements form a group under composition. This group is called the \emph{projective
general linear group} and denoted by $PGL(2, \mathbb{C})$ (the group $SGL(2, \mathbb{C})$ containing elements
with the determinant $1$ can also be considered).\<close>

text \<open>Identity Möbius transformation is represented by the identity matrix.\<close>

definition id_moebius_cmat :: "complex_mat" where
  [simp]: "id_moebius_cmat = eye"

lift_definition id_moebius_mmat :: "moebius_mat" is id_moebius_cmat
  by simp

lift_definition id_moebius :: "moebius" is id_moebius_mmat
  done

lemma moebius_pt_moebius_id [simp]:
  shows "moebius_pt id_moebius = id"
  unfolding id_def
  apply (rule ext, transfer, transfer)
  using eye_mv_l
  by simp

lemma mk_moeibus_id [simp]:
  shows "mk_moebius a 0 0 a = id_moebius"
  by (transfer, transfer, simp)

text \<open>The inverse Möbius transformation is obtained by taking the inverse representative matrix.\<close>

definition moebius_inv_cmat :: "complex_mat \<Rightarrow> complex_mat" where
  [simp]: "moebius_inv_cmat M = mat_inv M"

lift_definition moebius_inv_mmat :: "moebius_mat \<Rightarrow> moebius_mat" is moebius_inv_cmat
  by (simp add: mat_det_inv)

lift_definition moebius_inv :: "moebius \<Rightarrow> moebius" is "moebius_inv_mmat"
proof (transfer)
  fix x y
  assume "moebius_cmat_eq x y"
  thus "moebius_cmat_eq (moebius_inv_cmat x) (moebius_inv_cmat y)"
    by (auto simp add: mat_inv_mult_sm) (rule_tac x="1/k" in exI, simp)
qed

lemma moebius_inv:
  shows "moebius_pt (moebius_inv M) = inv (moebius_pt M)"
proof (rule inv_equality[symmetric])
  fix x
  show "moebius_pt (moebius_inv M) (moebius_pt M x) = x"
  proof (transfer, transfer)
    fix M::complex_mat and x::complex_vec
    assume "mat_det M \<noteq> 0" "x \<noteq> vec_zero"
    show "moebius_pt_cmat_cvec (moebius_inv_cmat M) (moebius_pt_cmat_cvec M x) \<approx>\<^sub>v x"
      using eye_mv_l
      by (simp add: mat_inv_l[OF \<open>mat_det M \<noteq> 0\<close>])
  qed
next
  fix y
  show "moebius_pt M (moebius_pt (moebius_inv M) y) = y"
  proof (transfer, transfer)
    fix M::complex_mat and y::complex_vec
    assume "mat_det M \<noteq> 0" "y \<noteq> vec_zero"
    show "moebius_pt_cmat_cvec M (moebius_pt_cmat_cvec (moebius_inv_cmat M) y) \<approx>\<^sub>v y"
      using eye_mv_l
      by (simp add: mat_inv_r[OF \<open>mat_det M \<noteq> 0\<close>])
  qed
qed

lemma is_moebius_inv [simp]:
  assumes "is_moebius m"
  shows "is_moebius (inv m)"
  using assms
  using moebius_inv
  unfolding is_moebius_def
  by metis

lemma moebius_inv_mk_moebus [simp]:
  assumes "mat_det (a, b, c, d) \<noteq> 0"
  shows "moebius_inv (mk_moebius a b c d) =
         mk_moebius (d/(a*d-b*c)) (-b/(a*d-b*c)) (-c/(a*d-b*c)) (a/(a*d-b*c))"
  using assms
  by (transfer, transfer) (auto, rule_tac x=1 in exI, simp_all add: field_simps)

text \<open>Composition of Möbius elements is obtained by multiplying their representing matrices.\<close>

definition moebius_comp_cmat :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> complex_mat" where
  [simp]: "moebius_comp_cmat M1 M2 = M1 *\<^sub>m\<^sub>m M2"

lift_definition moebius_comp_mmat :: "moebius_mat \<Rightarrow> moebius_mat \<Rightarrow> moebius_mat" is moebius_comp_cmat
  by simp

lift_definition moebius_comp :: "moebius \<Rightarrow> moebius \<Rightarrow> moebius" is moebius_comp_mmat
  by transfer (simp, (erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps)

lemma moebius_comp:
  shows "moebius_pt (moebius_comp M1 M2) = moebius_pt M1 \<circ> moebius_pt M2"
  unfolding comp_def
  by (rule ext, transfer, transfer, simp)

lemma moebius_pt_comp [simp]:
  shows "moebius_pt (moebius_comp M1 M2) z = moebius_pt M1 (moebius_pt M2 z)"
  by (auto simp add: moebius_comp)

lemma is_moebius_comp [simp]:
  assumes "is_moebius m1" and "is_moebius m2"
  shows "is_moebius (m1 \<circ> m2)"
  using assms
  unfolding is_moebius_def
  using moebius_comp
  by metis

lemma moebius_comp_mk_moebius [simp]:
  assumes "mat_det (a, b, c, d) \<noteq> 0" and "mat_det (a', b', c', d') \<noteq> 0"
  shows "moebius_comp (mk_moebius a b c d) (mk_moebius a' b' c' d') =
           mk_moebius (a * a' + b * c') (a * b' + b * d') (c * a' + d * c') (c * b' + d * d')"
  using mat_det_mult[of "(a, b, c, d)" "(a', b', c', d')"]
  using assms
  by (transfer, transfer) (auto, rule_tac x=1 in exI, simp)

instantiation moebius :: group_add
begin
definition plus_moebius :: "moebius \<Rightarrow> moebius \<Rightarrow> moebius" where
  [simp]: "plus_moebius = moebius_comp"

definition uminus_moebius :: "moebius \<Rightarrow> moebius" where
  [simp]: "uminus_moebius = moebius_inv"

definition zero_moebius :: "moebius" where
  [simp]: "zero_moebius = id_moebius"

definition minus_moebius :: "moebius \<Rightarrow> moebius \<Rightarrow> moebius" where
  [simp]: "minus_moebius A B = A + (-B)"

instance proof
  fix a b c :: moebius
  show "a + b + c = a + (b + c)"
    unfolding plus_moebius_def
  proof (transfer, transfer)
    fix a b c :: complex_mat
    assume "mat_det a \<noteq> 0" "mat_det b \<noteq> 0" "mat_det c \<noteq> 0"
    show "moebius_cmat_eq (moebius_comp_cmat (moebius_comp_cmat a b) c) (moebius_comp_cmat a (moebius_comp_cmat b c))"
      by simp (rule_tac x="1" in exI, simp add: mult_mm_assoc)
  qed
next
  fix a :: moebius
  show "a + 0 = a"
    unfolding plus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix A :: complex_mat
    assume "mat_det A \<noteq> 0"
    thus "moebius_cmat_eq (moebius_comp_cmat A id_moebius_cmat) A"
      using mat_eye_r
      by simp
  qed
next
  fix a :: moebius
  show "0 + a = a"
    unfolding plus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix A :: complex_mat
    assume "mat_det A \<noteq> 0"
    thus "moebius_cmat_eq (moebius_comp_cmat id_moebius_cmat A) A"
      using mat_eye_l
      by simp
  qed
next
  fix a :: moebius
  show "- a + a = 0"
    unfolding plus_moebius_def uminus_moebius_def zero_moebius_def
  proof (transfer, transfer)
    fix a :: complex_mat
    assume "mat_det a \<noteq> 0"
    thus "moebius_cmat_eq (moebius_comp_cmat (moebius_inv_cmat a) a) id_moebius_cmat"
      by (simp add: mat_inv_l)
  qed
next
  fix a b :: moebius
  show "a + - b = a - b"
    unfolding minus_moebius_def
    by simp
qed
end

text \<open>Composition with inverse\<close>

lemma moebius_comp_inv_left [simp]:
  shows "moebius_comp (moebius_inv M) M = id_moebius"
  by (metis left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)

lemma moebius_comp_inv_right [simp]:
  shows "moebius_comp M (moebius_inv M) = id_moebius"
  by (metis right_minus plus_moebius_def uminus_moebius_def zero_moebius_def)

lemma moebius_pt_comp_inv_left [simp]:
  shows "moebius_pt (moebius_inv M) (moebius_pt M z) = z"
  by (subst moebius_pt_comp[symmetric], simp)

lemma moebius_pt_comp_inv_right [simp]:
  shows "moebius_pt M (moebius_pt (moebius_inv M) z) = z"
  by (subst moebius_pt_comp[symmetric], simp)

lemma moebius_pt_comp_inv_image_left [simp]:
  shows "moebius_pt (moebius_inv M) ` moebius_pt M ` A = A"
  by force

lemma moebius_pt_comp_inv_image_right [simp]:
  shows "moebius_pt M ` moebius_pt (moebius_inv M) ` A = A"
  by force

lemma moebius_pt_invert:
  assumes "moebius_pt M z1 = z2"
  shows "moebius_pt (moebius_inv M) z2 = z1"
  using assms[symmetric]
  by simp

lemma moebius_pt_moebius_inv_in_set [simp]:
  assumes "moebius_pt M z \<in> A"
  shows "z \<in> moebius_pt (moebius_inv M) ` A"
  using assms
  using image_iff
  by fastforce

(* -------------------------------------------------------------------------- *)
subsection \<open>Special kinds of Möbius transformations\<close>
(* -------------------------------------------------------------------------- *)

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Reciprocal (1/z) as a Möbius transformation\<close>
(* -------------------------------------------------------------------------- *)

definition moebius_reciprocal :: "moebius" where
  "moebius_reciprocal = mk_moebius 0 1 1 0"

lemma moebius_reciprocal [simp]:
  shows "moebius_pt moebius_reciprocal = reciprocal"
  unfolding moebius_reciprocal_def
  by (rule ext, transfer, transfer) (force simp add: split_def)

lemma moebius_reciprocal_inv [simp]:
  shows "moebius_inv moebius_reciprocal = moebius_reciprocal"
  unfolding moebius_reciprocal_def
  by (transfer, transfer) simp

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Euclidean similarities as a Möbius transform\<close>
(* -------------------------------------------------------------------------- *)

text\<open>Euclidean similarities include Euclidean isometries (translations and rotations) and
dilatations.\<close>

definition moebius_similarity :: "complex \<Rightarrow> complex \<Rightarrow> moebius" where
  "moebius_similarity a b = mk_moebius a b 0 1"

lemma moebius_pt_moebius_similarity [simp]:
  assumes "a \<noteq> 0"
  shows "moebius_pt (moebius_similarity a b) z = (of_complex a) *\<^sub>h z +\<^sub>h (of_complex b)"
  unfolding moebius_similarity_def
  using assms
  using mult_inf_right[of "of_complex a"]
  by (subst moebius_pt_bilinear, auto)

text \<open>Their action is a linear transformation of $\mathbb{C}.$\<close>
lemma moebius_pt_moebius_similarity':
  assumes "a \<noteq> 0"
  shows "moebius_pt (moebius_similarity a b) = (\<lambda> z. (of_complex a) *\<^sub>h z +\<^sub>h (of_complex b))"
  using moebius_pt_moebius_similarity[OF assms, symmetric]
  by simp

lemma is_moebius_similarity':
  assumes "a \<noteq> 0\<^sub>h" and "a \<noteq> \<infinity>\<^sub>h" and "b \<noteq> \<infinity>\<^sub>h"
  shows "(\<lambda> z. a *\<^sub>h z +\<^sub>h b) = moebius_pt (moebius_similarity (to_complex a) (to_complex b))"
proof-
  obtain ka kb where *: "a = of_complex ka"  "ka \<noteq> 0" "b = of_complex kb"
    using assms
    using inf_or_of_complex[of a]  inf_or_of_complex[of b]
    by auto
  thus ?thesis
    unfolding is_moebius_def
    using moebius_pt_moebius_similarity'[of ka kb]
    by simp
qed

lemma is_moebius_similarity:
  assumes "a \<noteq> 0\<^sub>h" and "a \<noteq> \<infinity>\<^sub>h" and "b \<noteq> \<infinity>\<^sub>h"
  shows "is_moebius (\<lambda> z. a *\<^sub>h z +\<^sub>h b)"
  using is_moebius_similarity'[OF assms]
  unfolding is_moebius_def
  by auto

text \<open>Euclidean similarities form a group.\<close>

lemma moebius_similarity_id [simp]:
  shows "moebius_similarity 1 0 = id_moebius"
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_inv [simp]:
  assumes "a \<noteq> 0"
  shows "moebius_inv (moebius_similarity a b) = moebius_similarity (1/a) (-b/a)"
  using assms
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_uminus [simp]:
  assumes "a \<noteq> 0"
  shows "- moebius_similarity a b = moebius_similarity (1/a) (-b/a)"
  using assms
  by simp

lemma moebius_similarity_comp [simp]:
  assumes "a \<noteq> 0" and "c \<noteq> 0"
  shows "moebius_comp (moebius_similarity a b) (moebius_similarity c d) = moebius_similarity (a*c) (a*d+b)"
  using assms
  unfolding moebius_similarity_def
  by simp

lemma moebius_similarity_plus [simp]:
  assumes "a \<noteq> 0" and "c \<noteq> 0"
  shows "moebius_similarity a b + moebius_similarity c d = moebius_similarity (a*c) (a*d+b)"
  using assms
  by simp

text \<open>Euclidean similarities are the only Möbius group elements such that their action leaves the
$\infty_{h}$ fixed.\<close>
lemma moebius_similarity_inf [simp]:
  assumes "a \<noteq> 0"
  shows "moebius_pt (moebius_similarity a b) \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  using assms
  unfolding moebius_similarity_def
  by (transfer, transfer, simp)

lemma moebius_similarity_only_inf_to_inf:
  assumes "a \<noteq> 0"  "moebius_pt (moebius_similarity a b) z = \<infinity>\<^sub>h"
  shows "z = \<infinity>\<^sub>h"
  using assms
  using inf_or_of_complex[of z]
  by auto

lemma moebius_similarity_inf_iff [simp]:
  assumes "a \<noteq> 0"
  shows "moebius_pt (moebius_similarity a b) z = \<infinity>\<^sub>h \<longleftrightarrow> z = \<infinity>\<^sub>h"
  using assms
  using moebius_similarity_only_inf_to_inf[of a b z]
  by auto

lemma inf_fixed_only_moebius_similarity:
  assumes "moebius_pt M \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  shows "\<exists> a b. a \<noteq> 0 \<and> M = moebius_similarity a b"
  using assms
  unfolding moebius_similarity_def
proof (transfer, transfer)
  fix M :: complex_mat
  obtain a b c d where MM: "M = (a, b, c, d)"
    by (cases M, auto)
  assume "mat_det M \<noteq> 0" "moebius_pt_cmat_cvec M \<infinity>\<^sub>v \<approx>\<^sub>v \<infinity>\<^sub>v"
  hence *: "c = 0" "a \<noteq> 0 \<and> d \<noteq> 0"
    using MM
    by auto
  show "\<exists>a b. a \<noteq> 0 \<and> moebius_cmat_eq M (mk_moebius_cmat a b 0 1)"
  proof (rule_tac x="a/d" in exI, rule_tac x="b/d" in exI)
    show "a/d \<noteq> 0 \<and> moebius_cmat_eq M (mk_moebius_cmat (a / d) (b / d) 0 1)"
      using MM *
      by simp (rule_tac x="1/d" in exI, simp)
  qed
qed

text \<open>Euclidean similarities include translations, rotations, and dilatations.\<close>

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Translation\<close>
(* -------------------------------------------------------------------------- *)

definition moebius_translation where
  "moebius_translation v = moebius_similarity 1 v"

lemma moebius_translation_comp [simp]:
  shows "moebius_comp (moebius_translation v1) (moebius_translation v2) = moebius_translation (v1 + v2)"
  unfolding moebius_translation_def
  by (simp add: field_simps)

lemma moebius_translation_plus [simp]:
  shows "(moebius_translation v1) + (moebius_translation v2) = moebius_translation (v1 + v2)"
  by simp

lemma moebius_translation_zero [simp]:
  shows "moebius_translation 0 = id_moebius"
  unfolding moebius_translation_def moebius_similarity_id
  by simp

lemma moebius_translation_inv [simp]:
  shows "moebius_inv (moebius_translation v1) = moebius_translation (-v1)"
  using moebius_translation_comp[of v1 "-v1"] moebius_translation_zero
  using minus_unique[of "moebius_translation v1" "moebius_translation (-v1)"]
  by simp

lemma moebius_translation_uminus [simp]:
  shows "- (moebius_translation v1) = moebius_translation (-v1)"
  by simp

lemma moebius_translation_inv_translation [simp]:
  shows "moebius_pt (moebius_translation v) (moebius_pt (moebius_translation (-v)) z) = z"
  using moebius_translation_inv[symmetric, of v]
  by (simp del: moebius_translation_inv)

lemma moebius_inv_translation_translation [simp]:
  shows "moebius_pt (moebius_translation (-v)) (moebius_pt (moebius_translation v) z) = z"
  using moebius_translation_inv[symmetric, of v]
  by (simp del: moebius_translation_inv)

lemma moebius_pt_moebius_translation [simp]:
  shows "moebius_pt (moebius_translation v) (of_complex z) = of_complex (z + v)"
  unfolding moebius_translation_def
  by (simp add: field_simps)

lemma moebius_pt_moebius_translation_inf [simp]:
  shows "moebius_pt (moebius_translation v) \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  unfolding moebius_translation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Rotation\<close>
(* -------------------------------------------------------------------------- *)

definition moebius_rotation where
  "moebius_rotation \<phi> = moebius_similarity (cis \<phi>) 0"

lemma moebius_rotation_comp [simp]:
  shows "moebius_comp (moebius_rotation \<phi>1) (moebius_rotation \<phi>2) = moebius_rotation (\<phi>1 + \<phi>2)"
  unfolding moebius_rotation_def
  using moebius_similarity_comp[of "cis \<phi>1" "cis \<phi>2" 0 0]
  by (simp add: cis_mult)

lemma moebius_rotation_plus [simp]:
  shows "(moebius_rotation \<phi>1) + (moebius_rotation \<phi>2) = moebius_rotation (\<phi>1 + \<phi>2)"
  by simp

lemma moebius_rotation_zero [simp]:
  shows "moebius_rotation 0 = id_moebius"
  unfolding moebius_rotation_def
  using moebius_similarity_id
  by simp

lemma moebius_rotation_inv [simp]:
  shows "moebius_inv (moebius_rotation \<phi>) = moebius_rotation (- \<phi>)"
  using moebius_rotation_comp[of \<phi> "-\<phi>"] moebius_rotation_zero
  using minus_unique[of "moebius_rotation \<phi>" "moebius_rotation (-\<phi>)"]
  by simp

lemma moebius_rotation_uminus [simp]:
  shows "- (moebius_rotation \<phi>) = moebius_rotation (- \<phi>)"
  by simp

lemma moebius_rotation_inv_rotation [simp]:
  shows "moebius_pt (moebius_rotation \<phi>) (moebius_pt (moebius_rotation (-\<phi>)) z) = z"
  using moebius_rotation_inv[symmetric, of \<phi>]
  by (simp del: moebius_rotation_inv)

lemma moebius_inv_rotation_rotation [simp]:
  shows "moebius_pt (moebius_rotation (-\<phi>)) (moebius_pt (moebius_rotation \<phi>) z) = z"
  using moebius_rotation_inv[symmetric, of \<phi>]
  by (simp del: moebius_rotation_inv)

lemma moebius_pt_moebius_rotation [simp]:
  shows "moebius_pt (moebius_rotation \<phi>) (of_complex z) = of_complex (cis \<phi> * z)"
  unfolding moebius_rotation_def
  by simp

lemma moebius_pt_moebius_rotation_inf [simp]:
  shows "moebius_pt (moebius_rotation v) \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  unfolding moebius_rotation_def
  by simp

lemma moebius_pt_rotation_inf_iff [simp]:
  shows "moebius_pt (moebius_rotation v) x = \<infinity>\<^sub>h \<longleftrightarrow> x = \<infinity>\<^sub>h"
  unfolding moebius_rotation_def
  using cis_neq_zero moebius_similarity_only_inf_to_inf
  by (simp del: moebius_pt_moebius_similarity)

lemma moebius_pt_moebius_rotation_zero [simp]:
  shows "moebius_pt (moebius_rotation \<phi>) 0\<^sub>h = 0\<^sub>h"
  unfolding moebius_rotation_def
  by simp

lemma moebius_pt_moebius_rotation_zero_iff [simp]:
  shows "moebius_pt (moebius_rotation \<phi>) x = 0\<^sub>h \<longleftrightarrow> x = 0\<^sub>h"
  using moebius_pt_invert[of "moebius_rotation \<phi>" x "0\<^sub>h"]
  by auto

lemma moebius_rotation_preserve_cmod [simp]:
  assumes "u \<noteq> \<infinity>\<^sub>h"
  shows "cmod (to_complex (moebius_pt (moebius_rotation \<phi>) u)) = cmod (to_complex u)"
  using assms
  using inf_or_of_complex[of u]
  by auto

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Dilatation\<close>
(* -------------------------------------------------------------------------- *)

definition moebius_dilatation where
  "moebius_dilatation a = moebius_similarity (cor a) 0"

lemma moebius_dilatation_comp [simp]:
  assumes "a1 > 0" and "a2 > 0"
  shows "moebius_comp (moebius_dilatation a1) (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
  using assms
  unfolding moebius_dilatation_def
  by simp

lemma moebius_dilatation_plus [simp]:
  assumes "a1 > 0" and "a2 > 0"
  shows "(moebius_dilatation a1) + (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
  using assms
  by simp

lemma moebius_dilatation_zero [simp]:
  shows "moebius_dilatation 1 = id_moebius"
  unfolding moebius_dilatation_def
  using moebius_similarity_id
  by simp

lemma moebius_dilatation_inverse [simp]:
  assumes "a > 0"
  shows "moebius_inv (moebius_dilatation a) = moebius_dilatation (1/a)"
  using assms
  unfolding moebius_dilatation_def
  by simp

lemma moebius_dilatation_uminus [simp]:
  assumes "a > 0"
  shows "- (moebius_dilatation a) = moebius_dilatation (1/a)"
  using assms
  by simp

lemma moebius_pt_dilatation [simp]:
  assumes "a \<noteq> 0"
  shows "moebius_pt (moebius_dilatation a) (of_complex z) = of_complex (cor a * z)"
  using assms
  unfolding moebius_dilatation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Rotation-dilatation\<close>
(* -------------------------------------------------------------------------- *)

definition moebius_rotation_dilatation where
  "moebius_rotation_dilatation a = moebius_similarity a 0"

lemma moebius_rotation_dilatation:
  assumes "a \<noteq> 0"
  shows "moebius_rotation_dilatation a = moebius_rotation (arg a) + moebius_dilatation (cmod a)"
  using assms
  unfolding moebius_rotation_dilatation_def moebius_rotation_def moebius_dilatation_def
  by simp

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Conjugate Möbius\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Conjugation is not a Möbius transformation, and conjugate Möbius transformations (obtained
by conjugating each matrix element) do not represent conjugation function (although they are
somewhat related).\<close>

lift_definition conjugate_moebius_mmat :: "moebius_mat \<Rightarrow> moebius_mat" is mat_cnj
  by auto
lift_definition conjugate_moebius :: "moebius \<Rightarrow> moebius" is conjugate_moebius_mmat
  by transfer (auto simp add: mat_cnj_def)

lemma conjugate_moebius:
  shows "conjugate \<circ> moebius_pt M = moebius_pt (conjugate_moebius M) \<circ> conjugate"
  apply (rule ext, simp)
  apply (transfer, transfer)
  using vec_cnj_mult_mv by auto

(* -------------------------------------------------------------------------- *)
subsection \<open>Decomposition of M\"obius transformations\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Every Euclidean similarity can be decomposed using translations, rotations, and dilatations.\<close>
lemma similarity_decomposition:
  assumes "a \<noteq> 0"
  shows "moebius_similarity a b = (moebius_translation b) + (moebius_rotation (arg a)) + (moebius_dilatation (cmod a))"
proof-
  have "moebius_similarity a b = (moebius_translation b) + (moebius_rotation_dilatation a)"
    using assms
    unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def
    by auto
  thus ?thesis
    using moebius_rotation_dilatation [OF assms]
    by (auto simp add: add.assoc simp del: plus_moebius_def)
qed

text \<open>A very important fact is that every Möbius transformation can be
composed of Euclidean similarities and a reciprocation.\<close>
lemma moebius_decomposition:
  assumes "c \<noteq> 0" and "a*d - b*c \<noteq> 0"
  shows "mk_moebius a b c d =
             moebius_translation (a/c) +
             moebius_rotation_dilatation ((b*c - a*d)/(c*c)) +
             moebius_reciprocal +
             moebius_translation (d/c)"
  using assms
  unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def plus_moebius_def moebius_reciprocal_def
  by (simp add: field_simps) (transfer, transfer, auto simp add: field_simps, rule_tac x="1/c" in exI, simp)

lemma moebius_decomposition_similarity:
  assumes "a \<noteq> 0"
  shows "mk_moebius a b 0 d = moebius_similarity (a/d) (b/d)"
  using assms
  unfolding moebius_similarity_def
  by (transfer, transfer, auto, rule_tac x="1/d" in exI, simp)

text \<open>Decomposition is used in many proofs. Namely, to show that every Möbius transformation has
some property, it suffices to show that reciprocation and all Euclidean similarities have that
property, and that the property is preserved under compositions.\<close>
lemma wlog_moebius_decomposition:
  assumes
    trans: "\<And> v. P (moebius_translation v)" and
    rot: "\<And> \<alpha>. P (moebius_rotation \<alpha>)" and
    dil: "\<And> k. P (moebius_dilatation k)" and
    recip: "P (moebius_reciprocal)" and
    comp: "\<And> M1 M2. \<lbrakk>P M1; P M2\<rbrakk> \<Longrightarrow> P (M1 + M2)"
  shows "P M"
proof-
    obtain a b c d where "M = mk_moebius a b c d" "mat_det (a, b, c, d) \<noteq> 0"
      using ex_mk_moebius[of M]
      by auto
    show ?thesis
    proof (cases "c = 0")
      case False
      show ?thesis
        using moebius_decomposition[of c a d b] \<open>mat_det (a, b, c, d) \<noteq> 0\<close> \<open>c \<noteq> 0\<close> \<open>M = mk_moebius a b c d\<close>
        using moebius_rotation_dilatation[of "(b*c - a*d) / (c*c)"]
        using trans[of "a/c"] rot[of "arg ((b*c - a*d) / (c*c))"] dil[of "cmod ((b*c - a*d) / (c*c))"] recip
        using comp
        by (simp add: trans)
    next
      case True
      hence "M = moebius_similarity (a/d) (b/d)"
        using \<open>M = mk_moebius a b c d\<close> \<open>mat_det (a, b, c, d) \<noteq> 0\<close>
        using moebius_decomposition_similarity
        by auto
      thus ?thesis
        using \<open>c = 0\<close> \<open>mat_det (a, b, c, d) \<noteq> 0\<close>
        using similarity_decomposition[of "a/d" "b/d"]
        using trans[of "b/d"] rot[of "arg (a/d)"] dil[of "cmod (a/d)"] comp
        by simp
    qed
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Cross ratio and Möbius existence\<close>
(* -------------------------------------------------------------------------- *)

text \<open>For any fixed three points $z1$, $z2$ and $z3$, @{term "cross_ratio z z1 z2 z3"} can be seen as
a function of a single variable $z$.\<close>

lemma is_moebius_cross_ratio:
  assumes "z1 \<noteq> z2" and  "z2 \<noteq> z3" and "z1 \<noteq> z3"
  shows "is_moebius (\<lambda> z. cross_ratio z z1 z2 z3)"
proof-
  have "\<exists> M. \<forall> z. cross_ratio z z1 z2 z3 = moebius_pt M z"
    using assms
  proof (transfer, transfer)
    fix z1 z2 z3
    assume vz: "z1 \<noteq> vec_zero" "z2 \<noteq> vec_zero" "z3 \<noteq> vec_zero"
    obtain z1' z1'' where zz1: "z1 = (z1', z1'')"
      by (cases z1, auto)
    obtain z2' z2'' where zz2: "z2 = (z2', z2'')"
      by (cases z2, auto)
    obtain z3' z3'' where zz3: "z3 = (z3', z3'')"
      by (cases z3, auto)

    let ?m23 = "z2'*z3''-z3'*z2''"
    let ?m21 = "z2'*z1''-z1'*z2''"
    let ?m13 = "z1'*z3''-z3'*z1''"
    let ?M = "(z1''*?m23, -z1'*?m23, z3''*?m21, -z3'*?m21)"
    assume "\<not> z1 \<approx>\<^sub>v z2" "\<not> z2 \<approx>\<^sub>v z3" "\<not> z1 \<approx>\<^sub>v z3"
    hence *: "?m23 \<noteq> 0" "?m21 \<noteq> 0" "?m13 \<noteq> 0"
      using vz zz1 zz2 zz3
      using complex_cvec_eq_mix[of z1' z1'' z2' z2'']
      using complex_cvec_eq_mix[of z1' z1'' z3' z3'']
      using complex_cvec_eq_mix[of z2' z2'' z3' z3'']
      by (auto simp del: complex_cvec_eq_def simp add: field_simps)

    have "mat_det ?M = ?m21*?m23*?m13"
      by (simp add: field_simps)
    hence "mat_det ?M \<noteq> 0"
      using *
      by simp
    moreover
    have "\<forall>z\<in>{v. v \<noteq> vec_zero}. cross_ratio_cvec z z1 z2 z3 \<approx>\<^sub>v moebius_pt_cmat_cvec ?M z"
    proof
      fix z
      assume "z \<in> {v. v \<noteq> vec_zero}"
      hence "z \<noteq> vec_zero"
        by simp
      obtain z' z'' where zz: "z = (z', z'')"
        by (cases z, auto)

      let ?m01 = "z'*z1''-z1'*z''"
      let ?m03 = "z'*z3''-z3'*z''"

      have "?m01 \<noteq> 0 \<or> ?m03 \<noteq> 0"
      proof (cases "z'' = 0 \<or> z1'' = 0 \<or> z3'' = 0")
        case True
        thus ?thesis
          using * \<open>z \<noteq> vec_zero\<close>  zz
          by auto
      next
        case False
        hence 1: "z'' \<noteq> 0 \<and> z1'' \<noteq> 0 \<and> z3'' \<noteq> 0"
          by simp
        show ?thesis
        proof (rule ccontr)
          assume "\<not> ?thesis"
          hence "z' * z1'' - z1' * z'' = 0" "z' * z3'' - z3' * z'' = 0"
            by auto
          hence "z1'/z1'' = z3'/z3''"
            using 1 zz \<open>z \<noteq> vec_zero\<close>
            by (metis frac_eq_eq right_minus_eq)
          thus False
            using * 1
            using frac_eq_eq
            by auto
        qed
      qed
      note * = * this
      show "cross_ratio_cvec z z1 z2 z3 \<approx>\<^sub>v moebius_pt_cmat_cvec ?M z"
        using * zz zz1 zz2 zz3 mult_mv_nonzero[of "z" ?M] \<open>mat_det ?M \<noteq> 0\<close>
        by simp (rule_tac x="1" in exI, simp add: field_simps)
    qed
    ultimately
    show "\<exists>M\<in>{M. mat_det M \<noteq> 0}.
              \<forall>z\<in>{v. v \<noteq> vec_zero}. cross_ratio_cvec z z1 z2 z3 \<approx>\<^sub>v moebius_pt_cmat_cvec M z"
      by blast
  qed
  thus ?thesis
    by (auto simp add: is_moebius_def)
qed

text \<open>Using properties of the cross-ratio, it is shown that there is a Möbius transformation
mapping any three different points to $0_{hc}$, $1_{hc}$ and $\infty_{hc}$, respectively.\<close>
lemma ex_moebius_01inf:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
  shows "\<exists> M. ((moebius_pt M z1 = 0\<^sub>h) \<and> (moebius_pt M z2 = 1\<^sub>h) \<and> (moebius_pt M z3 = \<infinity>\<^sub>h))"
  using assms
  using is_moebius_cross_ratio[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close> \<open>z1 \<noteq> z3\<close>]
  using cross_ratio_0[OF \<open>z1 \<noteq> z2\<close> \<open>z1 \<noteq> z3\<close>] cross_ratio_1[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close>] cross_ratio_inf[OF \<open>z1 \<noteq> z3\<close> \<open>z2 \<noteq> z3\<close>]
  by (metis is_moebius_def)

text \<open>There is a Möbius transformation mapping any three different points to any three different
points.\<close>
lemma ex_moebius:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
          "w1 \<noteq> w2" and "w1 \<noteq> w3" and "w2 \<noteq> w3"
  shows "\<exists> M. ((moebius_pt M z1 = w1) \<and> (moebius_pt M z2 = w2) \<and> (moebius_pt M z3 = w3))"
proof-
  obtain M1 where *: "moebius_pt M1 z1 = 0\<^sub>h \<and> moebius_pt M1 z2 = 1\<^sub>h \<and> moebius_pt M1 z3 = \<infinity>\<^sub>h"
    using ex_moebius_01inf[OF assms(1-3)]
    by auto
  obtain M2 where **: "moebius_pt M2 w1 = 0\<^sub>h \<and> moebius_pt M2 w2 = 1\<^sub>h \<and> moebius_pt M2 w3 = \<infinity>\<^sub>h"
    using ex_moebius_01inf[OF assms(4-6)]
    by auto
  let ?M = "moebius_comp (moebius_inv M2) M1"
  show ?thesis
    using * **
    by (rule_tac x="?M" in exI, auto simp add: moebius_pt_invert)
qed

lemma ex_moebius_1:
  shows "\<exists> M. moebius_pt M z1 = w1"
proof-
  obtain z2 z3 where "z1 \<noteq> z2" "z1 \<noteq> z3" "z2 \<noteq> z3"
    using ex_3_different_points[of z1]
    by auto
  moreover
  obtain w2 w3 where "w1 \<noteq> w2" "w1 \<noteq> w3" "w2 \<noteq> w3"
    using ex_3_different_points[of w1]
    by auto
  ultimately
  show ?thesis
    using ex_moebius[of z1 z2 z3 w1 w2 w3]
    by auto
qed

text \<open>The next lemma turns out to have very important applications in further proof development, as
it enables so called ,,without-loss-of-generality (wlog)'' reasoning \cite{wlog}. Namely, if the
property is preserved under Möbius transformations, then instead of three arbitrary different
points one can consider only the case of points $0_{hc}$, $1_{hc}$, and $\infty_{hc}$.\<close>
lemma wlog_moebius_01inf:
  fixes M::moebius
  assumes "P 0\<^sub>h 1\<^sub>h \<infinity>\<^sub>h" and "z1 \<noteq> z2" and "z2 \<noteq> z3" and "z1 \<noteq> z3"
   "\<And> M a b c. P a b c \<Longrightarrow> P (moebius_pt M a) (moebius_pt M b) (moebius_pt M c)"
  shows "P z1 z2 z3"
proof-
  from assms obtain M where *:
    "moebius_pt M z1 = 0\<^sub>h"  "moebius_pt M z2 = 1\<^sub>h"   "moebius_pt M z3 = \<infinity>\<^sub>h"
    using ex_moebius_01inf[of z1 z2 z3]
    by auto
  have **: "moebius_pt (moebius_inv M) 0\<^sub>h = z1"  "moebius_pt (moebius_inv M) 1\<^sub>h = z2" "moebius_pt (moebius_inv M) \<infinity>\<^sub>h = z3"
    by (subst *[symmetric], simp)+
  thus ?thesis
    using assms
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Fixed points and Möbius transformation uniqueness\<close>
(* -------------------------------------------------------------------------- *)

lemma three_fixed_points_01inf:
  assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M 1\<^sub>h = 1\<^sub>h" and "moebius_pt M \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  shows "M = id_moebius"
  using assms
  by (transfer, transfer, auto)

  have "M' + M + (-M') = 0"
    unfolding zero_moebius_def
    apply (rule three_fixed_points_01inf)
    using * ** assms
    by (simp add: moebius_comp[symmetric])+
  thus ?thesis
    by (metis eq_neg_iff_add_eq_0 minus_add_cancel zero_moebius_def)
qed

lemma unique_moebius_three_points:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
  assumes "moebius_pt M1 z1 = w1" and "moebius_pt M1 z2 = w2" and "moebius_pt M1 z3 = w3"
          "moebius_pt M2 z1 = w1" and "moebius_pt M2 z2 = w2" and "moebius_pt M2 z3 = w3"
  shows "M1 = M2"
proof-
  let ?M = "moebius_comp (moebius_inv M2) M1"
  have "moebius_pt ?M z1 = z1"
    using \<open>moebius_pt M1 z1 = w1\<close> \<open>moebius_pt M2 z1 = w1\<close>
    by (auto simp add: moebius_pt_invert)
  moreover
  have "moebius_pt ?M z2 = z2"
    using \<open>moebius_pt M1 z2 = w2\<close> \<open>moebius_pt M2 z2 = w2\<close>
    by (auto simp add: moebius_pt_invert)
  moreover
  have "moebius_pt ?M z3 = z3"
    using \<open>moebius_pt M1 z3 = w3\<close> \<open>moebius_pt M2 z3 = w3\<close>
    by (auto simp add: moebius_pt_invert)
  ultimately
  have "?M = id_moebius"
    using assms three_fixed_points
    by auto
  thus ?thesis
    by (metis add_minus_cancel left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)
qed

text \<open>There is a unique Möbius transformation mapping three different points to other three
different points.\<close>

lemma ex_unique_moebius_three_points:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
          "w1 \<noteq> w2" and "w1 \<noteq> w3" and "w2 \<noteq> w3"
  shows "\<exists>! M. ((moebius_pt M z1 = w1) \<and> (moebius_pt M z2 = w2) \<and> (moebius_pt M z3 = w3))"
proof-
  obtain M where *: "moebius_pt M z1 = w1 \<and> moebius_pt M z2 = w2 \<and> moebius_pt M z3 = w3"
    using ex_moebius[OF assms]
    by auto
  show ?thesis
    unfolding Ex1_def
  proof (rule_tac x="M" in exI, rule)
    show "\<forall>y. moebius_pt y z1 = w1 \<and> moebius_pt y z2 = w2 \<and> moebius_pt y z3 = w3 \<longrightarrow> y = M"
      using *
      using unique_moebius_three_points[OF assms(1-3)]
      by simp
  qed (simp add: *)
qed

lemma ex_unique_moebius_three_points_fun:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
          "w1 \<noteq> w2" and "w1 \<noteq> w3" and "w2 \<noteq> w3"
  shows "\<exists>! f. is_moebius f \<and> (f z1 = w1) \<and> (f z2 = w2) \<and> (f z3 = w3)"
proof-
  obtain M where "moebius_pt M z1 = w1" "moebius_pt M z2 = w2" "moebius_pt M z3 = w3"
    using ex_unique_moebius_three_points[OF assms]
    by auto
  thus ?thesis
    using ex_unique_moebius_three_points[OF assms]
    unfolding Ex1_def
    by (rule_tac x="moebius_pt M" in exI) (auto simp add: is_moebius_def)
qed

text \<open>Different Möbius transformations produce different actions.\<close>
lemma unique_moebius_pt:
  assumes "moebius_pt M1 = moebius_pt M2"
  shows "M1 = M2"
  using assms unique_moebius_three_points[of "0\<^sub>h" "1\<^sub>h" "\<infinity>\<^sub>h"]
  by auto

lemma is_cross_ratio_01inf:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3" and "is_moebius f"
  assumes "f z1 = 0\<^sub>h" and "f z2 = 1\<^sub>h" and "f z3 = \<infinity>\<^sub>h"
  shows "f = (\<lambda> z. cross_ratio z z1 z2 z3)"
  using assms
  using cross_ratio_0[OF \<open>z1 \<noteq> z2\<close> \<open>z1 \<noteq> z3\<close>] cross_ratio_1[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close>] cross_ratio_inf[OF \<open>z1 \<noteq> z3\<close> \<open>z2 \<noteq> z3\<close>]
  using is_moebius_cross_ratio[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close> \<open>z1 \<noteq> z3\<close>]
  using ex_unique_moebius_three_points_fun[OF \<open>z1 \<noteq> z2\<close> \<open>z1 \<noteq> z3\<close> \<open>z2 \<noteq> z3\<close>, of "0\<^sub>h" "1\<^sub>h" "\<infinity>\<^sub>h"]
  by auto

text \<open>Möbius transformations preserve cross-ratio.\<close>
lemma moebius_preserve_cross_ratio [simp]:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
  shows "cross_ratio (moebius_pt M z) (moebius_pt M z1) (moebius_pt M z2) (moebius_pt M z3) =
         cross_ratio z z1 z2 z3"
proof-
  let ?f = "\<lambda> z. cross_ratio z z1 z2 z3"
  let ?M = "moebius_pt M"
  let ?iM = "inv ?M"
  have "(?f \<circ> ?iM) (?M z1) = 0\<^sub>h"
    using bij_moebius_pt[of M] cross_ratio_0[OF \<open>z1 \<noteq> z2\<close> \<open>z1 \<noteq> z3\<close>]
    by (simp add: bij_def)
  moreover
  have "(?f \<circ> ?iM) (?M z2) = 1\<^sub>h"
    using bij_moebius_pt[of M]  cross_ratio_1[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close>]
    by (simp add: bij_def)
  moreover
  have "(?f \<circ> ?iM) (?M z3) = \<infinity>\<^sub>h"
    using bij_moebius_pt[of M] cross_ratio_inf[OF \<open>z1 \<noteq> z3\<close> \<open>z2 \<noteq> z3\<close>]
    by (simp add: bij_def)
  moreover
  have "is_moebius (?f \<circ> ?iM)"
    by (rule is_moebius_comp, rule is_moebius_cross_ratio[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close> \<open>z1 \<noteq> z3\<close>], rule is_moebius_inv, auto simp add: is_moebius_def)
  moreover
  have "?M z1 \<noteq> ?M z2" "?M z1 \<noteq> ?M z3"  "?M z2 \<noteq> ?M z3"
    using assms
    by simp_all
  ultimately
  have "?f \<circ> ?iM = (\<lambda> z. cross_ratio z (?M z1) (?M z2) (?M z3))"
    using assms
    using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "?f \<circ> ?iM"]
    by simp
  moreover
  have "(?f \<circ> ?iM) (?M z) = cross_ratio z z1 z2 z3"
    using bij_moebius_pt[of M]
    by (simp add: bij_def)
  moreover
  have "(\<lambda> z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
    by simp
  ultimately
  show ?thesis
    by simp
qed

lemma conjugate_cross_ratio [simp]:
  assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
  shows "cross_ratio (conjugate z) (conjugate z1) (conjugate z2) (conjugate z3) =
         conjugate (cross_ratio z z1 z2 z3)"
proof-
  let ?f = "\<lambda> z. cross_ratio z z1 z2 z3"
  let ?M = "conjugate"
  let ?iM = "conjugate"
  have "(conjugate \<circ> ?f \<circ> ?iM) (?M z1) = 0\<^sub>h"
    using cross_ratio_0[OF \<open>z1 \<noteq> z2\<close> \<open>z1 \<noteq> z3\<close>]
    by simp
  moreover
  have "(conjugate \<circ> ?f \<circ> ?iM) (?M z2) = 1\<^sub>h"
    using cross_ratio_1[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close>]
    by simp
  moreover
  have "(conjugate \<circ> ?f \<circ> ?iM) (?M z3) = \<infinity>\<^sub>h"
    using cross_ratio_inf[OF \<open>z1 \<noteq> z3\<close> \<open>z2 \<noteq> z3\<close>]
    by simp
  moreover
  have "is_moebius (conjugate \<circ> ?f \<circ> ?iM)"
  proof-
    obtain M where "?f = moebius_pt M"
      using is_moebius_cross_ratio[OF \<open>z1 \<noteq> z2\<close> \<open>z2 \<noteq> z3\<close> \<open>z1 \<noteq> z3\<close>]
      by (auto simp add: is_moebius_def)
    thus ?thesis
      using conjugate_moebius[of M]
      by (auto simp add: comp_assoc is_moebius_def)
  qed
  moreover
  have "?M z1 \<noteq> ?M z2" "?M z1 \<noteq> ?M z3"  "?M z2 \<noteq> ?M z3"
    using assms
    by (auto simp add: conjugate_inj)
  ultimately
  have "conjugate \<circ> ?f \<circ> ?iM = (\<lambda> z. cross_ratio z (?M z1) (?M z2) (?M z3))"
    using assms
    using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "conjugate \<circ> ?f \<circ> ?iM"]
    by simp
  moreover
  have "(conjugate \<circ> ?f \<circ> ?iM) (?M z) = conjugate (cross_ratio z z1 z2 z3)"
    by simp
  moreover
  have "(\<lambda> z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
    by simp
  ultimately
  show ?thesis
    by simp
qed

lemma cross_ratio_reciprocal [simp]:
  assumes "u \<noteq> v" and "v \<noteq> w" and "u \<noteq> w"
  shows "cross_ratio (reciprocal z) (reciprocal u) (reciprocal v) (reciprocal w) =
         cross_ratio z u v w"
  using assms
  by (subst moebius_reciprocal[symmetric])+ (simp del: moebius_reciprocal)

lemma cross_ratio_inversion [simp]:
  assumes "u \<noteq> v" and "v \<noteq> w" and "u \<noteq> w"
  shows "cross_ratio (inversion z) (inversion u) (inversion v) (inversion w) =
         conjugate (cross_ratio z u v w)"
proof-
  have "reciprocal u \<noteq> reciprocal v" "reciprocal u \<noteq> reciprocal w" "reciprocal v \<noteq> reciprocal w"
    using assms
    by ((subst moebius_reciprocal[symmetric])+, simp del: moebius_reciprocal)+
  thus ?thesis
    using assms
    unfolding inversion_def
    by simp
qed

lemma fixed_points_0inf':
  assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  shows "\<exists> k::complex_homo. (k \<noteq> 0\<^sub>h \<and> k \<noteq> \<infinity>\<^sub>h) \<and> (\<forall> z. moebius_pt M z = k *\<^sub>h z)"
using assms
proof (transfer, transfer)
  fix M :: complex_mat
  assume "mat_det M \<noteq> 0"
  obtain a b c d where MM: "M = (a, b, c, d)"
    by (cases M) auto
  assume "moebius_pt_cmat_cvec M 0\<^sub>v \<approx>\<^sub>v 0\<^sub>v" "moebius_pt_cmat_cvec M \<infinity>\<^sub>v \<approx>\<^sub>v \<infinity>\<^sub>v"
  hence *: "b = 0" "c = 0" "a \<noteq> 0 \<and> d \<noteq> 0"
    using MM
    by auto
  let ?z = "(a, d)"
  have "?z \<noteq> vec_zero"
    using *
    by simp
  moreover
  have "\<not> ?z \<approx>\<^sub>v 0\<^sub>v \<and> \<not> ?z \<approx>\<^sub>v \<infinity>\<^sub>v"
    using *
    by simp
  moreover
  have "\<forall>z\<in>{v. v \<noteq> vec_zero}. moebius_pt_cmat_cvec M z \<approx>\<^sub>v ?z *\<^sub>v z"
    using MM \<open>mat_det M \<noteq> 0\<close> *
    by force
  ultimately
  show "\<exists>k\<in>{v. v \<noteq> vec_zero}.
                   (\<not> k \<approx>\<^sub>v 0\<^sub>v \<and> \<not> k \<approx>\<^sub>v \<infinity>\<^sub>v) \<and>
                   (\<forall>z\<in>{v. v \<noteq> vec_zero}. moebius_pt_cmat_cvec M z \<approx>\<^sub>v k *\<^sub>v z)"
    by blast
qed

lemma fixed_points_0inf:
  assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M \<infinity>\<^sub>h = \<infinity>\<^sub>h"
  shows "\<exists> k::complex_homo. (k \<noteq> 0\<^sub>h \<and> k \<noteq> \<infinity>\<^sub>h) \<and> moebius_pt M = (\<lambda> z. k *\<^sub>h z)"
  using fixed_points_0inf'[OF assms]
  by auto

lemma ex_cross_ratio:
  assumes "u \<noteq> v" and "u \<noteq> w" and "v \<noteq> w"
  shows "\<exists> z. cross_ratio z u v w = c"
proof-
  obtain M where "(\<lambda> z. cross_ratio z u v w) = moebius_pt M"
    using assms is_moebius_cross_ratio[of u v w]
    unfolding is_moebius_def
    by auto
  hence *: "\<forall> z. cross_ratio z u v w = moebius_pt M z"
    by metis
  let ?z = "moebius_pt (-M) c"
  have "cross_ratio ?z u v w = c"
    using *
    by auto
  thus ?thesis
    by auto
qed

lemma unique_cross_ratio:
  assumes "u \<noteq> v" and "v \<noteq> w" and "u \<noteq> w"
  assumes "cross_ratio z u v w = cross_ratio z' u v w"
  shows "z = z'"
proof-
  obtain M where "(\<lambda> z. cross_ratio z u v w) = moebius_pt M"
    using is_moebius_cross_ratio[OF assms(1-3)]
    unfolding is_moebius_def
    by auto
  hence "moebius_pt M z = moebius_pt M z'"
    using assms(4)
    by metis
  thus ?thesis
    using moebius_pt_eq_I
    by metis
qed

lemma ex1_cross_ratio:
  assumes "u \<noteq> v" and "u \<noteq> w" and "v \<noteq> w"
  shows "\<exists>! z. cross_ratio z u v w = c"
  using assms ex_cross_ratio[OF assms, of c] unique_cross_ratio[of u v w]
  by blast

(* -------------------------------------------------------------------------- *)
subsection \<open>Pole\<close>
(* -------------------------------------------------------------------------- *)

definition is_pole :: "moebius \<Rightarrow> complex_homo \<Rightarrow> bool" where
  "is_pole M z \<longleftrightarrow> moebius_pt M z = \<infinity>\<^sub>h"

lemma ex1_pole:
  shows "\<exists>! z. is_pole M z"
  using bij_moebius_pt[of M]
  unfolding is_pole_def bij_def inj_on_def surj_def
  unfolding Ex1_def
  by (metis UNIV_I)

definition pole :: "moebius \<Rightarrow> complex_homo" where
  "pole M = (THE z. is_pole M z)"

lemma pole_similarity:
  assumes "is_pole (moebius_similarity a b) z" and "a \<noteq> 0"
  shows "z = \<infinity>\<^sub>h"
  using assms
  unfolding is_pole_def
  using moebius_similarity_only_inf_to_inf[of a b z]
  by simp

(* -------------------------------------------------------------------------- *)
subsection \<open>Homographies and antihomographies\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Inversion is not a Möbius transformation (it is a canonical example of so called
anti-Möbius transformations, or antihomographies). All antihomographies are compositions of
homographies and conjugation. The fundamental theorem of projective geometry (that we shall not
prove) states that all automorphisms (bijective functions that preserve the cross-ratio) of
$\mathbb{C}P^1$ are either homographies or antihomographies.\<close>

definition is_homography :: "(complex_homo \<Rightarrow> complex_homo) \<Rightarrow> bool" where
 "is_homography f \<longleftrightarrow> is_moebius f"

definition is_antihomography :: "(complex_homo \<Rightarrow> complex_homo) \<Rightarrow> bool" where
 "is_antihomography f \<longleftrightarrow> (\<exists> f'. is_moebius f' \<and> f = f' \<circ> conjugate)"

text \<open>Conjugation is not a Möbius transformation, but is antihomograhpy.\<close>
lemma not_moebius_conjugate:
  shows "\<not> is_moebius conjugate"
proof
  assume "is_moebius conjugate"
  then obtain M where *: "moebius_pt M = conjugate"
    unfolding is_moebius_def
    by metis
  hence "moebius_pt M 0\<^sub>h = 0\<^sub>h" "moebius_pt M 1\<^sub>h = 1\<^sub>h" "moebius_pt M \<infinity>\<^sub>h = \<infinity>\<^sub>h"
    by auto
  hence "M = id_moebius"
    using three_fixed_points_01inf
    by auto
  hence "conjugate = id"
    using *
    by simp
  moreover
  have "conjugate ii\<^sub>h \<noteq> ii\<^sub>h"
    using of_complex_inj[of "\<i>" "-\<i>"]
    by (subst of_complex_ii[symmetric])+ (auto simp del: of_complex_ii)
  ultimately
  show False
    by simp
qed

lemma conjugation_is_antihomography[simp]:
  shows "is_antihomography conjugate"
  unfolding is_antihomography_def
  by (rule_tac x="id" in exI, metis fun.map_id0 id_apply is_moebius_def moebius_pt_moebius_id)

lemma inversion_is_antihomography [simp]:
  shows "is_antihomography inversion"
  using moebius_reciprocal
  unfolding inversion_sym is_antihomography_def is_moebius_def
  by metis

text \<open>Functions cannot simultaneously be homographies and antihomographies - the disjunction is exclusive.\<close>
lemma homography_antihomography_exclusive:
  assumes "is_antihomography f"
  shows "\<not> is_homography f"
proof
  assume "is_homography f"
  then obtain M where "f = moebius_pt M"
    unfolding is_homography_def is_moebius_def
    by auto
  then obtain M' where "moebius_pt M = moebius_pt M' \<circ> conjugate"
    using assms
    unfolding is_antihomography_def is_moebius_def
    by auto
  hence "conjugate = moebius_pt (-M') \<circ> moebius_pt M"
    by auto
  hence "conjugate = moebius_pt (-M' + M)"
    by (simp add: moebius_comp)
  thus False
    using not_moebius_conjugate
    unfolding is_moebius_def
    by metis
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Classification of Möbius transformations\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Möbius transformations can be classified to parabolic, elliptic and loxodromic. We do not
develop this part of the theory in depth.\<close>

lemma similarity_scale_1:
  assumes "k \<noteq> 0"
  shows "similarity (k *\<^sub>s\<^sub>m I) M = similarity I M"
  using assms
  unfolding similarity_def
  using mat_inv_mult_sm[of k I]
  by simp

lemma similarity_scale_2:
  shows "similarity I (k *\<^sub>s\<^sub>m M) = k *\<^sub>s\<^sub>m (similarity I M)"
  unfolding similarity_def
  by auto

lemma mat_trace_mult_sm [simp]:
  shows "mat_trace (k *\<^sub>s\<^sub>m M) = k * mat_trace M"
  by (cases M) (simp add: field_simps)

definition moebius_mb_cmat :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> complex_mat" where
  [simp]: "moebius_mb_cmat I M = similarity I M"

lift_definition moebius_mb_mmat :: "moebius_mat \<Rightarrow> moebius_mat \<Rightarrow> moebius_mat" is moebius_mb_cmat
  by (simp add: similarity_def mat_det_inv)

lift_definition moebius_mb :: "moebius \<Rightarrow> moebius \<Rightarrow> moebius" is moebius_mb_mmat
proof transfer
  fix M M' I I'
  assume "moebius_cmat_eq M M'" "moebius_cmat_eq I I'"
  thus "moebius_cmat_eq (moebius_mb_cmat I M) (moebius_mb_cmat I' M')"
    by (auto simp add: similarity_scale_1 similarity_scale_2)
qed

definition similarity_invar_cmat :: "complex_mat \<Rightarrow> complex" where
  [simp]: "similarity_invar_cmat M = (mat_trace M)\<^sup>2 / mat_det M - 4"

lift_definition similarity_invar_mmat :: "moebius_mat \<Rightarrow> complex" is similarity_invar_cmat
  done

lift_definition similarity_invar :: "moebius \<Rightarrow> complex" is similarity_invar_mmat
  by transfer (auto simp add: power2_eq_square field_simps)

lemma similarity_invar_moeibus_mb:
  shows "similarity_invar (moebius_mb I M) = similarity_invar M"
  by (transfer, transfer, simp)

definition similar :: "moebius \<Rightarrow> moebius \<Rightarrow> bool" where
  "similar M1 M2 \<longleftrightarrow> (\<exists> I. moebius_mb I M1 = M2)"

lemma similar_refl [simp]:
  shows "similar M M"
  unfolding similar_def
  by (rule_tac x="id_moebius" in exI) (transfer, transfer, simp)

lemma similar_sym:
  assumes "similar M1 M2"
  shows "similar M2 M1"
proof-
  from assms obtain I where "M2 = moebius_mb I M1"
    unfolding similar_def
    by auto
  hence "M1 = moebius_mb (moebius_inv I) M2"
  proof (transfer, transfer)
    fix M2 I M1
    assume "moebius_cmat_eq M2 (moebius_mb_cmat I M1)" "mat_det I \<noteq> 0"
    then obtain k where "k \<noteq> 0" "similarity I M1 = k *\<^sub>s\<^sub>m M2"
      by auto
    thus "moebius_cmat_eq M1 (moebius_mb_cmat (moebius_inv_cmat I) M2)"
      using similarity_inv[of I M1 "k *\<^sub>s\<^sub>m M2", OF _ \<open>mat_det I \<noteq> 0\<close>]
      by (auto simp add: similarity_scale_2) (rule_tac x="1/k" in exI, simp)
  qed
  thus ?thesis
    unfolding similar_def
    by auto
qed

lemma similar_trans:
  assumes "similar M1 M2" and "similar M2 M3"
  shows "similar M1 M3"
proof-
  obtain I1 I2 where "moebius_mb I1 M1 = M2" "moebius_mb I2 M2 = M3"
    using assms
    by (auto simp add: similar_def)
  thus ?thesis
    unfolding similar_def
  proof (rule_tac x="moebius_comp I1 I2" in exI, transfer, transfer)
    fix I1 I2 M1 M2 M3
    assume "moebius_cmat_eq (moebius_mb_cmat I1 M1) M2"
           "moebius_cmat_eq (moebius_mb_cmat I2 M2) M3"
           "mat_det I1 \<noteq> 0" "mat_det I2 \<noteq> 0"
    thus "moebius_cmat_eq (moebius_mb_cmat (moebius_comp_cmat I1 I2) M1) M3"
      by (auto simp add: similarity_scale_2) (rule_tac x="ka*k" in exI, simp)
  qed
qed

end


(* ----------------------------------------------------------------- *)
section \<open>Elementary complex geometry\<close>
(* ----------------------------------------------------------------- *)

text \<open>In this section equations and basic properties of the most fundamental objects and relations in
geometry -- collinearity, lines, circles and circlines. These are defined by equations in
$\mathbb{C}$ (not extended by an infinite point). Later these equations will be generalized to
equations in the extended complex plane, over homogenous coordinates.\<close>

theory Elementary_Complex_Geometry
imports More_Complex Linear_Systems Angles
begin

(* ----------------------------------------------------------------- *)
subsection \<open>Collinear points\<close>
(* ----------------------------------------------------------------- *)

definition collinear :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> bool" where
  "collinear z1 z2 z3 \<longleftrightarrow> z1 = z2 \<or> Im ((z3 - z1) / (z2 - z1)) = 0"

lemma collinear_ex_real:
  shows "collinear z1 z2 z3 \<longleftrightarrow>
         (\<exists> k::real. z1 = z2 \<or> z3 - z1 = complex_of_real k * (z2 - z1))"
  unfolding collinear_def
  by (metis Im_complex_of_real add_diff_cancel_right' complex_eq diff_zero legacy_Complex_simps(15) nonzero_mult_div_cancel_right right_minus_eq times_divide_eq_left zero_complex.code)

text \<open>Collinearity characterization using determinants\<close>
lemma collinear_det:
  assumes "\<not> collinear z1 z2 z3"
  shows "det2 (z3 - z1) (cnj (z3 - z1)) (z1 - z2) (cnj (z1 - z2)) \<noteq> 0"
proof-
  from assms have "((z3 - z1) / (z2 - z1)) - cnj ((z3 - z1) / (z2 - z1)) \<noteq> 0" "z2 \<noteq> z1"
    unfolding collinear_def
    using Complex_Im_express_cnj[of "(z3 - z1) / (z2 - z1)"]
    by (auto simp add: Complex_eq)
  thus ?thesis
    by (auto simp add: field_simps)
qed

text \<open>Properties of three collinear points\<close>

lemma collinear_sym1:
  shows "collinear z1 z2 z3 \<longleftrightarrow> collinear z1 z3 z2"
  unfolding collinear_def
  using div_reals[of "1" "(z3 - z1)/(z2 - z1)"]  div_reals[of "1" "(z2 - z1)/(z3 - z1)"]
  by auto

lemma collinear_sym2':
  assumes "collinear z1 z2 z3"
  shows "collinear z2 z1 z3"
proof-
  obtain k where "z1 = z2 \<or> z3 - z1 = complex_of_real k * (z2 - z1)"
    using assms
    unfolding collinear_ex_real
    by auto
  thus ?thesis
  proof
    assume "z3 - z1 = complex_of_real k * (z2 - z1)"
    thus ?thesis
      unfolding collinear_ex_real
      by (rule_tac x="1-k" in exI) (auto simp add: field_simps)
  qed (simp add: collinear_def)
qed

lemma collinear_sym2:
  shows "collinear z1 z2 z3 \<longleftrightarrow> collinear z2 z1 z3"
  using collinear_sym2'[of z1 z2 z3] collinear_sym2'[of z2 z1 z3]
  by auto

text \<open>Properties of four collinear points\<close>

lemma collinear_trans1:
  assumes "collinear z0 z2 z1" and "collinear z0 z3 z1" and "z0 \<noteq> z1"
  shows "collinear z0 z2 z3"
  using assms
  unfolding collinear_ex_real
  by (cases "z0 = z2", auto) (rule_tac x="k/ka" in exI, case_tac "ka = 0", auto simp add: field_simps)

(* ----------------------------------------------------------------- *)
subsection \<open>Euclidean line\<close>
(* ----------------------------------------------------------------- *)

text \<open>Line is defined by using collinearity\<close>
definition line :: "complex \<Rightarrow> complex \<Rightarrow> complex set" where
  "line z1 z2 = {z. collinear z1 z2 z}"

lemma line_points_collinear:
  assumes "z1 \<in> line z z'" and "z2 \<in> line z z'" and "z3 \<in> line z z'" and "z \<noteq> z'"
  shows "collinear z1 z2 z3"
  using assms
  unfolding line_def
  by (smt collinear_sym1 collinear_sym2' collinear_trans1 mem_Collect_eq)

text \<open>Parametric equation of a line\<close>
lemma line_param:
  shows "z1 + cor k * (z2 - z1) \<in> line z1 z2"
  unfolding line_def
  by (auto simp add: collinear_def)

text \<open>Equation of the line containing two different given points\<close>
lemma line_equation:
  assumes "z1 \<noteq> z2" and "\<mu> = rot90 (z2 - z1)"
  shows "line z1 z2 = {z. cnj \<mu>*z + \<mu>*cnj z - (cnj \<mu> * z1 + \<mu> * cnj z1)  = 0}"
proof-
  {
    fix z
    have "z \<in> line z1 z2 \<longleftrightarrow> Im ((z - z1)/(z2 - z1)) = 0"
      using assms
      by (simp add: line_def collinear_def)
    also have "... \<longleftrightarrow> (z - z1)/(z2 - z1) = cnj ((z - z1)/(z2 - z1))"
      using complex_diff_cnj[of "(z - z1)/(z2 - z1)"]
      by auto
    also have "... \<longleftrightarrow> (z - z1)*(cnj z2 - cnj z1) = (cnj z - cnj z1)*(z2 - z1)"
      using assms(1)
      using \<open>(z \<in> line z1 z2) = is_real ((z - z1) / (z2 - z1))\<close> calculation is_real_div
      by auto
    also have "... \<longleftrightarrow> cnj(z2 - z1)*z - (z2 - z1)*cnj z - (cnj(z2 - z1)*z1 - (z2 - z1)*cnj z1) = 0"
      by (simp add: field_simps)
    also have "... \<longleftrightarrow> cnj \<mu> * z + \<mu> * cnj z  - (cnj \<mu> * z1 + \<mu> * cnj z1) = 0"
      apply (subst assms)+
      apply (subst cnj_mix_minus)+
      by simp
    finally have "z \<in> line z1 z2 \<longleftrightarrow> cnj \<mu> * z + \<mu> * cnj z  - (cnj \<mu> * z1 + \<mu> * cnj z1) = 0"
      .
  }
  thus ?thesis
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Euclidean circle\<close>
(* -------------------------------------------------------------------------- *)

text \<open>Definition of the circle with given center and radius. It consists of all
points on the distance $r$ from the center $\mu$.\<close>
definition circle :: "complex \<Rightarrow> real \<Rightarrow> complex set" where
  "circle \<mu> r = {z. cmod (z - \<mu>) = r}"

text \<open>Equation of the circle centered at $\mu$ with the radius $r$.\<close>
lemma circle_equation:
  assumes "r \<ge> 0"
  shows "circle \<mu> r = {z. z*cnj z - z*cnj \<mu> - cnj z*\<mu> + \<mu>*cnj \<mu> - cor (r*r) = 0}"
proof (safe)
  fix z
  assume "z \<in> circle \<mu> r"
  hence "(z - \<mu>)*cnj (z - \<mu>) = complex_of_real (r*r)"
    unfolding circle_def
    using complex_mult_cnj_cmod[of "z - \<mu>"]
    by (auto simp add: power2_eq_square)
  thus "z * cnj z - z * cnj \<mu> - cnj z * \<mu> + \<mu> * cnj \<mu> - cor (r * r) = 0"
    by (auto simp add: field_simps)
next
  fix z
  assume "z * cnj z - z * cnj \<mu> - cnj z * \<mu> + \<mu> * cnj \<mu> - cor (r * r) = 0"
  hence "(z - \<mu>)*cnj (z - \<mu>) = cor (r*r)"
    by (auto simp add: field_simps)
  thus "z \<in> circle \<mu> r"
    using assms
    using complex_mult_cnj_cmod[of "z - \<mu>"]
    using power2_eq_imp_eq[of "cmod (z - \<mu>)" r]
    unfolding circle_def power2_eq_square[symmetric] complex_of_real_def
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsection \<open>Circline\<close>
(* -------------------------------------------------------------------------- *)

text \<open>A very important property of the extended complex plane is that it is possible to treat circles
and lines in a uniform way. The basic object is \emph{generalized circle}, or \emph{circline} for
short. We introduce circline equation given in $\mathbb{C}$, and it will later be generalized to an
equation in the extended complex plane $\overline{\mathbb{C}}$ given in matrix form using a
Hermitean matrix and a quadratic form over homogenous coordinates.\<close>

definition circline where
  "circline A BC D = {z. cor A*z*cnj z + cnj BC*z + BC*cnj z + cor D = 0}"

text \<open>Connection between circline and Euclidean circle\<close>

text \<open>Every circline with positive determinant and $A \neq 0$ represents an Euclidean circle\<close>

lemma circline_circle:
  assumes "A \<noteq> 0" and "A * D \<le> (cmod BC)\<^sup>2"
  "cl = circline A BC D" and
  "\<mu> = -BC/cor A" and
  "r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2" and "r = sqrt r2"
  shows "cl = circle \<mu> r"
proof-
  have *: "cl = {z. z * cnj z + cnj (BC / cor A) * z + (BC / cor A) * cnj z + cor (D / A) = 0}"
    using \<open>cl = circline A BC D\<close> \<open>A \<noteq> 0\<close>
    by (auto simp add: circline_def field_simps)

  have "r2 \<ge> 0"
  proof-
    have "(cmod BC)\<^sup>2 - A * D \<ge>  0"
      using \<open>A * D \<le> (cmod BC)\<^sup>2\<close>
      by auto
    thus ?thesis
      using \<open>A \<noteq> 0\<close> \<open>r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2\<close>
      by (metis zero_le_divide_iff zero_le_power2)
  qed
  hence **: "r * r = r2" "r \<ge> 0"
    using \<open>r = sqrt r2\<close>
    by (auto simp add: real_sqrt_mult[symmetric])

  have ***: "- \<mu> * - cnj \<mu> - cor r2 = cor (D / A)"
    using \<open>\<mu> = - BC / complex_of_real A\<close> \<open>r2 = ((cmod BC)\<^sup>2 - A * D) / A\<^sup>2\<close>
    by (auto simp add: power2_eq_square complex_mult_cnj_cmod field_simps)
       (simp add: add_divide_eq_iff assms(1))
  thus ?thesis
    using \<open>r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2\<close> \<open>\<mu> = - BC / cor A\<close>
    by (subst *, subst circle_equation[of r \<mu>, OF \<open>r \<ge> 0\<close>], subst **) (auto simp add: field_simps power2_eq_square)
qed

lemma circline_ex_circle:
  assumes "A \<noteq> 0" and "A * D \<le> (cmod BC)\<^sup>2" and "cl = circline A BC D"
  shows "\<exists> \<mu> r. cl = circle \<mu> r"
  using circline_circle[OF assms]
  by auto

text \<open>Every Euclidean circle can be represented by a circline\<close>

lemma circle_circline:
  assumes "cl = circle \<mu> r" and "r \<ge> 0"
  shows "cl = circline 1 (-\<mu>) ((cmod \<mu>)\<^sup>2 - r\<^sup>2)"
proof-
  have "complex_of_real ((cmod \<mu>)\<^sup>2 - r\<^sup>2) = \<mu> * cnj \<mu> - complex_of_real (r\<^sup>2)"
    by (auto simp add: complex_mult_cnj_cmod)
  thus "cl = circline 1 (- \<mu>) ((cmod \<mu>)\<^sup>2 - r\<^sup>2)"
    using assms
    using circle_equation[of r \<mu>]
    unfolding circline_def power2_eq_square
    by (simp add: field_simps)
qed

lemma circle_ex_circline:
  assumes "cl = circle \<mu> r" and "r \<ge> 0"
  shows "\<exists> A BC D. A \<noteq> 0 \<and> A*D \<le> (cmod BC)\<^sup>2 \<and> cl = circline A BC D"
  using circle_circline[OF assms]
  using \<open>r \<ge> 0\<close>
  by (rule_tac x=1 in exI, rule_tac x="-\<mu>" in exI, rule_tac x="Re (\<mu> * cnj \<mu>) - (r * r)" in exI) (simp add: complex_mult_cnj_cmod power2_eq_square)

text \<open>Connection between circline and Euclidean line\<close>

text \<open>Every circline with a positive determinant and $A = 0$ represents an Euclidean line\<close>

lemma circline_line:
  assumes
    "A = 0" and "BC \<noteq> 0" and
    "cl = circline A BC D" and
    "z1 = - cor D * BC / (2 * BC * cnj BC)" and
    "z2 = z1 + \<i> * sgn (if arg BC > 0 then -BC else BC)"
  shows
    "cl = line z1 z2"
proof-
  have "cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}"
    using assms
    by (simp add: circline_def)
    have "{z. cnj BC*z + BC*cnj z + complex_of_real D = 0} =
          {z. cnj BC*z + BC*cnj z - (cnj BC*z1 + BC*cnj z1) = 0}"
      using  \<open>BC \<noteq> 0\<close> assms
      by simp
    moreover
    have "z1 \<noteq> z2"
      using \<open>BC \<noteq> 0\<close> assms
      by (auto simp add: sgn_eq)
    moreover
    have "\<exists> k. k \<noteq> 0 \<and> BC = cor k*rot90 (z2 - z1)"
    proof (cases "arg BC > 0")
      case True
      thus ?thesis
        using assms
        by (rule_tac x="(cmod BC)" in exI, auto simp add: Complex_scale4)
    next
      case False
      thus ?thesis
        using assms
        by (rule_tac x="-(cmod BC)" in exI, simp)
           (smt Complex.Re_sgn Im_sgn cis_arg complex_minus complex_surj mult_minus_right rcis_cmod_arg rcis_def)
    qed
    then obtain k where "cor k \<noteq> 0" "BC = cor k*rot90 (z2 - z1)"
      by auto
    moreover
    have *: "\<And> z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = (1/cor k) * (cnj_mix BC z - cnj_mix BC z1)"
      using \<open>cor k \<noteq> 0\<close>
      by (simp add: field_simps)
    hence "{z. cnj_mix BC z - cnj_mix BC z1 = 0} = {z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = 0}"
      using \<open>cor k \<noteq> 0\<close>
      by auto
    ultimately
    have "cl = line z1 z2"
      using line_equation[of z1 z2 "BC/cor k"] \<open>cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}\<close>
      by auto
    thus ?thesis
      using \<open>z1 \<noteq> z2\<close>
      by blast
qed

lemma circline_ex_line:
  assumes "A = 0" and "BC \<noteq> 0" and "cl = circline A BC D"
  shows "\<exists> z1 z2. z1 \<noteq> z2 \<and> cl = line z1 z2"
proof-
  let ?z1 = "- cor D * BC / (2 * BC * cnj BC)"
  let ?z2 = "?z1 + \<i> * sgn (if 0 < arg BC then - BC else BC)"
  have "?z1 \<noteq> ?z2"
    using \<open>BC \<noteq> 0\<close>
    by (simp add: sgn_eq)
  thus ?thesis
    using circline_line[OF assms, of ?z1 ?z2] \<open>BC \<noteq> 0\<close>
    by (rule_tac x="?z1" in exI, rule_tac x="?z2" in exI, simp)
qed

text \<open>Every Euclidean line can be represented by a circline\<close>

lemma line_ex_circline:
  assumes "cl = line z1 z2" and "z1 \<noteq> z2"
  shows "\<exists> BC D. BC \<noteq> 0 \<and> cl = circline 0 BC D"
proof-
  let ?BC = "rot90 (z2 - z1)"
  let ?D = "Re (- 2 * scalprod z1 ?BC)"
  show ?thesis
  proof (rule_tac x="?BC" in exI, rule_tac x="?D" in exI, rule conjI)
    show "?BC \<noteq> 0"
      using \<open>z1 \<noteq> z2\<close> rot90_ii[of "z2 - z1"]
      by auto
  next
    have *: "complex_of_real (Re (- 2 * scalprod z1 (rot90 (z2 - z1)))) = - (cnj_mix z1 (rot90 (z2 - z1)))"
      using rot90_ii[of "z2 - z1"]
      by (cases z1, cases z2, simp add: Complex_eq field_simps)
    show "cl = circline 0 ?BC ?D"
      apply (subst assms, subst line_equation[of z1 z2 ?BC])
      unfolding circline_def
      by (fact, simp, subst *, simp add: field_simps)
  qed
qed

lemma circline_line':
  assumes "z1 \<noteq> z2"
  shows "circline 0 (\<i> * (z2 - z1)) (Re (- cnj_mix (\<i> * (z2 - z1)) z1)) = line z1 z2"
proof-
  let ?B = "\<i> * (z2 - z1)"
  let ?D = "Re (- cnj_mix ?B z1)"
  have "circline 0 ?B ?D = {z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0}"
    using assms
    by (simp add: circline_def)
  moreover
  have "is_real (- cnj_mix (\<i> * (z2 - z1)) z1)"
    using cnj_mix_real[of ?B z1]
    by auto
  hence "{z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0} =
         {z. cnj ?B*z + ?B*cnj z - (cnj ?B*z1 + ?B*cnj z1) = 0}"
    apply (subst complex_of_real_Re, simp)
    unfolding diff_conv_add_uminus
    by simp
  moreover
  have "line z1 z2 = {z. cnj_mix (\<i> * (z2 - z1)) z - cnj_mix (\<i> * (z2 - z1)) z1 = 0}"
    using line_equation[of z1 z2 ?B] assms
    unfolding rot90_ii
    by simp
  ultimately
  show ?thesis
    by simp
qed

(* ---------------------------------------------------------------------------- *)
subsection \<open>Angle between two circles\<close>
(* ---------------------------------------------------------------------------- *)

text \<open>Given a center $\mu$ of an Euclidean circle and a point $E$ on it, we define the tangent vector
in $E$ as the radius vector $\overrightarrow{\mu E}$, rotated by $\pi/2$, clockwise or
counterclockwise, depending on the circle orientation. The Boolean @{term p} encodes the orientation
of the circle, and the function @{term "sgn_bool p"} returns $1$ when @{term p} is true, and
$-1$ when @{term p} is false.\<close>

abbreviation sgn_bool where
  "sgn_bool p \<equiv> if p then 1 else -1"

definition circ_tang_vec :: "complex \<Rightarrow> complex \<Rightarrow> bool \<Rightarrow> complex" where
  "circ_tang_vec \<mu> E p = sgn_bool p * \<i> * (E - \<mu>)"

text \<open>Tangent vector is orthogonal to the radius.\<close>
lemma circ_tang_vec_ortho:
  shows "scalprod (E - \<mu>) (circ_tang_vec \<mu> E p) = 0"
  unfolding circ_tang_vec_def Let_def
  by auto

text \<open>Changing the circle orientation gives the opposite tangent vector.\<close>
lemma circ_tang_vec_opposite_orient:
  shows "circ_tang_vec \<mu> E p = - circ_tang_vec \<mu> E (\<not> p)"
  unfolding circ_tang_vec_def
  by auto

text \<open>Angle between two oriented circles at their common point $E$ is defined as the angle between
tangent vectors at $E$. Again we define three different angle measures.\<close>

text \<open>The oriented angle between two circles at the point $E$. The first circle is
centered at $\mu_1$ and its orientation is given by the Boolean $p_1$,
while the second circle is centered at $\mu_2$ and its orientation is given by
the Boolea $p_2$.\<close>
definition ang_circ where
  "ang_circ E \<mu>1 \<mu>2 p1 p2 = \<angle> (circ_tang_vec \<mu>1 E p1) (circ_tang_vec \<mu>2 E p2)"

text \<open>The unoriented angle between the two circles\<close>
definition ang_circ_c where
  "ang_circ_c E \<mu>1 \<mu>2 p1 p2 = \<angle>c (circ_tang_vec \<mu>1 E p1) (circ_tang_vec \<mu>2 E p2)"

text \<open>The acute angle between the two circles\<close>
definition ang_circ_a where
  "ang_circ_a E \<mu>1 \<mu>2 p1 p2 = \<angle>a (circ_tang_vec \<mu>1 E p1) (circ_tang_vec \<mu>2 E p2)"

text \<open>Explicit expression for oriented angle between two circles\<close>
lemma ang_circ_simp:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ E \<mu>1 \<mu>2 p1 p2 =
         \<downharpoonright>arg (E - \<mu>2) - arg (E - \<mu>1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2\<downharpoonleft>"
  unfolding ang_circ_def ang_vec_def circ_tang_vec_def
  apply (rule canon_ang_eq)
  using assms
  using arg_mult_2kpi[of "sgn_bool p2*\<i>" "E - \<mu>2"]
  using arg_mult_2kpi[of "sgn_bool p1*\<i>" "E - \<mu>1"]
  apply auto
     apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
    apply (rule_tac x="-1+x-xa" in exI, auto simp add: field_simps)
   apply (rule_tac x="1+x-xa" in exI, auto simp add: field_simps)
  apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
  done

text \<open>Explicit expression for the cosine of angle between two circles\<close>
lemma cos_ang_circ_simp:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "cos (ang_circ E \<mu>1 \<mu>2 p1 p2) =
         sgn_bool (p1 = p2) * cos (arg (E - \<mu>2) - arg (E - \<mu>1))"
  using assms
  using cos_periodic_pi2[of "arg (E - \<mu>2) - arg (E - \<mu>1)"]
  using cos_minus_pi[of "arg (E - \<mu>2) - arg (E - \<mu>1)"]
  using ang_circ_simp[OF assms, of p1 p2]
  by auto

text \<open>Explicit expression for the unoriented angle between two circles\<close>
lemma ang_circ_c_simp:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ_c E \<mu>1 \<mu>2 p1 p2 =
        \<bar>\<downharpoonright>arg (E - \<mu>2) - arg (E - \<mu>1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2\<downharpoonleft>\<bar>"
  unfolding ang_circ_c_def ang_vec_c_def
  using ang_circ_simp[OF assms]
  unfolding ang_circ_def
  by auto

text \<open>Explicit expression for the acute angle between two circles\<close>
lemma ang_circ_a_simp:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ_a E \<mu>1 \<mu>2 p1 p2 =
         acute_ang (abs (canon_ang (arg(E - \<mu>2) - arg(E - \<mu>1) + (sgn_bool p1) * pi/2 - (sgn_bool p2) * pi/2)))"
  unfolding ang_circ_a_def ang_vec_a_def
  using ang_circ_c_simp[OF assms]
  unfolding ang_circ_c_def
  by auto

text \<open>Acute angle between two circles does not depend on the circle orientation.\<close>
lemma ang_circ_a_pTrue:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ_a E \<mu>1 \<mu>2 p1 p2 = ang_circ_a E \<mu>1 \<mu>2 True True"
proof (cases "p1")
  case True
  show ?thesis
  proof (cases "p2")
    case True
    show ?thesis
      using \<open>p1\<close> \<open>p2\<close>
      by simp
  next
    case False
    show ?thesis
      using \<open>p1\<close> \<open>\<not> p2\<close>
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of \<mu>2 E p2]
      using ang_vec_a_opposite2
      by simp
  qed
next
  case False
  show ?thesis
  proof (cases "p2")
    case True
    show ?thesis
      using \<open>\<not> p1\<close> \<open>p2\<close>
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of \<mu>1 E p1]
      using ang_vec_a_opposite1
      by simp
  next
    case False
    show ?thesis
      using \<open>\<not> p1\<close> \<open>\<not> p2\<close>
      unfolding ang_circ_a_def
      using circ_tang_vec_opposite_orient[of \<mu>1 E p1] circ_tang_vec_opposite_orient[of \<mu>2 E p2]
      using ang_vec_a_opposite1  ang_vec_a_opposite2
      by simp
  qed
qed

text \<open>Definition of the acute angle between the two unoriented circles \<close>
abbreviation ang_circ_a' where
  "ang_circ_a' E \<mu>1 \<mu>2 \<equiv> ang_circ_a E \<mu>1 \<mu>2 True True"

text \<open>A very simple expression for the acute angle between the two circles\<close>
lemma ang_circ_a_simp1:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ_a E \<mu>1 \<mu>2 p1 p2 = \<angle>a (E - \<mu>1) (E - \<mu>2)"
  unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
  by (subst ang_circ_a_pTrue[OF assms, of p1 p2], subst ang_circ_a_simp[OF assms, of True True]) (metis add_diff_cancel)

lemma ang_circ_a'_simp:
  assumes "E \<noteq> \<mu>1" and "E \<noteq> \<mu>2"
  shows "ang_circ_a' E \<mu>1 \<mu>2 = \<angle>a (E - \<mu>1) (E - \<mu>2)"
  by (rule ang_circ_a_simp1[OF assms])

end


section\<open>Background material for the graph-theoretic aspects of the main proof\<close>
text \<open>This section includes a number of lemmas on project specific definitions for graph theory,
building on the general undirected graph theory library \cite{Undirected_Graph_Theory-AFP} \<close>

(*
  Session: Balog_Szemeredi_Gowers
  Title:   Graph_Theory_Preliminaries.thy
  Authors: Angeliki Koutsoukou-Argyraki, Mantas Bakšys, and Chelsea Edmonds
  Affiliation: University of Cambridge
  Date: August 2022.
*)

theory Graph_Theory_Preliminaries
  imports
    Miscellaneous_Lemmas
    Undirected_Graph_Theory.Bipartite_Graphs
    Undirected_Graph_Theory.Connectivity
    Random_Graph_Subgraph_Threshold.Ugraph_Misc
begin

subsection\<open>On graphs with loops\<close>

context ulgraph

begin

definition degree_normalized:: "'a \<Rightarrow> 'a set \<Rightarrow> real" where
  "degree_normalized v S \<equiv> card (neighbors_ss v S) / (card S)"

lemma degree_normalized_le_1: "degree_normalized x S \<le> 1"

proof(cases "finite S")
  assume hA: "finite S"
  then have "card (neighbors_ss x S) \<le> card S" using neighbors_ss_def card_mono hA
    by fastforce
  then show ?thesis using degree_normalized_def divide_le_eq_1
    by (metis antisym_conv3 of_nat_le_iff of_nat_less_0_iff)
next
  case False
  then show ?thesis using degree_normalized_def by auto
qed

end

subsection\<open>On bipartite graphs \<close>

context bipartite_graph
begin

(* codegree counts the number of paths between two vertices, including loops *)
definition codegree:: "'a \<Rightarrow> 'a \<Rightarrow> nat" where
  "codegree v u \<equiv> card {x \<in> V . vert_adj v x \<and> vert_adj u x}"

lemma codegree_neighbors: "codegree v u = card (neighborhood v \<inter> neighborhood u)"
  unfolding codegree_def neighborhood_def

proof -
  have "{x \<in> V. vert_adj v x \<and> vert_adj u x} = {va \<in> V. vert_adj v va} \<inter> {v \<in> V. vert_adj u v}"
    by blast
  thus "card {x \<in> V. vert_adj v x \<and> vert_adj u x} = card ({va \<in> V. vert_adj v va} \<inter> {v \<in> V. vert_adj u v})"
    by auto
qed

lemma codegree_sym: "codegree v u = codegree u v"
  by (simp add: Int_commute codegree_neighbors)

definition codegree_normalized:: "'a \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> real" where
  "codegree_normalized v u S \<equiv> codegree v u / card S"

lemma codegree_normalized_altX:
  assumes "x \<in> X" and "x' \<in> X"
  shows "codegree_normalized x x' Y = card (neighbors_ss x Y \<inter> neighbors_ss x' Y) / card Y"

proof -
  have "((neighbors_ss x Y) \<inter> (neighbors_ss x' Y)) = neighborhood x \<inter> neighborhood x'"
    using neighbors_ss_eq_neighborhoodX assms by auto
  then show ?thesis unfolding codegree_normalized_def
    using codegree_def codegree_neighbors by presburger
qed

lemma codegree_normalized_altY:
  assumes "y \<in> Y" and "y' \<in> Y"
  shows "codegree_normalized y y' X = card (neighbors_ss y X \<inter> neighbors_ss y' X) / card X"

proof -
  have "neighbors_ss y X \<inter> neighbors_ss y' X = neighborhood y \<inter> neighborhood y'"
    using neighbors_ss_eq_neighborhoodY assms by auto
  then show ?thesis unfolding codegree_normalized_def
    using codegree_def codegree_neighbors by presburger
qed

lemma codegree_normalized_sym: "codegree_normalized u v S = codegree_normalized v u S"
  unfolding codegree_normalized_def using codegree_sym by simp

definition bad_pair:: " 'a \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow> bool" where
  "bad_pair v u S c \<equiv> codegree_normalized v u S < c"

lemma bad_pair_sym:
  assumes "bad_pair v u S c" shows "bad_pair u v S c"
  using assms bad_pair_def codegree_normalized_def
  by (simp add: codegree_normalized_sym)

definition bad_pair_set:: "'a set \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow> ('a \<times> 'a) set" where
  "bad_pair_set S T c  \<equiv> {(u, v) \<in> S \<times> S. bad_pair u v T c}"

lemma bad_pair_set_ss: "bad_pair_set S T c \<subseteq> S \<times> S"
  by (auto simp add: bad_pair_set_def)

lemma bad_pair_set_filter_alt:
  "bad_pair_set S T c = Set.filter (\<lambda> p . bad_pair (fst p) (snd p) T c) (S \<times> S)"
  using bad_pair_set_def by auto

lemma bad_pair_set_finite:
  assumes "finite S"
  shows "finite (bad_pair_set S T c)"
proof -
  have "finite (S \<times> S)" using finite_cartesian_product assms by blast
  thus ?thesis using bad_pair_set_filter_alt finite_filter by auto
qed

lemma codegree_is_path_length_two:
  "codegree x x' = card {p . connecting_path x x' p \<and> walk_length p = 2}"
  unfolding codegree_def
proof-
  define f:: "'a list \<Rightarrow> 'a" where "f = (\<lambda> p. p!1)"
  have f_inj: "inj_on f {p . connecting_path x x' p \<and> walk_length p = 2}"
    unfolding f_def
  proof (intro inj_onI, simp del: One_nat_def)
    fix a b assume ha: "connecting_path x x' a \<and> walk_length a = 2" and
      hb: "connecting_path x x' b \<and> walk_length b = 2" and 1: "a!1 = b!1"
    then have len: "length a = 3" "length b = 3" using walk_length_conv by auto
    show "a = b" using list2_middle_singleton 1 len list_middle_eq ha hb connecting_path_def len by metis
  qed
  have f_image: "f ` {p . connecting_path x x' p \<and> walk_length p = 2} =
    {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
  proof(intro subset_antisym)
    show "f ` {p. connecting_path x x' p \<and> walk_length p = 2}
    \<subseteq> {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
    proof (intro subsetI)
      fix a assume "a \<in> f ` {p. connecting_path x x' p \<and> walk_length p = 2}"
      then obtain p where ha: "p!1 = a" and hp: "connecting_path x x' p" and hpl: "length p = 3"
        using f_def walk_length_conv by auto
      have "p ! 0 = x" using hd_conv_nth[of p] hpl hp connecting_path_def by fastforce
      then have va1: "vert_adj x a" using is_walk_index[of 0 p] hp connecting_path_def is_gen_path_def
          vert_adj_def ha hpl by auto
      have "p ! 2 = x'" using last_conv_nth[of p] hpl hp connecting_path_def by fastforce
      then have "vert_adj a x'" using is_walk_index[of 1 p] hp connecting_path_def is_gen_path_def
          vert_adj_def ha hpl by (metis One_nat_def le0 lessI numeral_3_eq_3 one_add_one)
      then show "a \<in> {a \<in> V. vert_adj x a \<and> vert_adj x' a}"
        using va1 vert_adj_sym by (simp add: vert_adj_imp_inV)
    qed
    show "{xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}
      \<subseteq> f ` {p. connecting_path x x' p \<and> walk_length p = 2}"
    proof (intro subsetI)
      fix a assume ha: "a \<in> {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa}"
      then have "a \<in> V" and "x \<in> V" and "x' \<in> V" and "vert_adj x a" and "vert_adj x' a"
        using vert_adj_imp_inV by auto
      then have "is_gen_path [x, a, x']"
        using is_walk_def vert_adj_def vert_adj_sym ha singleton_not_edge is_gen_path_def by auto (* Slow *)
      then have "connecting_path x x' [x, a, x']"
        unfolding connecting_path_def vert_adj_def hd_conv_nth last_conv_nth by simp
      moreover have "walk_length [x, a, x'] = 2" using walk_length_conv by simp
      ultimately show "a \<in> f ` {p. connecting_path x x' p \<and> walk_length p = 2}" using f_def by force
    qed
  qed
  then show "card {xa \<in> V. vert_adj x xa \<and> vert_adj x' xa} =
    card {p. connecting_path x x' p \<and> walk_length p = 2}"
    using f_inj card_image by fastforce
qed

lemma codegree_bipartite_eq:
  "\<forall> x \<in> X. \<forall> x' \<in> X. codegree x x' = card {y \<in> Y. vert_adj x y \<and> vert_adj x' y}"
  unfolding codegree_def using vert_adj_imp_inV X_vert_adj_Y
  by (metis (no_types, lifting) Collect_cong)

lemma (in fin_bipartite_graph) bipartite_deg_square_eq:
  "\<forall> y \<in> Y. (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y) = (degree y)^2"
proof
  have hX: "finite X" by (simp add: partitions_finite(1))
  fix y assume hy: "y \<in> Y"
  have 1: "\<forall> x' \<in> X. \<forall> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y =
    indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y"
    by (metis (mono_tags, lifting) Int_Collect indicator_simps(1) indicator_simps(2) mem_Collect_eq)
  have 2: "\<forall> x' \<in> X. \<forall> x \<in> X. (indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y:: nat) =
    indicator {z. vert_adj x' z} y * indicator {z. vert_adj x z} y" using indicator_inter_arith
    by auto
  have "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (indicator {z. vert_adj x z \<and> vert_adj x' z} y:: nat)) =
    (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator ({z. vert_adj x' z} \<inter> {z. vert_adj x z}) y)"
    using 1 sum.cong by (metis (no_types, lifting))
  also have "... = (\<Sum> x' \<in> X. \<Sum> x \<in> X. indicator {z. vert_adj x' z} y *
    indicator {z. vert_adj x z} y)" using 2 sum.cong by auto
  also have "... = sum (\<lambda> x. indicator {z. vert_adj x z} y) X * sum (\<lambda> x. indicator {z. vert_adj x z} y) X"
    using sum_product[of "(\<lambda> x. (indicator {z. vert_adj x z} y:: nat))" "X"
      "(\<lambda> x. indicator {z. vert_adj x z} y)" "X"] by auto
  finally have 3: "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (indicator {z. vert_adj x z \<and> vert_adj x' z} y:: nat)) =
    (sum (\<lambda> x. indicator {z. vert_adj x z} y) X) ^ 2" using power2_eq_square
    by (metis (no_types, lifting))
  have "\<forall> x \<in> X. indicator {z. vert_adj x z} y = indicator {x. vert_adj x y} x"
    by (simp add: indicator_def)
  from this have "(sum (\<lambda> x. indicator {z. vert_adj x z} y) X) = sum (\<lambda> x. indicator {x. vert_adj x y} x) X"
    using sum.cong by fastforce
  also have "... = card ({x \<in> X. vert_adj x y})" using sum_indicator_eq_card hX
    by (metis Collect_conj_eq Collect_mem_eq)
  finally show "(\<Sum>x'\<in>X. \<Sum>x\<in>X. indicator {z. vert_adj x z \<and> vert_adj x' z} y) = (degree y)^2"
    using 3 hy degree_neighbors_ssY neighbors_ss_def vert_adj_sym by presburger
qed

lemma (in fin_bipartite_graph) codegree_degree:
  "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (codegree x x')) = (\<Sum> y \<in> Y. (degree y)^2)"

proof-
  have hX: "finite X" and hY: "finite Y"
    by (simp_all add: partitions_finite)
  have "\<forall> x' \<in> X. \<forall> x \<in> X. {z \<in> V. vert_adj x z \<and> vert_adj x' z} = Y \<inter> {z. vert_adj x z \<and> vert_adj x' z}"
    using XY_union X_vert_adj_Y by fastforce
  from this have "(\<Sum> x' \<in> X. \<Sum> x \<in> X. (codegree x x')) = (\<Sum> x' \<in> X. \<Sum> x \<in> X. card (Y \<inter> {z. vert_adj x z \<and> vert_adj x' z}))"
    using codegree_def sum.cong by auto
  also have "... = (\<Sum> x' \<in> X. \<Sum> x \<in> X. \<Sum> y \<in> Y. indicator {z. vert_adj x z \<and> vert_adj x' z} y)"
    using sum_indicator_eq_card hY by fastforce
  also have "... =  (\<Sum> x' \<in> X. \<Sum> y \<in> Y. (\<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y))"
    using sum.swap by (metis (no_types))
  also have "... = (\<Sum> y \<in> Y. \<Sum> x' \<in> X. (\<Sum> x \<in> X. indicator {z. vert_adj x z \<and> vert_adj x' z} y))"
    using sum.swap by fastforce
  also have "... = (\<Sum> y \<in> Y. (degree y)^2)" using bipartite_deg_square_eq sum.cong by force
  finally show ?thesis by simp
qed

lemma (in fin_bipartite_graph) sum_degree_normalized_X_density:
  "(\<Sum> x \<in> X. degree_normalized x Y) / card X = edge_density X Y"
  by (smt (z3) card_all_edges_betw_neighbor card_edges_between_set degree_normalized_def
    divide_divide_eq_left' density_simp of_nat_mult of_nat_sum partitions_finite(1)
    partitions_finite(2) sum.cong sum_left_div_distrib)

lemma (in fin_bipartite_graph) sum_degree_normalized_Y_density:
  "(\<Sum> y \<in> Y. degree_normalized y X) / card Y = edge_density X Y"
  using bipartite_sym fin_bipartite_graph.sum_degree_normalized_X_density fin_bipartite_graph_def
    fin_graph_system_axioms edge_density_commute by fastforce

end
end


(*  Title:      HOL/UNITY/Comp/PriorityAux.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    Copyright   2001  University of Cambridge

Auxiliary definitions needed in Priority.thy
*)

theory PriorityAux
imports "../UNITY_Main"
begin

typedecl vertex

definition symcl :: "(vertex*vertex)set=>(vertex*vertex)set" where
  "symcl r == r \<union> (r^-1)"
    --{* symmetric closure: removes the orientation of a relation*}

definition neighbors :: "[vertex, (vertex*vertex)set]=>vertex set" where
  "neighbors i r == ((r \<union> r^-1)``{i}) - {i}"
    --{* Neighbors of a vertex i *}

definition R :: "[vertex, (vertex*vertex)set]=>vertex set" where
  "R i r == r``{i}"

definition A :: "[vertex, (vertex*vertex)set]=>vertex set" where
  "A i r == (r^-1)``{i}"

definition reach :: "[vertex, (vertex*vertex)set]=> vertex set" where
  "reach i r == (r^+)``{i}"
    --{* reachable and above vertices: the original notation was R* and A* *}

definition above :: "[vertex, (vertex*vertex)set]=> vertex set" where
  "above i r == ((r^-1)^+)``{i}"

definition reverse :: "[vertex, (vertex*vertex) set]=>(vertex*vertex)set" where
  "reverse i r == (r - {(x,y). x=i | y=i} \<inter> r) \<union> ({(x,y). x=i|y=i} \<inter> r)^-1"

definition derive1 :: "[vertex, (vertex*vertex)set, (vertex*vertex)set]=>bool" where
    --{* The original definition *}
  "derive1 i r q == symcl r = symcl q &
                    (\<forall>k k'. k\<noteq>i & k'\<noteq>i -->((k,k'):r) = ((k,k'):q)) &
                    A i r = {} & R i q = {}"

definition derive :: "[vertex, (vertex*vertex)set, (vertex*vertex)set]=>bool" where
    --{* Our alternative definition *}
  "derive i r q == A i r = {} & (q = reverse i r)"

axiomatization where
  finite_vertex_univ:  "finite (UNIV :: vertex set)"
    --{* we assume that the universe of vertices is finite  *}

declare derive_def [simp] derive1_def [simp] symcl_def [simp]
        A_def [simp] R_def [simp]
        above_def [simp] reach_def [simp]
        reverse_def [simp] neighbors_def [simp]

text{*All vertex sets are finite*}
declare finite_subset [OF subset_UNIV finite_vertex_univ, iff]

text{* and relatons over vertex are finite too *}

lemmas finite_UNIV_Prod =
       finite_Prod_UNIV [OF finite_vertex_univ finite_vertex_univ]

declare finite_subset [OF subset_UNIV finite_UNIV_Prod, iff]

(* The equalities (above i r = {}) = (A i r = {})
   and (reach i r = {}) = (R i r) rely on the following theorem  *)

lemma image0_trancl_iff_image0_r: "((r^+)``{i} = {}) = (r``{i} = {})"
apply auto
apply (erule trancl_induct, auto)
done

(* Another form usefull in some situation *)
lemma image0_r_iff_image0_trancl: "(r``{i}={}) = (ALL x. ((i,x):r^+) = False)"
apply auto
apply (drule image0_trancl_iff_image0_r [THEN ssubst], auto)
done

(* In finite universe acyclic coincides with wf *)
lemma acyclic_eq_wf: "!!r::(vertex*vertex)set. acyclic r = wf r"
by (auto simp add: wf_iff_acyclic_if_finite)

(* derive and derive1 are equivalent *)
lemma derive_derive1_eq: "derive i r q = derive1 i r q"
by auto

(* Lemma 1 *)
lemma lemma1_a:
     "[| x \<in> reach i q; derive1 k r q |] ==> x\<noteq>k --> x \<in> reach i r"
apply (unfold reach_def)
apply (erule ImageE)
apply (erule trancl_induct)
 apply (cases "i=k", simp_all)
 apply (blast, blast, clarify)
apply (drule_tac x = y in spec)
apply (drule_tac x = z in spec)
apply (blast dest: r_into_trancl intro: trancl_trans)
done

lemma reach_lemma: "derive k r q ==> reach i q \<subseteq> (reach i r \<union> {k})"
apply clarify
apply (drule lemma1_a)
apply (auto simp add: derive_derive1_eq
            simp del: reach_def derive_def derive1_def)
done

(* An other possible formulation of the above theorem based on
   the equivalence x \<in> reach y r = y \<in> above x r                  *)
lemma reach_above_lemma:
      "(\<forall>i. reach i q \<subseteq> (reach i r \<union> {k})) =
       (\<forall>x. x\<noteq>k --> (\<forall>i. i \<notin> above x r --> i \<notin> above x q))"
by (auto simp add: trancl_converse)

(* Lemma 2 *)
lemma maximal_converse_image0:
     "(z, i):r^+ ==> (\<forall>y. (y, z):r --> (y,i) \<notin> r^+) = ((r^-1)``{z}={})"
apply auto
apply (frule_tac r = r in trancl_into_trancl2, auto)
done

lemma above_lemma_a:
     "acyclic r ==> A i r\<noteq>{}-->(\<exists>j \<in> above i r. A j r = {})"
apply (simp add: acyclic_eq_wf wf_eq_minimal)
apply (drule_tac x = " ((r^-1) ^+) ``{i}" in spec)
apply auto
apply (simp add: maximal_converse_image0 trancl_converse)
done

lemma above_lemma_b:
     "acyclic r ==> above i r\<noteq>{}-->(\<exists>j \<in> above i r. above j r = {})"
apply (drule above_lemma_a)
apply (auto simp add: image0_trancl_iff_image0_r)
done

end


theory Exercise10
  imports Main
begin

datatype tree0 = Tip | Node "tree0" "tree0"

fun nodes :: "tree0 => nat" where
  "nodes Tip = 1"
  | "nodes (Node l r) = 1 + (nodes l) + (nodes r)"

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
  "explode 0 t = t"
  | "explode (Suc n) t = explode n (Node t t)"

fun nodes_explode_calc :: "nat \<Rightarrow> tree0 \<Rightarrow> nat" where
  "nodes_explode_calc n t = ((nodes t) * (2 ^ n)) + (2^n - 1)"

(*
lemma nodes_suc_explode [simp]: "nodes (explode (Suc n) t) = 1 + (2 * (nodes (explode n t)))"
  apply (induction n arbitrary: t)
  apply (simp add: algebra_simps)
  apply (simp add: algebra_simps)
done

lemma nodes_explode_algebra_manip_lhs [simp]: "1 + (2 * (n + ((Suc n) * ((2^m) - 1)))) = (n * (2 ^ (Suc m))) + (2 ^ (Suc m)) - 1"
  apply (induction m)
  apply (auto simp add: algebra_simps)
done

lemma nodes_explode_algebra_manip_rhs [simp]: "(n * (2 ^ (Suc m))) + (2 ^ (Suc m)) - 1 = n + ((Suc n) * (2 ^ (Suc m) - 1))"
  apply (induction m)
  apply (auto simp add: algebra_simps)
done

lemma nodes_explode_algebra_manip [simp]: "1 + (2 * (n + ((Suc n) * ((2^m) -1)))) = n + ((Suc n) * (2^(Suc m) - 1))"
  apply (induction m arbitrary: n)
  apply (simp add: algebra_simps)
  unfolding nodes_explode_algebra_manip_lhs
  unfolding nodes_explode_algebra_manip_rhs
by (rule HOL.refl)

theorem explosion_size: "nodes (explode n t) = (nodes t) + (((nodes t) + 1) * ((2 ^ n) - 1))"
  apply (induction n arbitrary: t)
  apply (simp add: algebra_simps)
done
*)

theorem explosion_size: "nodes (explode n t) = nodes_explode_calc n t"
  apply (induction n arbitrary: t)
  apply (auto simp add: algebra_simps)
done

end