(* -------------------------------------------------------------------------- *)
section \<open>Oriented circlines\<close>
(* -------------------------------------------------------------------------- *)
theory Oriented_Circlines
imports Circlines
begin

(* ----------------------------------------------------------------- *)
subsection \<open>Oriented circlines definition\<close>
(* ----------------------------------------------------------------- *)

text \<open>In this section we describe how the orientation is introduced for the circlines. Similarly as
the set of circline points, the set of disc points is introduced using the quadratic form induced by
the circline matrix --- the set of points of the circline disc is the set of points such that
satisfy that $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D < 0$, where
$(A, B, C, D)$ is a circline matrix representative Hermitean matrix. As the
set of disc points must be invariant to the choice of representative, it is clear that oriented
circlines matrices are equivalent only if they are proportional by a positive real factor (recall
that unoriented circline allowed arbitrary non-zero real factors).\<close>

definition ocircline_eq_cmat :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> bool" where
  [simp]: "ocircline_eq_cmat A B \<longleftrightarrow>(\<exists> k::real. k > 0 \<and> B = cor k *\<^sub>s\<^sub>m A)"
lift_definition ocircline_eq_clmat :: "circline_mat \<Rightarrow> circline_mat \<Rightarrow> bool" is ocircline_eq_cmat
  done

lemma ocircline_eq_cmat_id [simp]:
  shows "ocircline_eq_cmat H H"
  by (simp, rule_tac x=1 in exI, simp)

quotient_type ocircline = circline_mat / ocircline_eq_clmat
proof (rule equivpI)
  show "reflp ocircline_eq_clmat"
    unfolding reflp_def
    by transfer (auto, rule_tac x="1" in exI, simp)
next
  show "symp ocircline_eq_clmat"
    unfolding symp_def
    by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="1/k" in exI, simp)
next
  show "transp ocircline_eq_clmat"
    unfolding transp_def
    by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="k*ka" in exI, simp)
qed

(* ----------------------------------------------------------------- *)
subsection \<open>Points on oriented circlines\<close>
(* ----------------------------------------------------------------- *)

text \<open>Boundary of the circline.\<close>

lift_definition on_ocircline :: "ocircline \<Rightarrow> complex_homo \<Rightarrow> bool" is on_circline_clmat_hcoords
  by transfer (simp del: quad_form_def, (erule exE)+, simp add: quad_form_scale_m quad_form_scale_v del: quad_form_def)

definition ocircline_set :: "ocircline \<Rightarrow> complex_homo set" where
  "ocircline_set H = {z. on_ocircline H z}"

lemma ocircline_set_I [simp]:
  assumes "on_ocircline H z"
  shows "z \<in> ocircline_set H"
  using assms
  unfolding ocircline_set_def
  by simp

(* ----------------------------------------------------------------- *)
subsection \<open>Disc and disc complement - in and out points\<close>
(* ----------------------------------------------------------------- *)

text \<open>Interior and the exterior of an oriented circline.\<close>

definition in_ocircline_cmat_cvec :: "complex_mat \<Rightarrow> complex_vec \<Rightarrow> bool" where
  [simp]: "in_ocircline_cmat_cvec H z \<longleftrightarrow> Re (quad_form z H) < 0"
lift_definition in_ocircline_clmat_hcoords :: "circline_mat \<Rightarrow> complex_homo_coords \<Rightarrow> bool" is in_ocircline_cmat_cvec
  done
lift_definition in_ocircline :: "ocircline \<Rightarrow> complex_homo \<Rightarrow> bool" is in_ocircline_clmat_hcoords
proof transfer
  fix H H' z z'
  assume hh: "hermitean H \<and> H \<noteq> mat_zero" and "hermitean H' \<and> H' \<noteq> mat_zero" and
             "z \<noteq> vec_zero" and "z' \<noteq> vec_zero"
  assume "ocircline_eq_cmat H H'" and "z \<approx>\<^sub>v z'"
  then obtain k k' where
    *: "0 < k" "H' = cor k *\<^sub>s\<^sub>m H" "k' \<noteq> 0" "z' = k' *\<^sub>s\<^sub>v  z"
    by auto
  hence "quad_form z' H' = cor k * cor ((cmod k')\<^sup>2) * quad_form z H"
    by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
  hence "Re (quad_form z' H') = k * (cmod k')\<^sup>2 * Re (quad_form z H)"
    using hh quad_form_hermitean_real[of H]
    by (simp add: power2_eq_square)
  thus "in_ocircline_cmat_cvec H z = in_ocircline_cmat_cvec H' z'"
    using \<open>k > 0\<close> \<open>k' \<noteq> 0\<close>
    using mult_less_0_iff
    by fastforce
qed

definition disc :: "ocircline \<Rightarrow> complex_homo set" where
  "disc H = {z. in_ocircline H z}"

lemma disc_I [simp]:
  assumes "in_ocircline H z"
  shows "z \<in> disc H"
  using assms
  unfolding disc_def
  by simp

definition out_ocircline_cmat_cvec :: "complex_mat \<Rightarrow> complex_vec \<Rightarrow> bool" where
  [simp]: "out_ocircline_cmat_cvec H z \<longleftrightarrow> Re (quad_form z H) > 0"
lift_definition out_ocircline_clmat_hcoords :: "circline_mat \<Rightarrow> complex_homo_coords \<Rightarrow> bool" is out_ocircline_cmat_cvec
  done
lift_definition out_ocircline :: "ocircline \<Rightarrow> complex_homo \<Rightarrow> bool" is out_ocircline_clmat_hcoords
proof transfer
  fix H H' z z'
  assume hh: "hermitean H \<and> H \<noteq> mat_zero" "hermitean H' \<and> H' \<noteq> mat_zero"
             "z \<noteq> vec_zero" "z' \<noteq> vec_zero"
  assume "ocircline_eq_cmat H H'" "z \<approx>\<^sub>v z'"
  then obtain k k' where
    *: "0 < k" "H' = cor k *\<^sub>s\<^sub>m H" "k' \<noteq> 0" "z' = k' *\<^sub>s\<^sub>v  z"
    by auto
  hence "quad_form z' H' = cor k * cor ((cmod k')\<^sup>2) * quad_form z H"
    by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
  hence "Re (quad_form z' H') = k * (cmod k')\<^sup>2 * Re (quad_form z H)"
    using hh quad_form_hermitean_real[of H]
    by (simp add: power2_eq_square)
  thus "out_ocircline_cmat_cvec H z = out_ocircline_cmat_cvec H' z'"
    using \<open>k > 0\<close> \<open>k' \<noteq> 0\<close>
    using zero_less_mult_pos
    by fastforce
qed

definition disc_compl :: "ocircline \<Rightarrow> complex_homo set" where
  "disc_compl H = {z. out_ocircline H z}"

text \<open>These three sets are mutually disjoint and they fill up the entire plane.\<close>

lemma disc_compl_I [simp]:
  assumes "out_ocircline H z"
  shows "z \<in> disc_compl H"
  using assms
  unfolding disc_compl_def
  by simp

lemma in_on_out:
  shows "in_ocircline H z \<or> on_ocircline H z \<or> out_ocircline H z"
  apply (transfer, transfer)
  using quad_form_hermitean_real
  using complex_eq_if_Re_eq
  by auto

lemma in_on_out_univ:
  shows "disc H \<union> disc_compl H \<union> ocircline_set H = UNIV"
  unfolding disc_def disc_compl_def ocircline_set_def
  using in_on_out[of H]
  by auto

lemma disc_inter_disc_compl [simp]:
  shows "disc H \<inter> disc_compl H = {}"
  unfolding disc_def disc_compl_def
  by auto (transfer, transfer, simp)

lemma disc_inter_ocircline_set [simp]:
  shows "disc H \<inter> ocircline_set H = {}"
  unfolding disc_def ocircline_set_def
  by auto (transfer, transfer, simp)

lemma disc_compl_inter_ocircline_set [simp]:
  shows "disc_compl H \<inter> ocircline_set H = {}"
  unfolding disc_compl_def ocircline_set_def
  by auto (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection \<open>Opposite orientation\<close>
(* ----------------------------------------------------------------- *)

text \<open>Finding opposite circline is idempotent, and opposite circlines share the same set of points,
but exchange disc and its complement.\<close>

definition opposite_ocircline_cmat :: "complex_mat \<Rightarrow> complex_mat" where
  [simp]: "opposite_ocircline_cmat H = (-1) *\<^sub>s\<^sub>m H"
lift_definition opposite_ocircline_clmat :: "circline_mat \<Rightarrow> circline_mat" is opposite_ocircline_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition opposite_ocircline :: "ocircline \<Rightarrow> ocircline" is opposite_ocircline_clmat
  by transfer auto

lemma opposite_ocircline_involution [simp]:
  shows "opposite_ocircline (opposite_ocircline H) = H"
  by (transfer, transfer) (auto, rule_tac x="1" in exI, simp)

lemma on_circline_opposite_ocircline_cmat [simp]:
  assumes "hermitean H \<and> H \<noteq> mat_zero" and "z \<noteq> vec_zero"
  shows "on_circline_cmat_cvec (opposite_ocircline_cmat H) z = on_circline_cmat_cvec H z"
  using assms
  by (simp add: quad_form_scale_m del: quad_form_def)

lemma on_circline_opposite_ocircline [simp]:
  shows "on_ocircline (opposite_ocircline H) z \<longleftrightarrow> on_ocircline H z"
  using on_circline_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma ocircline_set_opposite_ocircline [simp]:
  shows "ocircline_set (opposite_ocircline H) = ocircline_set H"
  unfolding ocircline_set_def
  by auto

lemma disc_compl_opposite_ocircline [simp]:
  shows "disc_compl (opposite_ocircline H) = disc H"
  unfolding disc_def disc_compl_def
  apply auto
   apply (transfer, transfer)
   apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
  apply (transfer ,transfer)
  apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
  done

lemma disc_opposite_ocircline [simp]:
  shows "disc (opposite_ocircline H) = disc_compl H"
  using disc_compl_opposite_ocircline[of "opposite_ocircline H"]
  by simp

(* ----------------------------------------------------------------- *)
subsection \<open>Positive orientation. Conversion between unoriented and oriented circlines\<close>
(* ----------------------------------------------------------------- *)

text \<open>Given an oriented circline, one can trivially obtain its unoriented counterpart, and these two
share the same set of points.\<close>

lift_definition of_ocircline :: "ocircline \<Rightarrow> circline" is "id::circline_mat \<Rightarrow> circline_mat"
  by transfer (simp, erule exE, force)

lemma of_ocircline_opposite_ocircline [simp]:
  shows "of_ocircline (opposite_ocircline H) = of_ocircline H"
  by (transfer, transfer) (simp, erule exE, rule_tac x="-1" in exI, simp)

lemma on_ocircline_of_circline [simp]:
  shows "on_circline (of_ocircline H) z \<longleftrightarrow> on_ocircline H z"
  by (transfer, transfer, simp)

lemma circline_set_of_ocircline [simp]:
  shows "circline_set (of_ocircline H) = ocircline_set H"
  unfolding ocircline_set_def circline_set_def
  by (safe) (transfer, simp)+

lemma inj_of_ocircline:
  assumes "of_ocircline H = of_ocircline H'"
  shows "H = H' \<or> H = opposite_ocircline H'"
  using assms
  by (transfer, transfer) (simp, metis linorder_neqE_linordered_idom minus_of_real_eq_of_real_iff mult_minus1 mult_sm_distribution neg_0_equal_iff_equal neg_less_0_iff_less)

lemma inj_ocircline_set:
  assumes "ocircline_set H = ocircline_set H'" and "ocircline_set H \<noteq> {}"
  shows "H = H' \<or> H = opposite_ocircline H'"
proof-
  from assms
  have "circline_set (of_ocircline H) = circline_set (of_ocircline H')"
       "circline_set (of_ocircline H') \<noteq> {}"
    by auto
  hence "of_ocircline H = of_ocircline H'"
    by (simp add: inj_circline_set)
  thus ?thesis
    by (rule inj_of_ocircline)
qed

text \<open>Positive orientation.\<close>

text \<open>Given a representative Hermitean matrix of a circline, it represents exactly one of the two
possible oriented circlines. The choice of what should be called a positive orientation is
arbitrary. We follow Schwerdtfeger \cite{schwerdtfeger}, use the leading coefficient $A$ as the
first criterion, and say that circline matrices with $A > 0$ are called positively oriented, and
with $A < 0$ negatively oriented. However, Schwerdtfeger did not discuss the possible case of $A =
0$ (the case of lines), so we had to extend his definition to achieve a total characterization.\<close>

definition pos_oriented_cmat :: "complex_mat \<Rightarrow> bool" where
  [simp]: "pos_oriented_cmat H \<longleftrightarrow>
           (let (A, B, C, D) = H
              in (Re A > 0 \<or> (Re A = 0 \<and> ((B \<noteq> 0 \<and> arg B > 0) \<or> (B = 0 \<and> Re D > 0)))))"
lift_definition pos_oriented_clmat :: "circline_mat \<Rightarrow> bool" is pos_oriented_cmat
  done

lift_definition pos_oriented :: "ocircline \<Rightarrow> bool" is pos_oriented_clmat
  by transfer
     (case_tac circline_mat1, case_tac circline_mat2, simp, erule exE, simp,
      metis mult_pos_pos zero_less_mult_pos)

lemma pos_oriented:
  shows "pos_oriented H \<or> pos_oriented (opposite_ocircline H)"
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H \<and> H \<noteq> mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  moreover
  hence "Re A = 0 \<and> Re D = 0 \<longrightarrow> B \<noteq> 0"
    using hh hermitean_elems[of A B C D]
    by (cases A, cases D) (auto simp add: Complex_eq)
  moreover
  have "B \<noteq> 0 \<and> \<not> 0 < arg B \<longrightarrow> 0 < arg (- B)"
    using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B]
    by (auto simp add: arg_uminus)
  ultimately
  show "pos_oriented_cmat H \<or> pos_oriented_cmat (opposite_ocircline_cmat H)"
    by auto
qed

lemma pos_oriented_opposite_ocircline [simp]:
  shows "pos_oriented (opposite_ocircline H) \<longleftrightarrow> \<not> pos_oriented H"
  using pos_oriented_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma pos_oriented_circle_inf:
  assumes "\<infinity>\<^sub>h \<notin> ocircline_set H"
  shows "pos_oriented H \<longleftrightarrow> \<infinity>\<^sub>h \<notin> disc H"
  using assms
  unfolding ocircline_set_def disc_def
  apply simp
proof (transfer, transfer)
  fix H
  assume hh: "hermitean H \<and> H \<noteq> mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence "is_real A"
    using hh hermitean_elems
    by auto
  assume "\<not> on_circline_cmat_cvec H \<infinity>\<^sub>v"
  thus "pos_oriented_cmat H = (\<not> in_ocircline_cmat_cvec H  \<infinity>\<^sub>v)"
    using HH \<open>is_real A\<close>
    by (cases A) (auto simp add: vec_cnj_def Complex_eq)
qed

lemma pos_oriented_euclidean_circle:
  assumes "is_circle (of_ocircline H)"
          "(a, r) = euclidean_circle (of_ocircline H)"
          "circline_type (of_ocircline H) < 0"
  shows "pos_oriented H \<longleftrightarrow> of_complex a \<in> disc H"
  using assms
  unfolding disc_def
  apply simp
proof (transfer, transfer)
  fix H a r
  assume hh: "hermitean H \<and> H \<noteq> mat_zero"
  obtain A B C D where HH: "H = (A, B, C, D)"
    by (cases H) auto
  hence "is_real A" "is_real D" "C = cnj B"
    using hh hermitean_elems
    by auto

  assume *: "\<not> circline_A0_cmat (id H)" "(a, r) = euclidean_circle_cmat (id H)" "circline_type_cmat (id H) < 0"
  hence "A \<noteq> 0" "Re A \<noteq> 0"
    using HH \<open>is_real A\<close>
    by (case_tac[!] A) (auto simp add: Complex_eq)

  have "Re (A*D - B*C) < 0"
    using \<open>circline_type_cmat (id H) < 0\<close> HH
    by simp

  have **: "(A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A) = (A*D - B*C) / A"
    using \<open>A \<noteq> 0\<close>
    by (simp add: field_simps)
  hence ***: "0 < Re A \<longleftrightarrow> Re ((A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A)) < 0"
    using \<open>is_real A\<close> \<open>A \<noteq> 0\<close> \<open>Re (A*D - B*C) < 0\<close>
    by (simp add: Re_divide_real divide_less_0_iff)

  have "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)" if "Re A > 0"
    using HH * \<open>is_real A\<close> that
    by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
               minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
  moreover have "Re A > 0" if "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)"
    using HH * \<open>is_real A\<close> that
    by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
               minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
  ultimately show "pos_oriented_cmat H = in_ocircline_cmat_cvec H (of_complex_cvec a)"
    using HH \<open>Re A \<noteq> 0\<close> * \<open>is_real A\<close> by (auto simp add: vec_cnj_def)
qed

text \<open>Introduce positive orientation\<close>

definition of_circline_cmat :: "complex_mat \<Rightarrow> complex_mat" where
 [simp]: "of_circline_cmat H = (if pos_oriented_cmat H then H else opposite_ocircline_cmat H)"

lift_definition of_circline_clmat :: "circline_mat \<Rightarrow> circline_mat" is of_circline_cmat
  by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)

lemma of_circline_clmat_def':
  shows "of_circline_clmat H = (if pos_oriented_clmat H then H else opposite_ocircline_clmat H)"
  by transfer simp

lemma pos_oriented_cmat_mult_positive':
  assumes
    "hermitean H1 \<and> H1 \<noteq> mat_zero" and
    "hermitean H2 \<and> H2 \<noteq> mat_zero" and
    "\<exists>k. k > 0 \<and> H2 = cor k *\<^sub>s\<^sub>m H1" and
    "pos_oriented_cmat H1"
  shows "pos_oriented_cmat H2"
proof-
  obtain A1 B1 C1 D1 A2 B2 C2 D2
    where HH: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)"
    by (cases H1, cases H2)
  thus ?thesis
    using assms
    by fastforce
qed

lemma pos_oriented_cmat_mult_positive:
  assumes
    "hermitean H1 \<and> H1 \<noteq> mat_zero" and
    "hermitean H2 \<and> H2 \<noteq> mat_zero" and
    "\<exists>k. k > 0 \<and> H2 = cor k *\<^sub>s\<^sub>m H1"
  shows
    "pos_oriented_cmat H1 \<longleftrightarrow> pos_oriented_cmat H2"
proof-
  from assms(3) obtain k where "k > 0 \<and> H2 = cor k *\<^sub>s\<^sub>m H1"
    by auto
  hence "\<exists>k. k > 0 \<and> H1 = cor k *\<^sub>s\<^sub>m H2"
    by (rule_tac x="1/k" in exI, auto)
  thus ?thesis
    using assms pos_oriented_cmat_mult_positive'
    by blast
qed

lemma pos_oriented_cmat_mult_negative:
  assumes
    "hermitean H1 \<and> H1 \<noteq> mat_zero" and
    "hermitean H2 \<and> H2 \<noteq> mat_zero" and
    "\<exists>k. k < 0 \<and> H2 = cor k *\<^sub>s\<^sub>m H1"
  shows
    "pos_oriented_cmat H1 \<longleftrightarrow> \<not> pos_oriented_cmat H2"
  using assms
proof-
  obtain A B C D A1 B1 C1 D1
    where *: "H1 = (A, B, C, D)" "H2 = (A1, B1, C1, D1)"
    by (cases H1, cases H2) auto
  hence **: "is_real A" "is_real D" "is_real A1" "is_real D1" "B = 0 \<longleftrightarrow> C = 0" "B1 = 0 \<longleftrightarrow> C1 = 0"
    using assms hermitean_elems[of A B C D] hermitean_elems[of A1 B1 C1 D1]
    by auto
  show ?thesis
  proof (rule iffI)
    assume H1: "pos_oriented_cmat H1"
    show "\<not> pos_oriented_cmat H2"
    proof (cases "Re A > 0")
      case True
      thus ?thesis
        using assms * ** mult_neg_pos
        by fastforce
    next
      case False
      show ?thesis
      proof (cases "B = 0")
        case True
        thus ?thesis
          using assms * ** H1 `\<not> Re A > 0` mult_neg_pos
          by fastforce
      next
        case False
        thus ?thesis
          using arg_uminus_opposite_sign[of B] arg_mult_real_negative
          using assms * ** H1 `\<not> Re A > 0` mult_neg_pos
          by fastforce
      qed
    qed
  next
    assume H2: "\<not> pos_oriented_cmat H2"
    show "pos_oriented_cmat H1"
    proof (cases "Re A > 0")
      case True
      thus ?thesis
        using * ** mult_neg_pos
        by fastforce
    next
      case False
      show ?thesis
      proof (cases "B = 0")
        case True
        thus ?thesis
          using assms * ** H2 `\<not> Re A > 0`
          by simp (smt arg_0_iff arg_complex_of_real_negative arg_complex_of_real_positive arg_mult_eq complex_of_real_Re mult.right_neutral mult_eq_0_iff of_real_0 of_real_1 zero_complex.simps(1))
      next
        case False
        thus ?thesis
          using assms `\<not> Re A > 0` H2 * **
          using arg_uminus_opposite_sign[of B]
          by (cases "Re A = 0", auto simp add: mult_neg_neg)
      qed
    qed
  qed
qed

lift_definition of_circline :: "circline \<Rightarrow> ocircline" is of_circline_clmat
proof transfer
  fix H1 H2
  assume hh:
    "hermitean H1 \<and> H1 \<noteq> mat_zero"
    "hermitean H2 \<and> H2 \<noteq> mat_zero"
  assume "circline_eq_cmat H1 H2"
  then obtain k where *: "k \<noteq> 0 \<and> H2 = cor k *\<^sub>s\<^sub>m H1"
    by auto
  show "ocircline_eq_cmat (of_circline_cmat H1) (of_circline_cmat H2)"
  proof (cases "k > 0")
    case True
    hence "pos_oriented_cmat H1 = pos_oriented_cmat H2"
      using * pos_oriented_cmat_mult_positive[OF hh]
      by blast
    thus ?thesis
      using hh * \<open>k > 0\<close>
      apply (simp del: pos_oriented_cmat_def)
      apply (rule conjI)
       apply (rule impI)
       apply (simp, rule_tac x=k in exI, simp)
      apply (rule impI)
      apply (simp, rule_tac x=k in exI, simp)
      done
  next
    case False
    hence "k < 0"
      using *
      by simp
    hence "pos_oriented_cmat H1 \<longleftrightarrow> \<not> (pos_oriented_cmat H2)"
      using * pos_oriented_cmat_mult_negative[OF hh]
      by blast
    thus ?thesis
      using hh * \<open>k < 0\<close>
      apply (simp del: pos_oriented_cmat_def)
      apply (rule conjI)
       apply (rule impI)
       apply (simp, rule_tac x="-k" in exI, simp)
      apply (rule impI)
      apply (simp, rule_tac x="-k" in exI, simp)
      done
  qed
qed

lemma pos_oriented_of_circline [simp]:
  shows "pos_oriented (of_circline H)"
  using pos_oriented_opposite_ocircline_cmat
  by (transfer, transfer, simp)

lemma of_ocircline_of_circline [simp]:
  shows "of_ocircline (of_circline H) = H"
  apply (transfer, auto simp add: of_circline_clmat_def')
  apply (transfer, simp, rule_tac x="-1" in exI, simp)
  done

lemma of_circline_of_ocircline_pos_oriented [simp]:
  assumes "pos_oriented H"
  shows "of_circline (of_ocircline H) = H"
  using assms
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

lemma inj_of_circline:
  assumes "of_circline H = of_circline H'"
  shows "H = H'"
  using assms
proof (transfer, transfer)
  fix H H'
  assume "ocircline_eq_cmat (of_circline_cmat H) (of_circline_cmat H')"
  then obtain k where "k > 0" "of_circline_cmat H' = cor k *\<^sub>s\<^sub>m of_circline_cmat H"
    by auto
  thus "circline_eq_cmat H H'"
    using mult_sm_inv_l[of "-1" "H'" "cor k *\<^sub>s\<^sub>m H"]
    using mult_sm_inv_l[of "-1" "H'" "(- (cor k)) *\<^sub>s\<^sub>m H"]
    apply (simp split: if_split_asm)
    apply (rule_tac x="k" in exI, simp)
    apply (rule_tac x="-k" in exI, simp)
    apply (rule_tac x="-k" in exI, simp)
    apply (rule_tac x="k" in exI, simp)
    done
qed

lemma of_circline_of_ocircline:
  shows "of_circline (of_ocircline H') = H' \<or>
         of_circline (of_ocircline H') = opposite_ocircline H'"
proof (cases "pos_oriented H'")
  case True
  thus ?thesis
    by auto
next
  case False
  hence "pos_oriented (opposite_ocircline H')"
    using pos_oriented
    by auto
  thus ?thesis
    using of_ocircline_opposite_ocircline[of H']
    using of_circline_of_ocircline_pos_oriented [of "opposite_ocircline H'"]
    by auto
qed

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Set of points on oriented and unoriented circlines\<close>
(* -------------------------------------------------------------------------- *)

lemma ocircline_set_of_circline [simp]:
  shows "ocircline_set (of_circline H) = circline_set H"
  unfolding ocircline_set_def circline_set_def
proof (safe)
  fix z
  assume "on_ocircline (of_circline H) z"
  thus "on_circline H z"
    by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
next
  fix z
  assume "on_circline H z"
  thus "on_ocircline (of_circline H) z"
    by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
qed

(* ----------------------------------------------------------------- *)
subsection \<open>Some special oriented circlines and discs\<close>
(* ----------------------------------------------------------------- *)

lift_definition mk_ocircline :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> ocircline" is mk_circline_clmat
  done

text \<open>oriented unit circle and unit disc\<close>

lift_definition ounit_circle :: "ocircline" is unit_circle_clmat
  done

lemma pos_oriented_ounit_circle [simp]:
  shows "pos_oriented ounit_circle"
  by (transfer, transfer, simp)

lemma of_ocircline_ounit_circle [simp]:
  shows "of_ocircline ounit_circle = unit_circle"
  by (transfer, transfer, simp)

lemma of_circline_unit_circle [simp]:
  shows "of_circline (unit_circle) = ounit_circle"
  by (transfer, transfer, simp)

lemma ocircline_set_ounit_circle [simp]:
  shows "ocircline_set ounit_circle = circline_set unit_circle"
  apply (subst of_circline_unit_circle[symmetric])
  apply (subst ocircline_set_of_circline)
  apply simp
  done

definition unit_disc :: "complex_homo set" where
  "unit_disc = disc ounit_circle"

definition unit_disc_compl :: "complex_homo set" where
  "unit_disc_compl = disc_compl ounit_circle"

definition unit_circle_set :: "complex_homo set" where
  "unit_circle_set = circline_set unit_circle"

lemma zero_in_unit_disc [simp]:
  shows "0\<^sub>h \<in> unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma one_notin_unit_dic [simp]:
  shows "1\<^sub>h \<notin> unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma inf_notin_unit_disc [simp]:
  shows "\<infinity>\<^sub>h \<notin> unit_disc"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)

lemma unit_disc_iff_cmod_lt_1 [simp]:
  shows "of_complex c \<in> unit_disc \<longleftrightarrow> cmod c < 1"
  unfolding unit_disc_def disc_def
  by (simp, transfer, transfer, simp add: vec_cnj_def cmod_def power2_eq_square)

lemma unit_disc_cmod_square_lt_1 [simp]:
  assumes "z \<in> unit_disc"
  shows "(cmod (to_complex z))\<^sup>2 < 1"
  using assms inf_or_of_complex[of z]
  by (auto simp add: abs_square_less_1)

lemma unit_disc_to_complex_inj:
  assumes "u \<in> unit_disc" and "v \<in> unit_disc"
  assumes "to_complex u = to_complex v"
  shows "u = v"
  using assms
  using inf_or_of_complex[of u] inf_or_of_complex[of v]
  by auto

lemma inversion_unit_disc [simp]:
  shows "inversion ` unit_disc = unit_disc_compl"
  unfolding unit_disc_def unit_disc_compl_def disc_def disc_compl_def
proof safe
  fix x
  assume "in_ocircline ounit_circle x"
  thus "out_ocircline ounit_circle (inversion x)"
    unfolding inversion_def
    by (transfer, transfer, auto simp add: vec_cnj_def)
next
  fix x
  assume *: "out_ocircline ounit_circle x"
  show "x \<in> inversion ` Collect (in_ocircline ounit_circle)"
  proof (rule image_eqI)
    show "x = inversion (inversion x)"
      by auto
  next
    show "inversion x \<in> Collect (in_ocircline ounit_circle)"
      using *
      unfolding inversion_def
      by (simp, transfer, transfer, auto simp add: vec_cnj_def)
  qed
qed

lemma inversion_unit_disc_compl [simp]:
  shows "inversion ` unit_disc_compl = unit_disc"
proof-
  have "inversion ` (inversion ` unit_disc) = unit_disc"
    by (auto simp del: inversion_unit_disc simp add: image_iff)
  thus ?thesis
    by simp
qed

lemma inversion_noteq_unit_disc:
  assumes "u \<in> unit_disc" and "v \<in> unit_disc"
  shows "inversion u \<noteq> v"
proof-
  from assms
  have "inversion u \<in> unit_disc_compl"
    by (metis image_eqI inversion_unit_disc)
  thus ?thesis
    using assms
    unfolding unit_disc_def unit_disc_compl_def
    using disc_inter_disc_compl
    by fastforce
qed

lemma in_ocircline_ounit_circle_conjugate [simp]:
  assumes "in_ocircline ounit_circle z"
  shows "in_ocircline ounit_circle (conjugate z)"
  using assms
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma conjugate_unit_disc [simp]:
  shows "conjugate ` unit_disc = unit_disc"
  unfolding unit_disc_def disc_def
  apply (auto simp add: image_iff)
  apply (rule_tac x="conjugate x" in exI, simp)
  done

lemma conjugate_in_unit_disc [simp]:
  assumes "z \<in> unit_disc"
  shows "conjugate z \<in> unit_disc"
  using conjugate_unit_disc
  using assms
  by blast

lemma out_ocircline_ounit_circle_conjugate [simp]:
  assumes "out_ocircline ounit_circle z"
  shows "out_ocircline ounit_circle (conjugate z)"
  using assms
  by (transfer, transfer, auto simp add: vec_cnj_def)

lemma conjugate_unit_disc_compl [simp]:
  shows "conjugate ` unit_disc_compl = unit_disc_compl"
  unfolding unit_disc_compl_def disc_compl_def
  apply (auto simp add: image_iff)
  apply (rule_tac x="conjugate x" in exI, simp)
  done

lemma conjugate_in_unit_disc_compl [simp]:
  assumes "z \<in> unit_disc_compl"
  shows "conjugate z \<in> unit_disc_compl"
  using conjugate_unit_disc_compl
  using assms
  by blast

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Oriented x axis and lower half plane\<close>
(* -------------------------------------------------------------------------- *)

lift_definition o_x_axis :: "ocircline" is x_axis_clmat
done

lemma o_x_axis_pos_oriented [simp]:
  shows "pos_oriented o_x_axis"
  by (transfer, transfer, simp)

lemma of_ocircline_o_x_axis [simp]:
  shows "of_ocircline o_x_axis = x_axis"
  by (transfer, transfer, simp)

lemma of_circline_x_axis [simp]:
  shows "of_circline x_axis = o_x_axis"
  using of_circline_of_ocircline_pos_oriented[of o_x_axis]
  using o_x_axis_pos_oriented
  by simp

lemma ocircline_set_circline_set_x_axis [simp]:
  shows "ocircline_set o_x_axis = circline_set x_axis"
  by (subst of_circline_x_axis[symmetric], subst ocircline_set_of_circline, simp)

lemma ii_in_disc_o_x_axis [simp]:
  shows "ii\<^sub>h \<notin> disc o_x_axis"
  unfolding disc_def
  by simp (transfer, transfer, simp add: Let_def vec_cnj_def)

lemma ii_notin_disc_o_x_axis [simp]:
  shows "ii\<^sub>h \<in> disc_compl o_x_axis"
  unfolding disc_compl_def
  by simp (transfer, transfer, simp add: Let_def vec_cnj_def)

lemma of_complex_in_o_x_axis_disc [simp]:
  shows "of_complex z \<in> disc o_x_axis \<longleftrightarrow> Im z < 0"
  unfolding disc_def
  by auto (transfer, transfer, simp add: vec_cnj_def)+

lemma inf_notin_disc_o_x_axis [simp]:
  shows "\<infinity>\<^sub>h \<notin> disc o_x_axis"
  unfolding disc_def
  by simp (transfer, transfer, simp add: vec_cnj_def)

lemma disc_o_x_axis:
  shows "disc o_x_axis = of_complex ` {z. Im z < 0}"
proof-
  {
    fix z
    assume "z \<in> disc o_x_axis"
    hence "\<exists> x. Im x < 0 \<and> z = of_complex x"
      using inf_or_of_complex[of z]
      by auto
  }
  thus ?thesis
    by (auto simp add: image_iff)
qed

(* -------------------------------------------------------------------------- *)
subsubsection \<open>Oriented single point circline\<close>
(* -------------------------------------------------------------------------- *)

lift_definition  o_circline_point_0 :: "ocircline" is circline_point_0_clmat
done

lemma of_ocircline_o_circline_point_0 [simp]:
  shows "of_ocircline o_circline_point_0 = circline_point_0"
  by (transfer, transfer, simp)

(* ----------------------------------------------------------------- *)
subsection \<open>Möbius action on oriented circlines and discs\<close>
(* ----------------------------------------------------------------- *)

text \<open>Möbius action on an oriented circline is the same as on to an unoriented circline.\<close>

lift_definition moebius_ocircline :: "moebius \<Rightarrow> ocircline \<Rightarrow> ocircline" is moebius_circline_mmat_clmat
  apply (transfer, transfer)
  apply simp
  apply ((erule exE)+, (erule conjE)+)
  apply (simp add: mat_inv_mult_sm)
  apply (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
  done

text \<open>Möbius action on (unoriented) circlines could have been defined using the action on oriented
circlines, but not the other way around.\<close>

lemma moebius_circline_ocircline:
  shows "moebius_circline M H = of_ocircline (moebius_ocircline M (of_circline H))"
  apply (transfer, simp add: of_circline_clmat_def', safe)
  apply (transfer, simp, rule_tac x="-1" in exI, simp)
  done

text \<open>Möbius action on oriented circlines have many nice properties as it was the case with
Möbius action on (unoriented) circlines. These transformations are injective and form group under
composition.\<close>

lemma inj_moebius_ocircline [simp]:
  shows "inj (moebius_ocircline M)"
  unfolding inj_on_def
proof (safe)
  fix H H'
  assume "moebius_ocircline M H = moebius_ocircline M H'"
  thus "H = H'"
  proof (transfer, transfer)
    fix M H H' :: complex_mat
    assume "mat_det M \<noteq> 0"
    let ?iM = "mat_inv M"
    assume "ocircline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')"
    then obtain k where "congruence ?iM H' = congruence ?iM (cor k *\<^sub>s\<^sub>m H)" "k > 0"
      by (auto simp del: congruence_def)
    thus "ocircline_eq_cmat H H'"
      using \<open>mat_det M \<noteq> 0\<close> inj_congruence[of ?iM H' "cor k *\<^sub>s\<^sub>m H"] mat_det_inv[of M]
      by auto
  qed
qed

lemma moebius_ocircline_id_moebius [simp]:
  shows "moebius_ocircline id_moebius H = H"
  by (transfer, transfer) (force simp add: mat_adj_def mat_cnj_def)

lemma moebius_ocircline_comp [simp]:
  shows "moebius_ocircline (moebius_comp M1 M2) H = moebius_ocircline M1 (moebius_ocircline M2 H)"
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp add: mat_inv_mult_mm mult_mm_assoc)

lemma moebius_ocircline_comp_inv_left [simp]:
  shows "moebius_ocircline (moebius_inv M) (moebius_ocircline M H) = H"
  by (subst moebius_ocircline_comp[symmetric]) simp

lemma moebius_ocircline_comp_inv_right [simp]:
  shows "moebius_ocircline M (moebius_ocircline (moebius_inv M) H) = H"
  by (subst moebius_ocircline_comp[symmetric]) simp

lemma moebius_ocircline_opposite_ocircline [simp]:
  shows "moebius_ocircline M (opposite_ocircline H) = opposite_ocircline (moebius_ocircline M H)"
  by (transfer, transfer, simp, rule_tac x=1 in exI, simp)

text \<open>Möbius action on oriented circlines preserve the set of points of the circline.\<close>

lemma ocircline_set_moebius_ocircline [simp]:
  shows "ocircline_set (moebius_ocircline M H) = moebius_pt M ` ocircline_set H" (is "?lhs = ?rhs")
proof-
  have "?rhs = circline_set (moebius_circline M (of_ocircline H))"
    by simp
  thus ?thesis
    using moebius_ocircline_circline[of M H]
    by auto
qed

lemma ocircline_set_fix_iff_ocircline_fix:
  assumes "ocircline_set H' \<noteq> {}"
  shows "ocircline_set (moebius_ocircline M H) = ocircline_set H' \<longleftrightarrow>
         moebius_ocircline M H = H' \<or> moebius_ocircline M H = opposite_ocircline H'"
  using assms
  using inj_ocircline_set[of "moebius_ocircline M H" H']
  by (auto simp del: ocircline_set_moebius_ocircline)

lemma disc_moebius_ocircline [simp]:
  shows "disc (moebius_ocircline M H) = moebius_pt M ` (disc H)"
proof (safe)
  fix z
  assume "z \<in> disc H"
  thus "moebius_pt M z \<in> disc (moebius_ocircline M H)"
    unfolding disc_def
  proof (safe)
    assume "in_ocircline H z"
    thus "in_ocircline (moebius_ocircline M H) (moebius_pt M z)"
    proof (transfer, transfer)
      fix H M :: complex_mat and z :: complex_vec
      assume "mat_det M \<noteq> 0"
      assume "in_ocircline_cmat_cvec H z"
      thus "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
        using \<open>mat_det M \<noteq> 0\<close> quad_form_congruence[of M z]
        by simp
    qed
  qed
next
  fix z
  assume "z \<in> disc (moebius_ocircline M H)"
  thus "z \<in> moebius_pt M ` disc H"
    unfolding disc_def
  proof(safe)
    assume "in_ocircline (moebius_ocircline M H) z"
    show "z \<in> moebius_pt M ` Collect (in_ocircline H)"
    proof
      show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
        by simp
    next
      show "moebius_pt (moebius_inv M) z \<in> Collect (in_ocircline H)"
        using \<open>in_ocircline (moebius_ocircline M H) z\<close>
      proof (safe, transfer, transfer)
        fix M H :: complex_mat and z :: complex_vec
        assume "mat_det M \<noteq> 0"
        hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
          by (simp del: congruence_def)
        hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *\<^sub>m\<^sub>v z) H"
          using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
          using \<open>mat_det M \<noteq> 0\<close> mat_det_inv[of "M"]
          by simp
        moreover
        assume "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
        ultimately
        show "in_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
          by simp
      qed
    qed
  qed
qed

lemma disc_compl_moebius_ocircline [simp]:
  shows "disc_compl (moebius_ocircline M H) = moebius_pt M ` (disc_compl H)"
proof (safe)
  fix z
  assume "z \<in> disc_compl H"
  thus "moebius_pt M z \<in> disc_compl (moebius_ocircline M H)"
    unfolding disc_compl_def
  proof (safe)
    assume "out_ocircline H z"
    thus "out_ocircline (moebius_ocircline M H) (moebius_pt M z)"
    proof (transfer, transfer)
      fix H M :: complex_mat and z :: complex_vec
      assume "mat_det M \<noteq> 0"
      assume "out_ocircline_cmat_cvec H z"
      thus "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
        using \<open>mat_det M \<noteq> 0\<close> quad_form_congruence[of M z]
        by simp
    qed
  qed
next
  fix z
  assume "z \<in> disc_compl (moebius_ocircline M H)"
  thus "z \<in> moebius_pt M ` disc_compl H"
    unfolding disc_compl_def
  proof(safe)
    assume "out_ocircline (moebius_ocircline M H) z"
    show "z \<in> moebius_pt M ` Collect (out_ocircline H)"
    proof
      show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
        by simp
    next
      show "moebius_pt (moebius_inv M) z \<in> Collect (out_ocircline H)"
        using \<open>out_ocircline (moebius_ocircline M H) z\<close>
      proof (safe, transfer, transfer)
        fix M H :: complex_mat and z :: complex_vec
        assume "mat_det M \<noteq> 0"
        hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
          by (simp del: congruence_def)
        hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *\<^sub>m\<^sub>v z) H"
          using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
          using \<open>mat_det M \<noteq> 0\<close> mat_det_inv[of "M"]
          by simp
        moreover
        assume "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
        ultimately
        show "out_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
          by simp
      qed
    qed
  qed
qed

(* ----------------------------------------------------------------- *)
subsection \<open>Orientation after Möbius transformations\<close>
(* ----------------------------------------------------------------- *)

text \<open>All Euclidean similarities preserve circline orientation.\<close>

lemma moebius_similarity_oriented_lines_to_oriented_lines:
  assumes "a \<noteq> 0"
  shows "\<infinity>\<^sub>h \<in> ocircline_set H \<longleftrightarrow> \<infinity>\<^sub>h \<in> ocircline_set (moebius_ocircline (moebius_similarity a b) H)"
  using moebius_similarity_lines_to_lines[OF \<open>a \<noteq> 0\<close>, of b "of_ocircline H"]
  by simp

lemma moebius_similarity_preserve_orientation':
  assumes "a \<noteq> 0" and "\<infinity>\<^sub>h \<notin> ocircline_set H" and "pos_oriented H"
  shows "pos_oriented (moebius_ocircline (moebius_similarity a b) H)"
proof-
  let ?M = "moebius_similarity a b"
  let ?H = "moebius_ocircline ?M H"
  have "\<infinity>\<^sub>h \<notin> ocircline_set ?H"
    using \<open>\<infinity>\<^sub>h \<notin> ocircline_set H\<close> moebius_similarity_oriented_lines_to_oriented_lines[OF \<open>a \<noteq> 0\<close>]
    by simp

  have "\<infinity>\<^sub>h \<in> disc_compl H"
    using \<open>\<infinity>\<^sub>h \<notin> ocircline_set H\<close> \<open>pos_oriented H\<close> pos_oriented_circle_inf[of H] in_on_out
    unfolding disc_def disc_compl_def ocircline_set_def
    by auto
  hence "\<infinity>\<^sub>h \<in> disc_compl ?H"
    using moebius_similarity_inf[OF \<open>a \<noteq> 0\<close>, of b]
    by force
  thus "pos_oriented ?H"
    using pos_oriented_circle_inf[of ?H] disc_inter_disc_compl[of ?H] \<open>\<infinity>\<^sub>h \<notin> ocircline_set ?H\<close>
    by auto
qed

lemma moebius_similarity_preserve_orientation:
  assumes "a \<noteq> 0" and "\<infinity>\<^sub>h \<notin> ocircline_set H"
  shows "pos_oriented H \<longleftrightarrow> pos_oriented(moebius_ocircline (moebius_similarity a b) H)"
proof-
  let ?M = "moebius_similarity a b"
  let ?H = "moebius_ocircline ?M H"
  have "\<infinity>\<^sub>h \<notin> ocircline_set ?H"
    using \<open>\<infinity>\<^sub>h \<notin> ocircline_set H\<close> moebius_similarity_oriented_lines_to_oriented_lines[OF \<open>a \<noteq> 0\<close>]
    by simp

  have *: "H = moebius_ocircline (- moebius_similarity a b) ?H"
    by simp
  show ?thesis
    using \<open>a \<noteq> 0\<close>
    using moebius_similarity_preserve_orientation' [OF \<open>a \<noteq> 0\<close> \<open>\<infinity>\<^sub>h \<notin> ocircline_set H\<close>]
    using moebius_similarity_preserve_orientation'[OF _   \<open>\<infinity>\<^sub>h \<notin> ocircline_set ?H\<close>, of "1/a" "-b/a"]
    using moebius_similarity_inv[of a b, OF \<open>a \<noteq> 0\<close>]  *
    by auto
qed

lemma reciprocal_preserve_orientation:
  assumes "0\<^sub>h \<in> disc_compl H"
  shows "pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
  have "\<infinity>\<^sub>h \<in> disc_compl (moebius_ocircline moebius_reciprocal H)"
    using assms
    by force
  thus "pos_oriented (moebius_ocircline moebius_reciprocal H)"
    using pos_oriented_circle_inf[of "moebius_ocircline moebius_reciprocal H"]
    using disc_inter_disc_compl[of "moebius_ocircline moebius_reciprocal H"]
    using disc_compl_inter_ocircline_set[of "moebius_ocircline moebius_reciprocal H"]
    by auto
qed

lemma reciprocal_not_preserve_orientation:
  assumes "0\<^sub>h \<in> disc H"
  shows "\<not> pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
  let ?H = "moebius_ocircline moebius_reciprocal H"
  have "\<infinity>\<^sub>h \<in> disc ?H"
    using assms
    by force
  thus "\<not> pos_oriented ?H"
    using pos_oriented_circle_inf[of ?H] disc_inter_ocircline_set[of ?H]
    by auto
qed

text \<open>Orientation of the image of a given oriented circline $H$ under a given Möbius transformation
$M$ depends on whether the pole of $M$ (the point that $M$ maps to $\infty_{hc}$) lies in the disc
or in the disc complement of $H$ (if it is on the set of $H$, then it maps onto a line and we do not
discuss the orientation).\<close>

lemma pole_in_disc:
  assumes "M = mk_moebius a b c d" and "c \<noteq> 0" and "a*d - b*c \<noteq> 0"
  assumes "is_pole M z" "z \<in> disc H"
  shows "\<not> pos_oriented (moebius_ocircline M H)"
proof-
  let ?t1 = "moebius_translation (a / c)"
  let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
  let ?r =  "moebius_reciprocal"
  let ?t2 = "moebius_translation (d / c)"

  have "0\<^sub>h = moebius_pt (moebius_translation (d/c)) z"
    using pole_mk_moebius[of a b c d z] assms
    by simp

  have "z \<notin> ocircline_set H"
    using \<open>z \<in> disc H\<close> disc_inter_ocircline_set[of H]
    by blast

  hence "0\<^sub>h \<notin> ocircline_set (moebius_ocircline ?t2 H)"
    using \<open>0\<^sub>h = moebius_pt ?t2 z\<close>
    using moebius_pt_neq_I[of z _ ?t2]
    by force

  hence *: "\<infinity>\<^sub>h \<notin> ocircline_set (moebius_ocircline (?r + ?t2) H)"
    using \<open>0\<^sub>h = moebius_pt (moebius_translation (d / c)) z\<close>
    by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)

  hence **: "\<infinity>\<^sub>h \<notin> ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
    using \<open>a*d - b*c \<noteq> 0\<close> \<open>c \<noteq> 0\<close>
    unfolding moebius_rotation_dilatation_def
    using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
    by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)

  have "\<not> pos_oriented (moebius_ocircline (?r + ?t2) H)"
    using pole_mk_moebius[of a b c d z] assms
    using reciprocal_not_preserve_orientation
    by force
  hence "\<not> pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
    using *
    using \<open>a*d - b*c \<noteq> 0\<close> \<open>c \<noteq> 0\<close>
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
    unfolding moebius_rotation_dilatation_def
    by simp
  hence "\<not> pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
    using **
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
    unfolding moebius_translation_def
    by simp

  thus ?thesis
    using assms
    by simp (subst moebius_decomposition, simp_all)
qed

lemma pole_in_disc_compl:
  assumes "M = mk_moebius a b c d" and "c \<noteq> 0" and "a*d - b*c \<noteq> 0"
  assumes "is_pole M z" and "z \<in> disc_compl H"
  shows "pos_oriented (moebius_ocircline M H)"
proof-
  let ?t1 = "moebius_translation (a / c)"
  let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
  let ?r = "moebius_reciprocal"
  let ?t2 = "moebius_translation (d / c)"

  have "0\<^sub>h = moebius_pt (moebius_translation (d/c)) z"
    using pole_mk_moebius[of a b c d z] assms
    by simp

  have "z \<notin> ocircline_set H"
    using \<open>z \<in> disc_compl H\<close> disc_compl_inter_ocircline_set[of H]
    by blast
  hence "0\<^sub>h \<notin> ocircline_set (moebius_ocircline ?t2 H)"
    using \<open>0\<^sub>h = moebius_pt ?t2 z\<close>
    using moebius_pt_neq_I[of z _ ?t2]
    by force
  hence *: "\<infinity>\<^sub>h \<notin> ocircline_set (moebius_ocircline (?r + ?t2) H)"
    using \<open>0\<^sub>h = moebius_pt (moebius_translation (d / c)) z\<close>
    by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)

  hence **: "\<infinity>\<^sub>h \<notin> ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
    using \<open>a*d - b*c \<noteq> 0\<close> \<open>c \<noteq> 0\<close>
    unfolding moebius_rotation_dilatation_def
    using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
    by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)

  have "pos_oriented (moebius_ocircline (?r + ?t2) H)"
    using pole_mk_moebius[of a b c d z] assms
    using reciprocal_preserve_orientation
    by force
  hence "pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
    using *
    using \<open>a*d - b*c \<noteq> 0\<close> \<open>c \<noteq> 0\<close>
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
    unfolding moebius_rotation_dilatation_def
    by simp
  hence "pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
    using **
    using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
    unfolding moebius_translation_def
    by simp

  thus ?thesis
    using assms
    by simp (subst moebius_decomposition, simp_all)
qed

(* ----------------------------------------------------------------- *)
subsection \<open>Oriented circlines uniqueness\<close>
(* ----------------------------------------------------------------- *)

lemma ocircline_01inf:
  assumes "0\<^sub>h \<in> ocircline_set H \<and> 1\<^sub>h \<in> ocircline_set H \<and> \<infinity>\<^sub>h \<in> ocircline_set H"
  shows "H = o_x_axis \<or> H = opposite_ocircline o_x_axis"
proof-
  have "0\<^sub>h \<in> circline_set (of_ocircline H) \<and> 1\<^sub>h \<in> circline_set (of_ocircline H) \<and> \<infinity>\<^sub>h \<in> circline_set (of_ocircline H)"
    using assms
    by simp
  hence "of_ocircline H = x_axis"
    using unique_circline_01inf'
    by auto
  thus "H = o_x_axis \<or> H = opposite_ocircline o_x_axis"
    by (metis inj_of_ocircline of_ocircline_o_x_axis)
qed

lemma unique_ocircline_01inf:
  shows "\<exists>! H. 0\<^sub>h \<in> ocircline_set H \<and> 1\<^sub>h \<in> ocircline_set H \<and> \<infinity>\<^sub>h \<in> ocircline_set H \<and> ii\<^sub>h \<notin> disc H"
proof
  show "0\<^sub>h \<in> ocircline_set o_x_axis \<and> 1\<^sub>h \<in> ocircline_set o_x_axis \<and> \<infinity>\<^sub>h \<in> ocircline_set o_x_axis \<and> ii\<^sub>h \<notin> disc o_x_axis"
    by simp
next
  fix H
  assume "0\<^sub>h \<in> ocircline_set H \<and> 1\<^sub>h \<in> ocircline_set H \<and> \<infinity>\<^sub>h \<in> ocircline_set H \<and> ii\<^sub>h \<notin> disc H"
  hence "0\<^sub>h \<in> ocircline_set H \<and> 1\<^sub>h \<in> ocircline_set H \<and> \<infinity>\<^sub>h \<in> ocircline_set H" "ii\<^sub>h \<notin> disc H"
    by auto
  hence "H = o_x_axis \<or> H = opposite_ocircline o_x_axis"
    using ocircline_01inf
    by simp
  thus "H = o_x_axis"
    using \<open>ii\<^sub>h \<notin> disc H\<close>
    by auto
qed

lemma unique_ocircline_set:
  assumes "A \<noteq> B" and "A \<noteq> C" and "B \<noteq> C"
  shows "\<exists>! H. pos_oriented H \<and> (A \<in> ocircline_set H \<and> B \<in> ocircline_set H \<and> C \<in> ocircline_set H)"
proof-
  obtain M where *: "moebius_pt M A = 0\<^sub>h"  "moebius_pt M B = 1\<^sub>h" "moebius_pt M C = \<infinity>\<^sub>h"
    using ex_moebius_01inf[OF assms]
    by auto
  let ?iM = "moebius_pt (moebius_inv M)"
  have **: "?iM 0\<^sub>h = A"  "?iM 1\<^sub>h = B"  "?iM \<infinity>\<^sub>h = C"
    using *
    by (auto simp add: moebius_pt_invert)
  let ?H = "moebius_ocircline (moebius_inv M) o_x_axis"
  have 1: "A \<in> ocircline_set ?H" "B \<in> ocircline_set ?H" "C \<in> ocircline_set ?H"
    using **
    by auto
  have 2: "\<And> H'. A \<in> ocircline_set H' \<and> B \<in> ocircline_set H' \<and> C \<in> ocircline_set H' \<Longrightarrow> H' = ?H \<or> H' = opposite_ocircline ?H"
  proof-
    fix H'
    let ?H' = "ocircline_set H'" and ?H'' = "ocircline_set (moebius_ocircline M H')"
    assume "A \<in> ocircline_set H' \<and> B \<in> ocircline_set H' \<and> C \<in> ocircline_set H'"
    hence "moebius_pt M A \<in> ?H''" "moebius_pt M B \<in> ?H''" "moebius_pt M C \<in> ?H''"
      by auto
    hence "0\<^sub>h \<in> ?H''" "1\<^sub>h \<in> ?H''"  "\<infinity>\<^sub>h \<in> ?H''"
      using *
      by auto
    hence "moebius_ocircline M H' = o_x_axis \<or> moebius_ocircline M H' = opposite_ocircline o_x_axis"
      using ocircline_01inf
      by auto
    hence "o_x_axis = moebius_ocircline M H' \<or>  o_x_axis = opposite_ocircline (moebius_ocircline M H')"
      by auto
    thus "H' = ?H \<or> H' = opposite_ocircline ?H"
    proof
      assume *: "o_x_axis = moebius_ocircline M H'"
      show "H' = moebius_ocircline (moebius_inv M) o_x_axis \<or> H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
        by (rule disjI1) (subst *, simp)
    next
      assume *: "o_x_axis = opposite_ocircline (moebius_ocircline M H')"
      show "H' = moebius_ocircline (moebius_inv M) o_x_axis \<or> H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
        by (rule disjI2) (subst *, simp)
    qed
  qed

  show ?thesis (is "\<exists>! x. ?P x")
  proof (cases "pos_oriented ?H")
    case True
    show ?thesis
    proof
      show "?P ?H"
        using 1 True
        by auto
    next
      fix H
      assume "?P H"
      thus "H = ?H"
        using 1 2[of H] True
        by auto
    qed
  next
    case False
    let ?OH = "opposite_ocircline ?H"
    show ?thesis
    proof
      show "?P ?OH"
        using 1 False
        by auto
    next
      fix H
      assume "?P H"
      thus "H = ?OH"
        using False 2[of H]
        by auto
    qed
  qed
qed

lemma ocircline_set_0h:
  assumes "ocircline_set H = {0\<^sub>h}"
  shows "H = o_circline_point_0 \<or> H = opposite_ocircline (o_circline_point_0)"
proof-
  have "of_ocircline H = circline_point_0"
    using assms
    using unique_circline_type_zero_0' card_eq1_circline_type_zero[of "of_ocircline H"]
    by auto
  thus ?thesis
    by (metis inj_of_ocircline of_ocircline_o_circline_point_0)
qed

end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_prop_27
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun rev :: "'a list => 'a list" where
  "rev (nil2) = nil2"
| "rev (cons2 z xs) = x (rev xs) (cons2 z (nil2))"

fun qrev :: "'a list => 'a list => 'a list" where
  "qrev (nil2) z = z"
| "qrev (cons2 z2 xs) z = qrev xs (cons2 z2 z)"

theorem property0 :
  "((rev y) = (qrev y (nil2)))"
  oops

end


(*  Title:      HOL/Library/Numeral_Type.thy
    Author:     Brian Huffman
*)

section {* Numeral Syntax for Types *}

theory Numeral_Type
imports Cardinality
begin

subsection {* Numeral Types *}

typedef num0 = "UNIV :: nat set" ..
typedef num1 = "UNIV :: unit set" ..

typedef 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
proof
  show "0 \<in> {0 ..< 2 * int CARD('a)}"
    by simp
qed

typedef 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
proof
  show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
    by simp
qed

lemma card_num0 [simp]: "CARD (num0) = 0"
  unfolding type_definition.card [OF type_definition_num0]
  by simp

lemma infinite_num0: "\<not> finite (UNIV :: num0 set)"
  using card_num0[unfolded card_eq_0_iff]
  by simp

lemma card_num1 [simp]: "CARD(num1) = 1"
  unfolding type_definition.card [OF type_definition_num1]
  by (simp only: card_UNIV_unit)

lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
  unfolding type_definition.card [OF type_definition_bit0]
  by simp

lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
  unfolding type_definition.card [OF type_definition_bit1]
  by simp

instance num1 :: finite
proof
  show "finite (UNIV::num1 set)"
    unfolding type_definition.univ [OF type_definition_num1]
    using finite by (rule finite_imageI)
qed

instance bit0 :: (finite) card2
proof
  show "finite (UNIV::'a bit0 set)"
    unfolding type_definition.univ [OF type_definition_bit0]
    by simp
  show "2 \<le> CARD('a bit0)"
    by simp
qed

instance bit1 :: (finite) card2
proof
  show "finite (UNIV::'a bit1 set)"
    unfolding type_definition.univ [OF type_definition_bit1]
    by simp
  show "2 \<le> CARD('a bit1)"
    by simp
qed

subsection {* Locales for for modular arithmetic subtypes *}

locale mod_type =
  fixes n :: int
  and Rep :: "'a::{zero,one,plus,times,uminus,minus} \<Rightarrow> int"
  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus}"
  assumes type: "type_definition Rep Abs {0..<n}"
  and size1: "1 < n"
  and zero_def: "0 = Abs 0"
  and one_def:  "1 = Abs 1"
  and add_def:  "x + y = Abs ((Rep x + Rep y) mod n)"
  and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
  and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
  and minus_def: "- x = Abs ((- Rep x) mod n)"
begin

lemmas definitions =
  zero_def one_def add_def mult_def minus_def diff_def

lemma Rep_less_n: "Rep x < n"
by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])

lemma Rep_le_n: "Rep x \<le> n"
by (rule Rep_less_n [THEN order_less_imp_le])

lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
by (rule type_definition.Rep_inject [OF type, symmetric])

lemma Rep_inverse: "Abs (Rep x) = x"
by (rule type_definition.Rep_inverse [OF type])

lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
by (rule type_definition.Abs_inverse [OF type])

lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
by (simp add: Abs_inverse pos_mod_conj [OF size0])

lemma Rep_Abs_0: "Rep (Abs 0) = 0"
by (simp add: Abs_inverse size0)

lemma Rep_0: "Rep 0 = 0"
by (simp add: zero_def Rep_Abs_0)

lemma Rep_Abs_1: "Rep (Abs 1) = 1"
by (simp add: Abs_inverse size1)

lemma Rep_1: "Rep 1 = 1"
by (simp add: one_def Rep_Abs_1)

lemma Rep_mod: "Rep x mod n = Rep x"
apply (rule_tac x=x in type_definition.Abs_cases [OF type])
apply (simp add: type_definition.Abs_inverse [OF type])
apply (simp add: mod_pos_pos_trivial)
done

lemmas Rep_simps =
  Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1

lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
apply (intro_classes, unfold definitions)
apply (simp_all add: Rep_simps zmod_simps field_simps)
done

end

locale mod_ring = mod_type n Rep Abs
  for n :: int
  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
begin

lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
apply (induct k)
apply (simp add: zero_def)
apply (simp add: Rep_simps add_def one_def zmod_simps ac_simps)
done

lemma of_int_eq: "of_int z = Abs (z mod n)"
apply (cases z rule: int_diff_cases)
apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
done

lemma Rep_numeral:
  "Rep (numeral w) = numeral w mod n"
using of_int_eq [of "numeral w"]
by (simp add: Rep_inject_sym Rep_Abs_mod)

lemma iszero_numeral:
  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)

lemma cases:
  assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
  shows "P"
apply (cases x rule: type_definition.Abs_cases [OF type])
apply (rule_tac z="y" in 1)
apply (simp_all add: of_int_eq mod_pos_pos_trivial)
done

lemma induct:
  "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
by (cases x rule: cases) simp

end

subsection {* Ring class instances *}

text {*
  Unfortunately @{text ring_1} instance is not possible for
  @{typ num1}, since 0 and 1 are not distinct.
*}

instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
begin

lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
  by (induct x, induct y) simp

instance proof
qed (simp_all add: num1_eq_iff)

end

instantiation
  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus}"
begin

definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
  "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"

definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
  "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"

definition "0 = Abs_bit0 0"
definition "1 = Abs_bit0 1"
definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
definition "- x = Abs_bit0' (- Rep_bit0 x)"

definition "0 = Abs_bit1 0"
definition "1 = Abs_bit1 1"
definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
definition "- x = Abs_bit1' (- Rep_bit1 x)"

instance ..

end

interpretation bit0:
  mod_type "int CARD('a::finite bit0)"
           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
apply (rule mod_type.intro)
apply (simp add: int_mult type_definition_bit0)
apply (rule one_less_int_card)
apply (rule zero_bit0_def)
apply (rule one_bit0_def)
apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
apply (rule times_bit0_def [unfolded Abs_bit0'_def])
apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
done

interpretation bit1:
  mod_type "int CARD('a::finite bit1)"
           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
apply (rule mod_type.intro)
apply (simp add: int_mult type_definition_bit1)
apply (rule one_less_int_card)
apply (rule zero_bit1_def)
apply (rule one_bit1_def)
apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
apply (rule times_bit1_def [unfolded Abs_bit1'_def])
apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
done

instance bit0 :: (finite) comm_ring_1
  by (rule bit0.comm_ring_1)

instance bit1 :: (finite) comm_ring_1
  by (rule bit1.comm_ring_1)

interpretation bit0:
  mod_ring "int CARD('a::finite bit0)"
           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
  ..

interpretation bit1:
  mod_ring "int CARD('a::finite bit1)"
           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
  ..

text {* Set up cases, induction, and arithmetic *}

lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases

lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct

lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral

lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit0"] for dummy :: "'a::finite"
lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit1"] for dummy :: "'a::finite"

subsection {* Order instances *}

instantiation bit0 and bit1 :: (finite) linorder begin
definition "a < b \<longleftrightarrow> Rep_bit0 a < Rep_bit0 b"
definition "a \<le> b \<longleftrightarrow> Rep_bit0 a \<le> Rep_bit0 b"
definition "a < b \<longleftrightarrow> Rep_bit1 a < Rep_bit1 b"
definition "a \<le> b \<longleftrightarrow> Rep_bit1 a \<le> Rep_bit1 b"

instance
  by(intro_classes)
    (auto simp add: less_eq_bit0_def less_bit0_def less_eq_bit1_def less_bit1_def Rep_bit0_inject Rep_bit1_inject)
end

lemma (in preorder) tranclp_less: "op <\<^sup>+\<^sup>+ = op <"
by(auto simp add: fun_eq_iff intro: less_trans elim: tranclp.induct)

instance bit0 and bit1 :: (finite) wellorder
proof -
  have "wf {(x :: 'a bit0, y). x < y}"
    by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
  thus "OFCLASS('a bit0, wellorder_class)"
    by(rule wf_wellorderI) intro_classes
next
  have "wf {(x :: 'a bit1, y). x < y}"
    by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
  thus "OFCLASS('a bit1, wellorder_class)"
    by(rule wf_wellorderI) intro_classes
qed

subsection {* Code setup and type classes for code generation *}

text {* Code setup for @{typ num0} and @{typ num1} *}

definition Num0 :: num0 where "Num0 = Abs_num0 0"
code_datatype Num0

instantiation num0 :: equal begin
definition equal_num0 :: "num0 \<Rightarrow> num0 \<Rightarrow> bool"
  where "equal_num0 = op ="
instance by intro_classes (simp add: equal_num0_def)
end

lemma equal_num0_code [code]:
  "equal_class.equal Num0 Num0 = True"
by(rule equal_refl)

code_datatype "1 :: num1"

instantiation num1 :: equal begin
definition equal_num1 :: "num1 \<Rightarrow> num1 \<Rightarrow> bool"
  where "equal_num1 = op ="
instance by intro_classes (simp add: equal_num1_def)
end

lemma equal_num1_code [code]:
  "equal_class.equal (1 :: num1) 1 = True"
by(rule equal_refl)

instantiation num1 :: enum begin
definition "enum_class.enum = [1 :: num1]"
definition "enum_class.enum_all P = P (1 :: num1)"
definition "enum_class.enum_ex P = P (1 :: num1)"
instance
  by intro_classes
     (auto simp add: enum_num1_def enum_all_num1_def enum_ex_num1_def num1_eq_iff Ball_def,
      (metis (full_types) num1_eq_iff)+)
end

instantiation num0 and num1 :: card_UNIV begin
definition "finite_UNIV = Phantom(num0) False"
definition "card_UNIV = Phantom(num0) 0"
definition "finite_UNIV = Phantom(num1) True"
definition "card_UNIV = Phantom(num1) 1"
instance
  by intro_classes
     (simp_all add: finite_UNIV_num0_def card_UNIV_num0_def infinite_num0 finite_UNIV_num1_def card_UNIV_num1_def)
end

text {* Code setup for @{typ "'a bit0"} and @{typ "'a bit1"} *}

declare
  bit0.Rep_inverse[code abstype]
  bit0.Rep_0[code abstract]
  bit0.Rep_1[code abstract]

lemma Abs_bit0'_code [code abstract]:
  "Rep_bit0 (Abs_bit0' x :: 'a :: finite bit0) = x mod int (CARD('a bit0))"
by(auto simp add: Abs_bit0'_def intro!: Abs_bit0_inverse)
  (metis bit0.Rep_Abs_mod bit0.Rep_less_n card_bit0 of_nat_numeral zmult_int)

lemma inj_on_Abs_bit0:
  "inj_on (Abs_bit0 :: int \<Rightarrow> 'a bit0) {0..<2 * int CARD('a :: finite)}"
by(auto intro: inj_onI simp add: Abs_bit0_inject)

declare
  bit1.Rep_inverse[code abstype]
  bit1.Rep_0[code abstract]
  bit1.Rep_1[code abstract]

lemma Abs_bit1'_code [code abstract]:
  "Rep_bit1 (Abs_bit1' x :: 'a :: finite bit1) = x mod int (CARD('a bit1))"
by(auto simp add: Abs_bit1'_def intro!: Abs_bit1_inverse)
  (metis of_nat_0_less_iff of_nat_Suc of_nat_mult of_nat_numeral pos_mod_conj zero_less_Suc)

lemma inj_on_Abs_bit1:
  "inj_on (Abs_bit1 :: int \<Rightarrow> 'a bit1) {0..<1 + 2 * int CARD('a :: finite)}"
by(auto intro: inj_onI simp add: Abs_bit1_inject)

instantiation bit0 and bit1 :: (finite) equal begin

definition "equal_class.equal x y \<longleftrightarrow> Rep_bit0 x = Rep_bit0 y"
definition "equal_class.equal x y \<longleftrightarrow> Rep_bit1 x = Rep_bit1 y"

instance
  by intro_classes (simp_all add: equal_bit0_def equal_bit1_def Rep_bit0_inject Rep_bit1_inject)

end

instantiation bit0 :: (finite) enum begin
definition "(enum_class.enum :: 'a bit0 list) = map (Abs_bit0' \<circ> int) (upt 0 (CARD('a bit0)))"
definition "enum_class.enum_all P = (\<forall>b :: 'a bit0 \<in> set enum_class.enum. P b)"
definition "enum_class.enum_ex P = (\<exists>b :: 'a bit0 \<in> set enum_class.enum. P b)"

instance
proof(intro_classes)
  show "distinct (enum_class.enum :: 'a bit0 list)"
    by(auto intro!: inj_onI simp add: Abs_bit0'_def Abs_bit0_inject zmod_int[symmetric] enum_bit0_def distinct_map)

  show univ_eq: "(UNIV :: 'a bit0 set) = set enum_class.enum"
    unfolding enum_bit0_def type_definition.Abs_image[OF type_definition_bit0, symmetric]
    by(simp add: image_comp [symmetric] inj_on_Abs_bit0 card_image image_int_atLeastLessThan)
      (auto intro!: image_cong[OF refl] simp add: Abs_bit0'_def mod_pos_pos_trivial)

  fix P :: "'a bit0 \<Rightarrow> bool"
  show "enum_class.enum_all P = Ball UNIV P"
    and "enum_class.enum_ex P = Bex UNIV P"
    by(simp_all add: enum_all_bit0_def enum_ex_bit0_def univ_eq)
qed

end

instantiation bit1 :: (finite) enum begin
definition "(enum_class.enum :: 'a bit1 list) = map (Abs_bit1' \<circ> int) (upt 0 (CARD('a bit1)))"
definition "enum_class.enum_all P = (\<forall>b :: 'a bit1 \<in> set enum_class.enum. P b)"
definition "enum_class.enum_ex P = (\<exists>b :: 'a bit1 \<in> set enum_class.enum. P b)"

instance
proof(intro_classes)
  show "distinct (enum_class.enum :: 'a bit1 list)"
    by(simp only: Abs_bit1'_def zmod_int[symmetric] enum_bit1_def distinct_map Suc_eq_plus1 card_bit1 o_apply inj_on_def)
      (clarsimp simp add: Abs_bit1_inject)

  show univ_eq: "(UNIV :: 'a bit1 set) = set enum_class.enum"
    unfolding enum_bit1_def type_definition.Abs_image[OF type_definition_bit1, symmetric]
    by(simp add: image_comp [symmetric] inj_on_Abs_bit1 card_image image_int_atLeastLessThan)
      (auto intro!: image_cong[OF refl] simp add: Abs_bit1'_def mod_pos_pos_trivial)

  fix P :: "'a bit1 \<Rightarrow> bool"
  show "enum_class.enum_all P = Ball UNIV P"
    and "enum_class.enum_ex P = Bex UNIV P"
    by(simp_all add: enum_all_bit1_def enum_ex_bit1_def univ_eq)
qed

end

instantiation bit0 and bit1 :: (finite) finite_UNIV begin
definition "finite_UNIV = Phantom('a bit0) True"
definition "finite_UNIV = Phantom('a bit1) True"
instance by intro_classes (simp_all add: finite_UNIV_bit0_def finite_UNIV_bit1_def)
end

instantiation bit0 and bit1 :: ("{finite,card_UNIV}") card_UNIV begin
definition "card_UNIV = Phantom('a bit0) (2 * of_phantom (card_UNIV :: 'a card_UNIV))"
definition "card_UNIV = Phantom('a bit1) (1 + 2 * of_phantom (card_UNIV :: 'a card_UNIV))"
instance by intro_classes (simp_all add: card_UNIV_bit0_def card_UNIV_bit1_def card_UNIV)
end

subsection {* Syntax *}

syntax
  "_NumeralType" :: "num_token => type"  ("_")
  "_NumeralType0" :: type ("0")
  "_NumeralType1" :: type ("1")

translations
  (type) "1" == (type) "num1"
  (type) "0" == (type) "num0"

parse_translation {*
  let
    fun mk_bintype n =
      let
        fun mk_bit 0 = Syntax.const @{type_syntax bit0}
          | mk_bit 1 = Syntax.const @{type_syntax bit1};
        fun bin_of n =
          if n = 1 then Syntax.const @{type_syntax num1}
          else if n = 0 then Syntax.const @{type_syntax num0}
          else if n = ~1 then raise TERM ("negative type numeral", [])
          else
            let val (q, r) = Integer.div_mod n 2;
            in mk_bit r $ bin_of q end;
      in bin_of n end;

    fun numeral_tr [Free (str, _)] = mk_bintype (the (Int.fromString str))
      | numeral_tr ts = raise TERM ("numeral_tr", ts);

  in [(@{syntax_const "_NumeralType"}, K numeral_tr)] end;
*}

print_translation {*
  let
    fun int_of [] = 0
      | int_of (b :: bs) = b + 2 * int_of bs;

    fun bin_of (Const (@{type_syntax num0}, _)) = []
      | bin_of (Const (@{type_syntax num1}, _)) = [1]
      | bin_of (Const (@{type_syntax bit0}, _) $ bs) = 0 :: bin_of bs
      | bin_of (Const (@{type_syntax bit1}, _) $ bs) = 1 :: bin_of bs
      | bin_of t = raise TERM ("bin_of", [t]);

    fun bit_tr' b [t] =
          let
            val rev_digs = b :: bin_of t handle TERM _ => raise Match
            val i = int_of rev_digs;
            val num = string_of_int (abs i);
          in
            Syntax.const @{syntax_const "_NumeralType"} $ Syntax.free num
          end
      | bit_tr' b _ = raise Match;
  in
   [(@{type_syntax bit0}, K (bit_tr' 0)),
    (@{type_syntax bit1}, K (bit_tr' 1))]
  end;
*}

subsection {* Examples *}

lemma "CARD(0) = 0" by simp
lemma "CARD(17) = 17" by simp
lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp

end