diff --git a/thys/Complex_Geometry/Angles.thy b/thys/Complex_Geometry/Angles.thy
--- a/thys/Complex_Geometry/Angles.thy
+++ b/thys/Complex_Geometry/Angles.thy
@@ -1,510 +1,510 @@
 (* ---------------------------------------------------------------------------- *)
 subsection \<open>Angle between two vectors\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>In this section we introduce different measures of angle between two vectors (represented by complex numbers).\<close>
 
 theory Angles
 imports More_Transcendental Canonical_Angle More_Complex
 begin
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Oriented angle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>Oriented angle between two vectors (it is always in the interval $(-\pi, \pi]$).\<close>
 definition ang_vec ("\<angle>") where
-  [simp]: "\<angle> z1 z2 \<equiv> \<downharpoonright>arg z2 - arg z1\<downharpoonleft>"
+  [simp]: "\<angle> z1 z2 \<equiv> \<downharpoonright>Arg z2 - Arg z1\<downharpoonleft>"
 
 lemma ang_vec_bounded:
   shows "-pi < \<angle> z1 z2 \<and> \<angle> z1 z2 \<le> pi"
   by (simp add: canon_ang(1) canon_ang(2))
 
 lemma ang_vec_sym:
   assumes "\<angle> z1 z2 \<noteq> pi"
   shows "\<angle> z1 z2 = - \<angle> z2 z1"
   using assms
   unfolding ang_vec_def
-  using canon_ang_uminus[of "arg z2 - arg z1"]
+  using canon_ang_uminus[of "Arg z2 - Arg z1"]
   by simp
 
 lemma ang_vec_sym_pi:
   assumes "\<angle> z1 z2 = pi"
   shows "\<angle> z1 z2 = \<angle> z2 z1"
   using assms
   unfolding ang_vec_def
-  using canon_ang_uminus_pi[of "arg z2 - arg z1"]
+  using canon_ang_uminus_pi[of "Arg z2 - Arg z1"]
   by simp
 
 lemma ang_vec_plus_pi1:
   assumes "\<angle> z1 z2 > 0"
   shows "\<downharpoonright>\<angle> z1 z2 + pi\<downharpoonleft> = \<angle> z1 z2 - pi"
 proof (rule canon_ang_eqI)
   show "\<exists> x::int. \<angle> z1 z2 - pi - (\<angle> z1 z2 + pi) = 2 * real_of_int x * pi"
     by (rule_tac x="-1" in exI) auto
 next
   show "- pi < \<angle> z1 z2 - pi \<and> \<angle> z1 z2 - pi \<le> pi"
     using assms
     unfolding ang_vec_def
-    using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+    using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
     by auto
 qed
 
 lemma ang_vec_plus_pi2:
   assumes "\<angle> z1 z2 \<le> 0"
   shows "\<downharpoonright>\<angle> z1 z2 + pi\<downharpoonleft> = \<angle> z1 z2 + pi"
 proof (rule canon_ang_id)
   show "- pi < \<angle> z1 z2 + pi \<and> \<angle> z1 z2 + pi \<le> pi"
     using assms
     unfolding ang_vec_def
-    using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+    using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
     by auto
 qed
 
 lemma ang_vec_opposite1:
   assumes "z1 \<noteq> 0"
   shows "\<angle> (-z1) z2 = \<downharpoonright>\<angle> z1 z2 - pi\<downharpoonleft>"
 proof-
-  have "\<angle> (-z1) z2 = \<downharpoonright>arg z2 - (arg z1 + pi)\<downharpoonleft>"
+  have "\<angle> (-z1) z2 = \<downharpoonright>Arg z2 - (Arg z1 + pi)\<downharpoonleft>"
     unfolding ang_vec_def
     using arg_uminus[OF assms] 
     using canon_ang_arg[of z2, symmetric]
-    using canon_ang_diff[of "arg z2" "arg z1 + pi", symmetric]
+    using canon_ang_diff[of "Arg z2" "Arg z1 + pi", symmetric]
     by simp
   moreover
-  have "\<downharpoonright>\<angle> z1 z2 - pi\<downharpoonleft> = \<downharpoonright>arg z2 - arg z1 - pi\<downharpoonleft>"
+  have "\<downharpoonright>\<angle> z1 z2 - pi\<downharpoonleft> = \<downharpoonright>Arg z2 - Arg z1 - pi\<downharpoonleft>"
     using canon_ang_id[of pi, symmetric]
-    using canon_ang_diff[of "arg z2 - arg z1" "pi", symmetric]
+    using canon_ang_diff[of "Arg z2 - Arg z1" "pi", symmetric]
     by simp_all
   ultimately
   show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma ang_vec_opposite2:
   assumes "z2 \<noteq> 0"
   shows "\<angle> z1 (-z2) = \<downharpoonright>\<angle> z1 z2 + pi\<downharpoonleft>"
   unfolding ang_vec_def
   using arg_mult[of "-1" "z2"] assms
   using arg_complex_of_real_negative[of "-1"]
-  using canon_ang_diff[of "arg (-1) + arg z2" "arg z1", symmetric]
-  using canon_ang_sum[of "arg z2 - arg z1" "pi", symmetric]
+  using canon_ang_diff[of "Arg (-1) + Arg z2" "Arg z1", symmetric]
+  using canon_ang_sum[of "Arg z2 - Arg z1" "pi", symmetric]
   using canon_ang_id[of pi] canon_ang_arg[of z1]
   by (auto simp: algebra_simps)
   
 
 lemma ang_vec_opposite_opposite:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "\<angle> (-z1) (-z2) = \<angle> z1 z2"
 proof-
   have "\<angle> (-z1) (-z2) = \<downharpoonright>\<downharpoonright>\<angle> z1 z2 + pi\<downharpoonleft> - \<downharpoonright>pi\<downharpoonleft>\<downharpoonleft>"
     using ang_vec_opposite1[OF assms(1)]
     using ang_vec_opposite2[OF assms(2)]
     using canon_ang_id[of pi, symmetric]
     by simp_all
   also have "... = \<downharpoonright>\<angle> z1 z2\<downharpoonleft>"
     by (subst canon_ang_diff[symmetric], simp)
   finally
   show ?thesis
     by (metis ang_vec_def canon_ang(1) canon_ang(2) canon_ang_id)
 qed
 
 lemma ang_vec_opposite_opposite':
   assumes "z1 \<noteq> z" and "z2 \<noteq> z"
   shows "\<angle> (z - z1) (z - z2) = \<angle> (z1 - z) (z2 - z)"
 using ang_vec_opposite_opposite[of "z - z1" "z - z2"] assms
 by (simp add: field_simps del: ang_vec_def)
 
 text \<open>Cosine, scalar product and the law of cosines\<close>
 
 lemma cos_cmod_scalprod:
   shows "cmod z1 * cmod z2 * (cos (\<angle> z1 z2)) = Re (scalprod z1 z2)"
 proof (cases "z1 = 0 \<or> z2 = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
   thus ?thesis
     by (simp add: cos_diff cos_arg sin_arg field_simps)
 qed
 
 lemma cos0_scalprod0:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "cos (\<angle> z1 z2) = 0 \<longleftrightarrow> scalprod z1 z2 = 0"
   using assms
   using cnj_mix_real[of z1 z2]
   using cos_cmod_scalprod[of z1 z2]
   by (auto simp add: complex_eq_if_Re_eq)
 
 lemma ortho_scalprod0:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "\<angle> z1 z2 = pi/2 \<or> \<angle> z1 z2 = -pi/2 \<longleftrightarrow> scalprod z1 z2 = 0"
   using cos0_scalprod0[OF assms]
   using ang_vec_bounded[of z1 z2]
   using cos_0_iff_canon[of "\<angle> z1 z2"]
   by (metis cos_minus cos_pi_half divide_minus_left)
 
 lemma law_of_cosines:
   shows "(cdist B C)\<^sup>2 = (cdist A C)\<^sup>2 + (cdist A B)\<^sup>2 - 2*(cdist A C)*(cdist A B)*(cos (\<angle> (C-A) (B-A)))"
 proof-
   let ?a = "C-B" and ?b = "C-A" and ?c = "B-A"
   have "?a = ?b - ?c"
     by simp
   hence "(cmod ?a)\<^sup>2 = (cmod (?b - ?c))\<^sup>2"
     by metis
   also have "... = Re (scalprod (?b-?c) (?b-?c))"
     by (simp add: cmod_square)
   also have "... = (cmod ?b)\<^sup>2 + (cmod ?c)\<^sup>2 - 2*Re (scalprod ?b ?c)"
     by (simp add: cmod_square field_simps)
   finally
   show ?thesis
     using cos_cmod_scalprod[of ?b ?c]
     by simp
 qed
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Unoriented angle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>Convex unoriented angle between two vectors (it is always in the interval $[0, pi]$).\<close>
 definition ang_vec_c ("\<angle>c") where
   [simp]:"\<angle>c z1 z2 \<equiv> abs (\<angle> z1 z2)"
 
 lemma ang_vec_c_sym:
   shows "\<angle>c z1 z2 = \<angle>c z2 z1"
   unfolding ang_vec_c_def
   using ang_vec_sym_pi[of z1 z2] ang_vec_sym[of z1 z2]
   by (cases "\<angle> z1 z2 = pi") auto
 
 lemma ang_vec_c_bounded: "0 \<le> \<angle>c z1 z2 \<and> \<angle>c z1 z2 \<le> pi"
-  using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+  using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
   by auto
 
 text \<open>Cosine and scalar product\<close>
 
 lemma cos_c_: "cos (\<angle>c z1 z2) = cos (\<angle> z1 z2)"
   unfolding ang_vec_c_def
   by (smt cos_minus)
 
 lemma ortho_c_scalprod0:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "\<angle>c z1 z2 = pi/2 \<longleftrightarrow> scalprod z1 z2 = 0"
 proof-
   have "\<angle> z1 z2 = pi / 2 \<or> \<angle> z1 z2 = - pi / 2 \<longleftrightarrow> \<angle>c z1 z2 = pi/2"
     unfolding ang_vec_c_def
     using arctan 
     by force
   thus ?thesis
     using ortho_scalprod0[OF assms]
     by simp
 qed
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Acute angle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>Acute or right angle (non-obtuse) between two vectors (it is always in the interval $[0, \frac{\pi}{2}$]).
 We will use this to measure angle between two circles, since it can always be acute (or right).\<close>
 
 definition acute_ang where
   [simp]: "acute_ang \<alpha> = (if \<alpha> > pi / 2 then pi - \<alpha> else \<alpha>)"
 
 definition ang_vec_a ("\<angle>a") where
   [simp]: "\<angle>a z1 z2 \<equiv> acute_ang (\<angle>c z1 z2)"
 
 lemma ang_vec_a_sym:
   "\<angle>a z1 z2 = \<angle>a z2 z1"
   unfolding ang_vec_a_def
   using ang_vec_c_sym
   by auto
 
 lemma ang_vec_a_opposite2:
   "\<angle>a z1 z2 = \<angle>a z1 (-z2)"
 proof(cases "z2  = 0")
   case True
   thus ?thesis
     by (metis minus_zero)
 next
   case False
   thus ?thesis
   proof(cases "\<angle> z1 z2 < -pi / 2")
     case True
     hence "\<angle> z1 z2 < 0"
       using pi_not_less_zero
       by linarith
     have "\<angle>a z1 z2 = pi + \<angle> z1 z2"
       using True \<open>\<angle> z1 z2 < 0\<close>
       unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
       by auto
     moreover
     have "\<angle>a z1 (-z2) = pi + \<angle> z1 z2"
       unfolding ang_vec_a_def ang_vec_c_def abs_real_def
-      using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+      using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
       using ang_vec_plus_pi2[of z1 z2] True \<open>\<angle> z1 z2 < 0\<close> \<open>z2 \<noteq> 0\<close>
       using ang_vec_opposite2[of z2 z1]
       by auto
     ultimately
     show ?thesis
       by auto
   next
     case False
     show ?thesis
     proof (cases "\<angle> z1 z2 \<le> 0")
       case True
       have "\<angle>a z1 z2 = - \<angle> z1 z2"
         using \<open>\<not> \<angle> z1 z2 < - pi / 2\<close> True
         unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
         by auto
       moreover
       have "\<angle>a z1 (-z2) = - \<angle> z1 z2"
         using \<open>\<not> \<angle> z1 z2 < - pi / 2\<close> True
         unfolding ang_vec_a_def ang_vec_c_def abs_real_def
         using ang_vec_plus_pi2[of z1 z2]
-        using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+        using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
         using \<open>z2 \<noteq> 0\<close> ang_vec_opposite2[of z2 z1]
         by auto
       ultimately
       show ?thesis
         by simp
     next
       case False
       show ?thesis
       proof (cases "\<angle> z1 z2 < pi / 2")
         case True
         have "\<angle>a z1 z2 = \<angle> z1 z2"
           using \<open>\<not> \<angle> z1 z2 \<le> 0\<close> True
           unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
           by auto
         moreover
         have "\<angle>a z1 (-z2) = \<angle> z1 z2"
           using \<open>\<not> \<angle> z1 z2 \<le> 0\<close> True
           unfolding ang_vec_a_def ang_vec_c_def abs_real_def
           using ang_vec_plus_pi1[of z1 z2]
-          using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+          using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
           using \<open>z2 \<noteq> 0\<close> ang_vec_opposite2[of z2 z1]
           by auto
         ultimately
         show ?thesis
           by simp
       next
         case False
         have "\<angle> z1 z2 > 0"
           using False
           by (metis less_linear less_trans pi_half_gt_zero)
         have "\<angle>a z1 z2 = pi - \<angle> z1 z2"
           using False \<open>\<angle> z1 z2 > 0\<close>
           unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
           by auto
         moreover
         have "\<angle>a z1 (-z2) = pi - \<angle> z1 z2"
           unfolding ang_vec_a_def ang_vec_c_def abs_real_def
           using False \<open>\<angle> z1 z2 > 0\<close>
           using ang_vec_plus_pi1[of z1 z2]
-          using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
+          using canon_ang(1)[of "Arg z2 - Arg z1"] canon_ang(2)[of "Arg z2 - Arg z1"]
           using \<open>z2 \<noteq> 0\<close> ang_vec_opposite2[of z2 z1]
           by auto
         ultimately
         show ?thesis
           by auto
       qed
     qed
   qed
 qed
 
 lemma ang_vec_a_opposite1:
   shows "\<angle>a z1 z2 = \<angle>a (-z1) z2"
   using ang_vec_a_sym[of "-z1" z2] ang_vec_a_opposite2[of z2 z1] ang_vec_a_sym[of z2 z1]
   by auto
 
 lemma ang_vec_a_scale1:
   assumes "k \<noteq> 0"
   shows "\<angle>a (cor k * z1) z2 = \<angle>a z1 z2"
 proof (cases "k > 0")
   case True
   thus ?thesis
     unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
     using arg_mult_real_positive[of k z1]
     by auto
 next
   case False
   hence "k < 0"
     using assms
     by auto
   thus ?thesis
     using arg_mult_real_negative[of k z1]
     using ang_vec_a_opposite1[of z1 z2]
     unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
     by simp
 qed
 
 lemma ang_vec_a_scale2:
   assumes "k \<noteq> 0"
   shows "\<angle>a z1 (cor k * z2) = \<angle>a z1 z2"
   using ang_vec_a_sym[of z1 "complex_of_real k * z2"]
   using ang_vec_a_scale1[OF assms, of z2 z1]
   using ang_vec_a_sym[of z1 z2]
   by auto
 
 lemma ang_vec_a_scale:
   assumes "k1 \<noteq> 0" and "k2 \<noteq> 0"
   shows "\<angle>a (cor k1 * z1) (cor k2 * z2) = \<angle>a z1 z2"
   using ang_vec_a_scale1[OF assms(1)] ang_vec_a_scale2[OF assms(2)]
   by auto
 
 lemma ang_a_cnj_cnj:
   shows "\<angle>a z1 z2 = \<angle>a (cnj z1) (cnj z2)"
 unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
-proof(cases "arg z1 \<noteq> pi \<and> arg z2 \<noteq> pi")
+proof(cases "Arg z1 \<noteq> pi \<and> Arg z2 \<noteq> pi")
   case True
-  thus "acute_ang \<bar>\<downharpoonright>arg z2 - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg (cnj z2) - arg (cnj z1)\<downharpoonleft>\<bar>"
+  thus "acute_ang \<bar>\<downharpoonright>Arg z2 - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg (cnj z2) - Arg (cnj z1)\<downharpoonleft>\<bar>"
     using arg_cnj_not_pi[of z1] arg_cnj_not_pi[of z2]
     apply (auto simp del:acute_ang_def)
-    proof(cases "\<downharpoonright>arg z2 - arg z1\<downharpoonleft> = pi")
+    proof(cases "\<downharpoonright>Arg z2 - Arg z1\<downharpoonleft> = pi")
       case True
-      thus "acute_ang \<bar>\<downharpoonright>arg z2 - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg z1 - arg z2\<downharpoonleft>\<bar>"
-        using  canon_ang_uminus_pi[of "arg z2 - arg z1"]
+      thus "acute_ang \<bar>\<downharpoonright>Arg z2 - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg z1 - Arg z2\<downharpoonleft>\<bar>"
+        using  canon_ang_uminus_pi[of "Arg z2 - Arg z1"]
         by (auto simp add:field_simps)
     next
       case False
-      thus "acute_ang \<bar>\<downharpoonright>arg z2 - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg z1 - arg z2\<downharpoonleft>\<bar>"
-        using  canon_ang_uminus[of "arg z2 - arg z1"]
+      thus "acute_ang \<bar>\<downharpoonright>Arg z2 - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg z1 - Arg z2\<downharpoonleft>\<bar>"
+        using  canon_ang_uminus[of "Arg z2 - Arg z1"]
         by (auto simp add:field_simps)
     qed
   next
     case False
-    thus "acute_ang \<bar>\<downharpoonright>arg z2 - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg (cnj z2) - arg (cnj z1)\<downharpoonleft>\<bar>"
-    proof(cases "arg z1 = pi")
+    thus "acute_ang \<bar>\<downharpoonright>Arg z2 - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg (cnj z2) - Arg (cnj z1)\<downharpoonleft>\<bar>"
+    proof(cases "Arg z1 = pi")
       case False
-      hence "arg z2 = pi"
-        using \<open> \<not> (arg z1 \<noteq> pi \<and> arg z2 \<noteq> pi)\<close>
+      hence "Arg z2 = pi"
+        using \<open> \<not> (Arg z1 \<noteq> pi \<and> Arg z2 \<noteq> pi)\<close>
         by auto
       thus ?thesis
         using False
         using arg_cnj_not_pi[of z1] arg_cnj_pi[of z2]
         apply (auto simp del:acute_ang_def)
-      proof(cases "arg z1 > 0")
+      proof(cases "Arg z1 > 0")
           case True
-          hence "-arg z1 \<le> 0"
+          hence "-Arg z1 \<le> 0"
             by auto
-          thus "acute_ang \<bar>\<downharpoonright>pi - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>pi + arg z1\<downharpoonleft>\<bar>"
-            using True canon_ang_plus_pi1[of "arg z1"]
-            using arg_bounded[of z1] canon_ang_plus_pi2[of "-arg z1"]
+          thus "acute_ang \<bar>\<downharpoonright>pi - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>pi + Arg z1\<downharpoonleft>\<bar>"
+            using True canon_ang_plus_pi1[of "Arg z1"]
+            using Arg_bounded[of z1] canon_ang_plus_pi2[of "-Arg z1"]
             by (auto simp add:field_simps)
         next
           case False
-          hence "-arg z1 \<ge> 0"
+          hence "-Arg z1 \<ge> 0"
              by simp
-          thus "acute_ang \<bar>\<downharpoonright>pi - arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>pi + arg z1\<downharpoonleft>\<bar>"
-          proof(cases "arg z1 = 0")
+          thus "acute_ang \<bar>\<downharpoonright>pi - Arg z1\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>pi + Arg z1\<downharpoonleft>\<bar>"
+          proof(cases "Arg z1 = 0")
             case True
             thus ?thesis
               by (auto simp del:acute_ang_def)
           next
             case False
-            hence "-arg z1 > 0"
-              using \<open>-arg z1 \<ge> 0\<close>
+            hence "-Arg z1 > 0"
+              using \<open>-Arg z1 \<ge> 0\<close>
               by auto
             thus ?thesis
-            using False canon_ang_plus_pi1[of "-arg z1"]
-            using arg_bounded[of z1] canon_ang_plus_pi2[of "arg z1"]
+            using False canon_ang_plus_pi1[of "-Arg z1"]
+            using Arg_bounded[of z1] canon_ang_plus_pi2[of "Arg z1"]
             by (auto simp add:field_simps)
         qed
       qed
     next
       case True
       thus ?thesis
         using arg_cnj_pi[of z1]
         apply (auto simp del:acute_ang_def)
-      proof(cases "arg z2 = pi")
+      proof(cases "Arg z2 = pi")
         case True
-        thus "acute_ang \<bar>\<downharpoonright>arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg (cnj z2) - pi\<downharpoonleft>\<bar>"
+        thus "acute_ang \<bar>\<downharpoonright>Arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg (cnj z2) - pi\<downharpoonleft>\<bar>"
           using arg_cnj_pi[of z2]
           by auto
       next
         case False
-        thus "acute_ang \<bar>\<downharpoonright>arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>arg (cnj z2) - pi\<downharpoonleft>\<bar>"
+        thus "acute_ang \<bar>\<downharpoonright>Arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>Arg (cnj z2) - pi\<downharpoonleft>\<bar>"
           using arg_cnj_not_pi[of z2]
           apply (auto simp del:acute_ang_def)
-        proof(cases "arg z2 > 0")
+        proof(cases "Arg z2 > 0")
           case True
-          hence "-arg z2 \<le> 0"
+          hence "-Arg z2 \<le> 0"
             by auto
-          thus "acute_ang \<bar>\<downharpoonright>arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>- arg z2 - pi\<downharpoonleft>\<bar>"
-            using True canon_ang_minus_pi1[of "arg z2"]
-            using arg_bounded[of z2] canon_ang_minus_pi2[of "-arg z2"]
+          thus "acute_ang \<bar>\<downharpoonright>Arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>- Arg z2 - pi\<downharpoonleft>\<bar>"
+            using True canon_ang_minus_pi1[of "Arg z2"]
+            using Arg_bounded[of z2] canon_ang_minus_pi2[of "-Arg z2"]
             by (auto simp add: field_simps)
         next
           case False
-          hence "-arg z2 \<ge> 0"
+          hence "-Arg z2 \<ge> 0"
              by simp
-          thus "acute_ang \<bar>\<downharpoonright>arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>- arg z2 - pi\<downharpoonleft>\<bar>"
-          proof(cases "arg z2 = 0")
+          thus "acute_ang \<bar>\<downharpoonright>Arg z2 - pi\<downharpoonleft>\<bar> = acute_ang \<bar>\<downharpoonright>- Arg z2 - pi\<downharpoonleft>\<bar>"
+          proof(cases "Arg z2 = 0")
             case True
             thus ?thesis
               by (auto simp del:acute_ang_def)
           next
             case False
-            hence "-arg z2 > 0"
-              using \<open>-arg z2 \<ge> 0\<close>
+            hence "-Arg z2 > 0"
+              using \<open>-Arg z2 \<ge> 0\<close>
               by auto
             thus ?thesis
-            using False canon_ang_minus_pi1[of "-arg z2"]
-            using arg_bounded[of z2] canon_ang_minus_pi2[of "arg z2"]
+            using False canon_ang_minus_pi1[of "-Arg z2"]
+            using Arg_bounded[of z2] canon_ang_minus_pi2[of "Arg z2"]
             by (auto simp add:field_simps)
         qed
       qed
     qed
   qed
 qed
 
 text \<open>Cosine and scalar product\<close>
 
 lemma ortho_a_scalprod0:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "\<angle>a z1 z2 = pi/2 \<longleftrightarrow> scalprod z1 z2 = 0"
   unfolding ang_vec_a_def
   using assms ortho_c_scalprod0[of z1 z2]
   by auto
 
 declare ang_vec_c_def[simp del]
 
 lemma cos_a_c: "cos (\<angle>a z1 z2) = abs (cos (\<angle>c z1 z2))"
 proof-
   have "0 \<le> \<angle>c z1 z2" "\<angle>c z1 z2 \<le> pi"
     using ang_vec_c_bounded[of z1 z2]
     by auto
   show ?thesis
   proof (cases "\<angle>c z1 z2 = pi/2")
     case True
     thus ?thesis
       unfolding ang_vec_a_def acute_ang_def
       by (smt cos_pi_half pi_def pi_half)
   next
     case False
     show ?thesis
     proof (cases "\<angle>c z1 z2 < pi / 2")
       case True
       thus ?thesis
         using \<open>0 \<le> \<angle>c z1 z2\<close>
         using cos_gt_zero_pi[of "\<angle>c z1 z2"]
         unfolding ang_vec_a_def
         by simp
     next
       case False
       hence "\<angle>c z1 z2 > pi/2"
         using \<open>\<angle>c z1 z2 \<noteq> pi/2\<close>
         by simp
       hence "cos (\<angle>c z1 z2) < 0"
         using \<open>\<angle>c z1 z2 \<le> pi\<close>
         using cos_lt_zero_on_pi2_pi[of "\<angle>c z1 z2"] 
         by simp
       thus ?thesis
         using \<open>\<angle>c z1 z2 > pi/2\<close>
         unfolding ang_vec_a_def
         by simp
     qed
   qed
 qed
 
 end
diff --git a/thys/Complex_Geometry/Circlines.thy b/thys/Complex_Geometry/Circlines.thy
--- a/thys/Complex_Geometry/Circlines.thy
+++ b/thys/Complex_Geometry/Circlines.thy
@@ -1,2048 +1,2048 @@
 (* ---------------------------------------------------------------------------- *)
 section \<open>Circlines\<close>
 (* ---------------------------------------------------------------------------- *)
 theory Circlines
   imports More_Set Moebius Hermitean_Matrices Elementary_Complex_Geometry
 begin
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Definition of circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>In our formalization we follow the approach described by Schwerdtfeger
 \cite{schwerdtfeger} and represent circlines by Hermitean, non-zero
 $2\times 2$ matrices. In the original formulation, a matrix
 $\left(\begin{array}{cc}A & B\\C & D\end{array}\right)$ corresponds to
 the equation $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D = 0$,
 where $C = \overline{B}$ and $A$ and $D$ are real (as the matrix is
 Hermitean).\<close>
 
 abbreviation hermitean_nonzero where
   "hermitean_nonzero \<equiv> {H. hermitean H \<and> H \<noteq> mat_zero}"
 
 typedef circline_mat = hermitean_nonzero
 by (rule_tac x="eye" in exI) (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
 
 setup_lifting type_definition_circline_mat
 
 
 definition circline_eq_cmat :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> bool" where
  [simp]: "circline_eq_cmat A B \<longleftrightarrow> (\<exists> k::real. k \<noteq> 0 \<and> B = cor k *\<^sub>s\<^sub>m A)"
 
 lemma symp_circline_eq_cmat: "symp circline_eq_cmat"
   unfolding symp_def
 proof ((rule allI)+, rule impI)
   fix x y
   assume "circline_eq_cmat x y"
   then obtain k where "k \<noteq> 0 \<and> y = cor k *\<^sub>s\<^sub>m x"
     by auto
   hence  "1 / k \<noteq> 0 \<and> x = cor (1 / k) *\<^sub>s\<^sub>m y"
     by auto
   thus "circline_eq_cmat y x"
     unfolding circline_eq_cmat_def
     by blast
 qed
 
 text\<open>Hermitean non-zero matrices are equivalent only to such matrices\<close>
 lemma circline_eq_cmat_hermitean_nonzero:
   assumes "hermitean H \<and> H \<noteq> mat_zero" "circline_eq_cmat H H'"
   shows "hermitean H' \<and> H' \<noteq> mat_zero"
   using assms
   by (metis circline_eq_cmat_def hermitean_mult_real nonzero_mult_real of_real_eq_0_iff)
 
 
 lift_definition circline_eq_clmat :: "circline_mat \<Rightarrow> circline_mat \<Rightarrow> bool" is circline_eq_cmat
   done
 
 lemma circline_eq_clmat_refl [simp]: "circline_eq_clmat H H"
   by transfer (simp, rule_tac x="1" in exI, simp)
 
 quotient_type circline = circline_mat / circline_eq_clmat
 proof (rule equivpI)
   show "reflp circline_eq_clmat"
     unfolding reflp_def
     by transfer (auto, rule_tac x="1" in exI, simp)
 next
   show "symp circline_eq_clmat"
     unfolding symp_def
     by transfer (auto, (rule_tac x="1/k" in exI, simp)+)
 next
   show "transp circline_eq_clmat"
     unfolding transp_def
     by transfer (simp, safe, (rule_tac x="ka*k" in exI, simp)+)
 qed
 
 text \<open>Circline with specified matrix\<close>
 
 text \<open>An auxiliary constructor @{term mk_circline} returns a circline (an
 equivalence class) for given four complex numbers $A$, $B$, $C$ and
 $D$ (provided that they form a Hermitean, non-zero matrix).\<close>
 
 definition mk_circline_cmat :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex_mat" where
 [simp]: "mk_circline_cmat A B C D =
           (let M = (A, B, C, D)
             in if M \<in> hermitean_nonzero then
                   M
                else
                   eye)"
 
 lift_definition mk_circline_clmat :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> circline_mat" is mk_circline_cmat
   by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def)
 
 lift_definition mk_circline :: "complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> circline" is mk_circline_clmat
   done
 
 lemma ex_mk_circline:
   shows "\<exists> A B C D. H = mk_circline A B C D \<and> hermitean (A, B, C, D) \<and> (A, B, C, D) \<noteq> mat_zero"
 proof (transfer, transfer)
   fix H
   assume *: "hermitean H \<and> H \<noteq> mat_zero"
   obtain A B C D where "H = (A, B, C, D)"
     by (cases " H", auto)
   hence "circline_eq_cmat H (mk_circline_cmat A B C D) \<and> hermitean (A, B, C, D) \<and> (A, B, C, D) \<noteq> mat_zero"
     using *
     by auto
   thus "\<exists> A B C D. circline_eq_cmat H (mk_circline_cmat A B C D) \<and> hermitean (A, B, C, D) \<and> (A, B, C, D) \<noteq> mat_zero"
     by blast
 qed
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Circline type\<close>
 (* ----------------------------------------------------------------- *)
 
 definition circline_type_cmat :: "complex_mat \<Rightarrow> real" where
   [simp]: "circline_type_cmat H = sgn (Re (mat_det H))"
 
 lift_definition circline_type_clmat :: "circline_mat \<Rightarrow> real" is circline_type_cmat
   done
 
 lift_definition circline_type :: "circline \<Rightarrow> real" is circline_type_clmat
   by transfer (simp, erule exE, simp add: sgn_mult)
 
 lemma circline_type: "circline_type H = -1 \<or> circline_type H = 0 \<or> circline_type H = 1"
   by (transfer, transfer, simp add: sgn_if)
 
 lemma circline_type_mk_circline [simp]:
   assumes "(A, B, C, D) \<in> hermitean_nonzero"
   shows  "circline_type (mk_circline A B C D) = sgn (Re (A*D - B*C))"
   using assms
   by (transfer, transfer, simp)
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Points on the circline\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>Each circline determines a corresponding set of points. Again, a description given in
 homogeneous coordinates is a bit better than the original description defined only for ordinary
 complex numbers. The point with homogeneous coordinates $(z_1, z_2)$ will belong to the set of
 circline points iff $A \cdot z_1\cdot \overline{z_1} + B\cdot \overline{z_1} \cdot z_2 + C\cdot z_1 \cdot\overline{z_2} +
 D\cdot z_2 \cdot \overline{z_2} = 0$. Note that this is a quadratic form determined by a vector of
 homogeneous coordinates and the Hermitean matrix.\<close>
 
 definition on_circline_cmat_cvec :: "complex_mat \<Rightarrow> complex_vec \<Rightarrow> bool" where
   [simp]: "on_circline_cmat_cvec H z \<longleftrightarrow> quad_form z H = 0"
 
 lift_definition on_circline_clmat_hcoords :: "circline_mat \<Rightarrow> complex_homo_coords \<Rightarrow> bool" is on_circline_cmat_cvec
   done
 
 lift_definition on_circline :: "circline \<Rightarrow> complex_homo \<Rightarrow> bool" is on_circline_clmat_hcoords
   by transfer (simp del: quad_form_def, (erule exE)+, simp del: quad_form_def add: quad_form_scale_m quad_form_scale_v)
 
 definition circline_set :: "circline \<Rightarrow> complex_homo set" where
   "circline_set H = {z. on_circline H z}"
 
 lemma circline_set_I [simp]:
   assumes "on_circline H z"
   shows "z \<in> circline_set H"
   using assms
   unfolding circline_set_def
   by auto
 
 abbreviation circline_equation where
   "circline_equation A B C D z1 z2 \<equiv> A*z1*cnj z1 + B*z2*cnj z1 + C*cnj z2*z1 + D*z2*cnj z2 = 0"
 
 lemma on_circline_cmat_cvec_circline_equation:
   "on_circline_cmat_cvec (A, B, C, D) (z1, z2) \<longleftrightarrow> circline_equation A B C D z1 z2"
   by (simp add: vec_cnj_def field_simps)
 
 lemma circline_equation:
   assumes "H = mk_circline A B C D" and "(A, B, C, D) \<in> hermitean_nonzero"
   shows "of_complex z \<in> circline_set H \<longleftrightarrow> circline_equation A B C D z 1"
   using assms
   unfolding circline_set_def
   by simp (transfer, transfer, simp add: vec_cnj_def field_simps)
 
 text \<open>Circlines trough 0 and inf.\<close>
 text \<open>The circline represents a line when $A=0$ or a circle, otherwise.\<close>
 
 definition circline_A0_cmat :: "complex_mat \<Rightarrow> bool" where
   [simp]: "circline_A0_cmat H \<longleftrightarrow> (let (A, B, C, D) = H in A = 0)"
 lift_definition circline_A0_clmat :: "circline_mat \<Rightarrow> bool" is circline_A0_cmat
   done
 lift_definition circline_A0 :: "circline \<Rightarrow> bool" is circline_A0_clmat
   by transfer auto
 
 abbreviation is_line where
   "is_line H \<equiv> circline_A0 H"
 
 abbreviation is_circle where
   "is_circle H \<equiv> \<not> circline_A0 H"
 
 definition circline_D0_cmat :: "complex_mat \<Rightarrow> bool" where
   [simp]: "circline_D0_cmat H \<longleftrightarrow> (let (A, B, C, D) = H in D = 0)"
 lift_definition circline_D0_clmat :: "circline_mat \<Rightarrow> bool" is circline_D0_cmat
   done
 lift_definition circline_D0 :: "circline \<Rightarrow> bool" is circline_D0_clmat
   by transfer auto
 
 lemma inf_on_circline: "on_circline H \<infinity>\<^sub>h \<longleftrightarrow> circline_A0 H"
   by (transfer, transfer, auto simp add: vec_cnj_def)
 
 lemma
   inf_in_circline_set: "\<infinity>\<^sub>h \<in> circline_set H \<longleftrightarrow> is_line H"
   using inf_on_circline
   unfolding circline_set_def
   by simp
 
 lemma zero_on_circline: "on_circline H 0\<^sub>h \<longleftrightarrow> circline_D0 H"
   by (transfer, transfer, auto simp add: vec_cnj_def)
 
 lemma
   zero_in_circline_set: "0\<^sub>h \<in> circline_set H \<longleftrightarrow> circline_D0 H"
   using zero_on_circline
   unfolding circline_set_def
   by simp
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Connection with circles and lines in the classic complex plane\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>Every Euclidean circle and Euclidean line can be represented by a
 circline.\<close>
 
 lemma classic_circline:
   assumes "H = mk_circline A B C D" and "hermitean (A, B, C, D) \<and> (A, B, C, D) \<noteq> mat_zero"
   shows "circline_set H - {\<infinity>\<^sub>h} = of_complex ` circline (Re A) B (Re D)"
 using assms
 unfolding circline_set_def
 proof (safe)
   fix z
   assume "hermitean (A, B, C, D)" "(A, B, C, D) \<noteq> mat_zero" "z \<in> circline (Re A) B (Re D)"
     thus "on_circline (mk_circline A B C D) (of_complex z)"
       using hermitean_elems[of A B C D]
       by (transfer, transfer) (auto simp add: circline_def vec_cnj_def field_simps)
 next
   fix z
   assume "of_complex z = \<infinity>\<^sub>h"
   thus False
     by simp
 next
   fix z
   assume "hermitean (A, B, C, D)" "(A, B, C, D) \<noteq> mat_zero" "on_circline (mk_circline A B C D) z" "z \<notin> of_complex ` circline (Re A) B (Re D)"
   moreover
   have "z \<noteq> \<infinity>\<^sub>h \<longrightarrow> z \<in> of_complex ` circline (Re A) B (Re D)"
   proof
     assume "z \<noteq> \<infinity>\<^sub>h"
     show "z \<in> of_complex ` circline (Re A) B (Re D)"
     proof
       show "z = of_complex (to_complex z)"
         using \<open>z \<noteq> \<infinity>\<^sub>h\<close>
         by simp
     next
       show "to_complex z \<in> circline (Re A) B (Re D)"
         using \<open>on_circline (mk_circline A B C D) z\<close> \<open>z \<noteq> \<infinity>\<^sub>h\<close>
         using \<open>hermitean (A, B, C, D)\<close> \<open>(A, B, C, D) \<noteq> mat_zero\<close>
       proof (transfer, transfer)
         fix A B C D and z :: complex_vec
         obtain z1 z2 where zz: "z = (z1, z2)"
           by (cases z, auto)
         assume *: "z \<noteq> vec_zero"  "\<not> z \<approx>\<^sub>v \<infinity>\<^sub>v"
                   "on_circline_cmat_cvec (mk_circline_cmat A B C D) z"
                   "hermitean (A, B, C, D)" "(A, B, C, D) \<noteq> mat_zero"
         have "z2 \<noteq> 0"
           using \<open>z \<noteq> vec_zero\<close> \<open>\<not> z \<approx>\<^sub>v \<infinity>\<^sub>v\<close>
           using inf_cvec_z2_zero_iff zz
           by blast
         thus "to_complex_cvec z \<in> circline (Re A) B (Re D)"
           using * zz
           using hermitean_elems[of A B C D]
           by (simp add: vec_cnj_def circline_def field_simps)
       qed
     qed
   qed
   ultimately
   show "z = \<infinity>\<^sub>h"
     by simp
 qed
 
 text \<open>The matrix of the circline representing circle determined with center and radius.\<close>
 definition mk_circle_cmat :: "complex \<Rightarrow> real \<Rightarrow> complex_mat" where
   [simp]: "mk_circle_cmat a r = (1, -a, -cnj a, a*cnj a - cor r*cor r)"
 
 lift_definition mk_circle_clmat :: "complex \<Rightarrow> real \<Rightarrow> circline_mat" is mk_circle_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 
 lift_definition mk_circle :: "complex \<Rightarrow> real \<Rightarrow> circline" is mk_circle_clmat
   done
 
 lemma is_circle_mk_circle: "is_circle (mk_circle a r)"
   by (transfer, transfer, simp)
 
 lemma circline_set_mk_circle [simp]:
   assumes "r \<ge> 0"
   shows "circline_set (mk_circle a r) = of_complex ` circle a r"
 proof-
   let ?A = "1" and ?B = "-a" and ?C = "-cnj a" and ?D = "a*cnj a - cor r*cor r"
   have *: "(?A, ?B, ?C, ?D) \<in> {H. hermitean H \<and> H \<noteq> mat_zero}"
     by (simp add: hermitean_def mat_adj_def mat_cnj_def)
   have "mk_circle a r = mk_circline ?A ?B ?C ?D"
     using *
     by (transfer, transfer, simp)
   hence "circline_set (mk_circle a r) - {\<infinity>\<^sub>h} = of_complex ` circline ?A ?B (Re ?D)"
     using classic_circline[of "mk_circle a r" ?A ?B ?C ?D] *
     by simp
   moreover
   have "circline ?A ?B (Re ?D) = circle a r"
     by (rule circline_circle[of ?A "Re ?D" "?B" "circline ?A ?B (Re ?D)" "a" "r*r" r], simp_all add: cmod_square \<open>r \<ge> 0\<close>)
   moreover
   have "\<infinity>\<^sub>h \<notin> circline_set (mk_circle a r)"
     using inf_in_circline_set[of "mk_circle a r"] is_circle_mk_circle[of a r]
     by auto
   ultimately
   show ?thesis
     unfolding circle_def
     by simp
 qed
 
 text \<open>The matrix of the circline representing line determined with two (not equal) complex points.\<close>
 definition mk_line_cmat :: "complex \<Rightarrow> complex \<Rightarrow> complex_mat" where
   [simp]: "mk_line_cmat z1 z2 =
     (if z1 \<noteq> z2 then
           let B = \<i> * (z2 - z1) in (0, B, cnj B, -cnj_mix B z1)
     else
           eye)"
 
 lift_definition mk_line_clmat :: "complex \<Rightarrow> complex \<Rightarrow> circline_mat" is mk_line_cmat
   by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def  split: if_split_asm)
 
 lift_definition mk_line :: "complex \<Rightarrow> complex \<Rightarrow> circline" is mk_line_clmat
   done
 
 lemma circline_set_mk_line [simp]:
   assumes "z1 \<noteq> z2"
   shows "circline_set (mk_line z1 z2) - {\<infinity>\<^sub>h} = of_complex ` line z1 z2"
 proof-
   let ?A = "0" and ?B = "\<i>*(z2 - z1)"
   let ?C = "cnj ?B" and ?D = "-cnj_mix ?B z1"
   have *: "(?A, ?B, ?C, ?D) \<in> {H. hermitean H \<and> H \<noteq> mat_zero}"
     using assms
     by (simp add: hermitean_def mat_adj_def mat_cnj_def)
   have "mk_line z1 z2 = mk_circline ?A ?B ?C ?D"
     using * assms
     by (transfer, transfer, auto simp add: Let_def)
   hence "circline_set (mk_line z1 z2) - {\<infinity>\<^sub>h} = of_complex ` circline ?A ?B (Re ?D)"
     using classic_circline[of "mk_line z1 z2" ?A ?B ?C ?D] *
     by simp
   moreover
   have "circline ?A ?B (Re ?D) = line z1 z2"
     using \<open>z1 \<noteq> z2\<close>
     using circline_line'
     by simp
   ultimately
   show ?thesis
     by simp
 qed
 
 text \<open>The set of points determined by a circline is always 
 either an Euclidean circle or an Euclidean line. \<close>
 
 text \<open>Euclidean circle is determined by its center and radius.\<close>
 type_synonym euclidean_circle = "complex \<times> real"
 
 definition euclidean_circle_cmat :: "complex_mat \<Rightarrow> euclidean_circle" where
   [simp]: "euclidean_circle_cmat H = (let (A, B, C, D) = H in (-B/A, sqrt(Re ((B*C - A*D)/(A*A)))))"
 
 lift_definition euclidean_circle_clmat :: "circline_mat \<Rightarrow> euclidean_circle" is euclidean_circle_cmat
   done
 
 lift_definition euclidean_circle :: "circline \<Rightarrow> euclidean_circle" is euclidean_circle_clmat
 proof transfer
   fix H1 H2
   assume hh: "hermitean H1 \<and> H1 \<noteq> mat_zero" "hermitean H2 \<and> H2 \<noteq> mat_zero"
   obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
     by (cases "H1") auto
   obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
     by (cases "H2") auto
   assume "circline_eq_cmat H1 H2"
   then obtain k where "k \<noteq> 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
     using HH1 HH2
     by auto
   have "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) = (cor k)\<^sup>2 * (B1*C1 - A1*D1)"
     "(cor k * A1 * (cor k * A1)) = (cor k)\<^sup>2 * (A1*A1)"
     by (auto simp add: field_simps power2_eq_square)
   hence "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) /
          (cor k * A1 * (cor k * A1)) = (B1*C1 - A1*D1) / (A1*A1)"
     using \<open>k \<noteq> 0\<close>
     by (simp add: power2_eq_square)
   thus "euclidean_circle_cmat H1 = euclidean_circle_cmat H2"
     using HH1 HH2 * hh
     by auto
 qed
 
 lemma classic_circle:
   assumes "is_circle H" and "(a, r) = euclidean_circle H" and "circline_type H \<le> 0"
   shows "circline_set H = of_complex ` circle a r"
 proof-
   obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) \<noteq> mat_zero"
     using ex_mk_circline[of H]
     by auto
   have "is_real A" "is_real D" "C = cnj B"
     using * hermitean_elems
     by auto
   have "Re (A*D - B*C) \<le> 0"
     using \<open>circline_type H \<le> 0\<close> *
     by simp
 
   hence **: "Re A * Re D \<le> (cmod B)\<^sup>2"
     using \<open>is_real A\<close> \<open>is_real D\<close> \<open>C = cnj B\<close>
     by (simp add: cmod_square)
 
   have "A \<noteq> 0"
     using \<open>is_circle H\<close> * \<open>is_real A\<close>
     by simp (transfer, transfer, simp)
 
   hence "Re A \<noteq> 0"
     using \<open>is_real A\<close>
     by (metis complex_surj zero_complex.code)
 
   have ***: "\<infinity>\<^sub>h \<notin> circline_set H"
     using * inf_in_circline_set[of H] \<open>is_circle H\<close>
     by simp
 
   let ?a = "-B/A"
   let ?r2 = "((cmod B)\<^sup>2 - Re A * Re D) / (Re A)\<^sup>2"
   let ?r = "sqrt ?r2"
 
   have "?a = a \<and> ?r = r"
     using \<open>(a, r) = euclidean_circle H\<close>
     using * \<open>is_real A\<close> \<open>is_real D\<close> \<open>C = cnj B\<close> \<open>A \<noteq> 0\<close>
     apply simp
     apply transfer
     apply transfer
     apply simp
     apply (subst Re_divide_real)
     apply (simp_all add: cmod_square, simp add: power2_eq_square)
     done
 
   show ?thesis
     using * ** *** \<open>Re A \<noteq> 0\<close> \<open>is_real A\<close> \<open>C = cnj B\<close> \<open>?a = a \<and> ?r = r\<close>
     using classic_circline[of H A B C D] assms circline_circle[of "Re A" "Re D" B "circline (Re A) B (Re D)" ?a ?r2 ?r]
     by (simp add: circle_def)
 qed
 
 text \<open>Euclidean line is represented by two points.\<close>
 type_synonym euclidean_line = "complex \<times> complex"
 
 definition euclidean_line_cmat :: "complex_mat \<Rightarrow> euclidean_line" where
  [simp]: "euclidean_line_cmat H =
          (let (A, B, C, D) = H;
               z1 = -(D*B)/(2*B*C);
-              z2 = z1 + \<i> * sgn (if arg B > 0 then -B else B)
+              z2 = z1 + \<i> * sgn (if Arg B > 0 then -B else B)
            in (z1, z2))"
 
 lift_definition euclidean_line_clmat :: "circline_mat \<Rightarrow> euclidean_line" is euclidean_line_cmat
   done
 
 lift_definition euclidean_line :: "circline \<Rightarrow> complex \<times> complex" is euclidean_line_clmat
 proof transfer
   fix H1 H2
   assume hh: "hermitean H1 \<and> H1 \<noteq> mat_zero" "hermitean H2 \<and> H2 \<noteq> mat_zero"
   obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
     by (cases "H1") auto
   obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
     by (cases "H2") auto
   assume "circline_eq_cmat H1 H2"
   then obtain k where "k \<noteq> 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
     using HH1 HH2
     by auto
-  have 1: "B1 \<noteq> 0 \<and> 0 < arg B1 \<longrightarrow> \<not> 0 < arg (- B1)"
-    using canon_ang_plus_pi1[of "arg B1"] arg_bounded[of B1]
+  have 1: "B1 \<noteq> 0 \<and> 0 < Arg B1 \<longrightarrow> \<not> 0 < Arg (- B1)"
+    using canon_ang_plus_pi1[of "Arg B1"] Arg_bounded[of B1]
     by (auto simp add: arg_uminus)
-  have 2: "B1 \<noteq> 0 \<and> \<not> 0 < arg B1 \<longrightarrow> 0 < arg (- B1)"
-    using canon_ang_plus_pi2[of "arg B1"] arg_bounded[of B1]
+  have 2: "B1 \<noteq> 0 \<and> \<not> 0 < Arg B1 \<longrightarrow> 0 < Arg (- B1)"
+    using canon_ang_plus_pi2[of "Arg B1"] Arg_bounded[of B1]
     by (auto simp add: arg_uminus)
 
   show "euclidean_line_cmat H1 = euclidean_line_cmat H2"
     using HH1 HH2 * \<open>k \<noteq> 0\<close>
     by (cases "k > 0") (auto simp add: Let_def, simp_all add: norm_mult sgn_eq 1 2)
 qed
 
 lemma classic_line:
   assumes "is_line H" and "circline_type H < 0" and "(z1, z2) = euclidean_line H"
   shows "circline_set H - {\<infinity>\<^sub>h} = of_complex ` line z1 z2"
 proof-
   obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) \<noteq> mat_zero"
     using ex_mk_circline[of H]
     by auto
   have "is_real A" "is_real D" "C = cnj B"
     using * hermitean_elems
     by auto
   have "Re A = 0"
     using \<open>is_line H\<close> * \<open>is_real A\<close> \<open>is_real D\<close> \<open>C = cnj B\<close>
     by simp (transfer, transfer, simp)
   have "B \<noteq> 0"
     using \<open>Re A = 0\<close>  \<open>is_real A\<close> \<open>is_real D\<close> \<open>C = cnj B\<close> * \<open>circline_type H < 0\<close>
     using circline_type_mk_circline[of A B C D]
     by auto
 
   let ?z1 = "- cor (Re D) * B / (2 * B * cnj B)"
-  let ?z2 = "?z1 + \<i> * sgn (if 0 < arg B then - B else B)"
+  let ?z2 = "?z1 + \<i> * sgn (if 0 < Arg B then - B else B)"
   have "z1 = ?z1 \<and> z2 = ?z2"
     using \<open>(z1, z2) = euclidean_line H\<close> * \<open>is_real A\<close> \<open>is_real D\<close> \<open>C = cnj B\<close>
     by simp (transfer, transfer, simp add: Let_def)
   thus ?thesis
     using *
     using classic_circline[of H A B C D] circline_line[of "Re A" B "circline (Re A) B (Re D)" "Re D" ?z1 ?z2] \<open>Re A = 0\<close> \<open>B \<noteq> 0\<close>
     by simp
 qed
 
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Some special circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Unit circle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 definition unit_circle_cmat :: complex_mat where
   [simp]: "unit_circle_cmat =  (1, 0, 0, -1)"
 lift_definition unit_circle_clmat :: circline_mat is unit_circle_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition unit_circle :: circline is unit_circle_clmat
   done
 
 lemma on_circline_cmat_cvec_unit:
   shows "on_circline_cmat_cvec unit_circle_cmat (z1, z2) \<longleftrightarrow> 
          z1 * cnj z1 = z2 * cnj z2"
   by (simp add: vec_cnj_def field_simps)
 
 lemma
   one_on_unit_circle [simp]: "on_circline unit_circle 1\<^sub>h"  and
   ii_on_unit_circle [simp]: "on_circline unit_circle ii\<^sub>h" and
   not_zero_on_unit_circle [simp]: "\<not> on_circline unit_circle 0\<^sub>h"
   by (transfer, transfer, simp add: vec_cnj_def)+
 
 lemma  
   one_in_unit_circle_set [simp]: "1\<^sub>h \<in> circline_set unit_circle" and
   ii_in_unit_circle_set [simp]: "ii\<^sub>h \<in> circline_set unit_circle" and
   zero_in_unit_circle_set [simp]: "0\<^sub>h \<notin> circline_set unit_circle"
   unfolding circline_set_def
   by simp_all
 
 lemma is_circle_unit_circle [simp]:
   shows "is_circle unit_circle"
   by (transfer, transfer, simp)
 
 lemma not_inf_on_unit_circle' [simp]:
   shows "\<not> on_circline unit_circle \<infinity>\<^sub>h"
   using is_circle_unit_circle inf_on_circline
   by blast
 
 lemma not_inf_on_unit_circle'' [simp]:
   shows "\<infinity>\<^sub>h \<notin> circline_set unit_circle"
   by (simp add: inf_in_circline_set)
 
 lemma euclidean_circle_unit_circle [simp]:
   shows "euclidean_circle unit_circle = (0, 1)"
   by (transfer, transfer, simp)
 
 lemma circline_type_unit_circle [simp]:
   shows "circline_type unit_circle = -1"
   by (transfer, transfer, simp)
 
 lemma on_circline_unit_circle [simp]:
   shows "on_circline unit_circle (of_complex z) \<longleftrightarrow> cmod z = 1"
   by (transfer, transfer, simp add: vec_cnj_def mult.commute)
 
 lemma circline_set_unit_circle [simp]:
   shows "circline_set unit_circle = of_complex ` {z. cmod z = 1}"
 proof-
   show ?thesis
   proof safe
     fix x
     assume "x \<in> circline_set unit_circle"
     then obtain x' where "x = of_complex x'"
       using inf_or_of_complex[of x]
       by auto
     thus "x \<in> of_complex ` {z. cmod z = 1}"
       using \<open>x \<in> circline_set unit_circle\<close>
       unfolding circline_set_def              
       by auto
   next
     fix x
     assume "cmod x = 1"
     thus "of_complex x \<in> circline_set unit_circle"
       unfolding circline_set_def
       by auto
   qed
 qed
 
 lemma circline_set_unit_circle_I [simp]:
   assumes "cmod z = 1"
   shows "of_complex z \<in> circline_set unit_circle"
   using assms
   unfolding circline_set_unit_circle
   by simp
 
 lemma inversion_unit_circle [simp]:
   assumes "on_circline unit_circle x"
   shows "inversion x = x"
 proof-
   obtain x' where "x = of_complex x'" "x' \<noteq> 0"
     using inf_or_of_complex[of x]
     using assms
     by force
   moreover
   hence "x' * cnj x' = 1"
     using assms
     using circline_set_unit_circle
     unfolding circline_set_def
     by auto
   hence "1 / cnj x' = x'"
     using \<open>x' \<noteq> 0\<close>
     by (simp add: field_simps)
   ultimately
   show ?thesis
     using assms
     unfolding inversion_def
     by simp
 qed
 
 lemma inversion_id_iff_on_unit_circle: 
   shows "inversion a = a \<longleftrightarrow> on_circline unit_circle a"
   using inversion_id_iff[of a] inf_or_of_complex[of a]
   by auto
 
 lemma on_unit_circle_conjugate [simp]:
   shows "on_circline unit_circle (conjugate z) \<longleftrightarrow> on_circline unit_circle z"
   by (transfer, transfer, auto simp add: vec_cnj_def field_simps)
 
 lemma conjugate_unit_circle_set [simp]:
   shows "conjugate ` (circline_set unit_circle) = circline_set unit_circle"
   unfolding circline_set_def
   by (auto simp add: image_iff, rule_tac x="conjugate x" in exI, simp)
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>x-axis\<close>
 (* ---------------------------------------------------------------------------- *)
 
 definition x_axis_cmat :: complex_mat where
   [simp]: "x_axis_cmat =  (0, \<i>, -\<i>, 0)"
 lift_definition x_axis_clmat :: circline_mat is x_axis_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition x_axis :: circline is x_axis_clmat
   done
 
 lemma special_points_on_x_axis' [simp]:
   shows "on_circline x_axis 0\<^sub>h" and "on_circline x_axis 1\<^sub>h" and "on_circline x_axis \<infinity>\<^sub>h"
   by (transfer, transfer, simp add: vec_cnj_def)+
 
 lemma special_points_on_x_axis'' [simp]:
   shows "0\<^sub>h \<in> circline_set x_axis" and "1\<^sub>h \<in> circline_set x_axis" and "\<infinity>\<^sub>h \<in> circline_set x_axis"
   unfolding circline_set_def
   by auto
 
 lemma is_line_x_axis [simp]:
   shows "is_line x_axis"
   by (transfer, transfer, simp)
 
 lemma circline_type_x_axis [simp]:
   shows "circline_type x_axis = -1"
   by (transfer, transfer, simp)
 
 lemma on_circline_x_axis:
   shows "on_circline x_axis z \<longleftrightarrow> (\<exists> c. is_real c \<and> z = of_complex c) \<or> z = \<infinity>\<^sub>h"
 proof safe
   fix z c
   assume "is_real c"
   thus "on_circline x_axis (of_complex c)"
   proof (transfer, transfer)
     fix c
     assume "is_real c"
     thus "on_circline_cmat_cvec x_axis_cmat (of_complex_cvec c)"
       using eq_cnj_iff_real[of c]
       by (simp add: vec_cnj_def)
   qed
 next
   fix z
   assume "on_circline x_axis z" "z \<noteq> \<infinity>\<^sub>h"
   thus "\<exists>c. is_real c \<and> z = of_complex c"
   proof (transfer, transfer, safe)
     fix a b
     assume "(a, b) \<noteq> vec_zero"
       "on_circline_cmat_cvec x_axis_cmat (a, b)"
       "\<not> (a, b) \<approx>\<^sub>v \<infinity>\<^sub>v"
     hence "b \<noteq> 0" "cnj a * b = cnj b * a" using inf_cvec_z2_zero_iff
       by (auto simp add: vec_cnj_def)
     thus "\<exists>c. is_real c \<and> (a, b) \<approx>\<^sub>v of_complex_cvec c"
       apply (rule_tac x="a/b" in exI)
       apply (auto simp add: is_real_div field_simps)
       apply (rule_tac x="1/b" in exI, simp)
       done
   qed
 next
   show "on_circline x_axis \<infinity>\<^sub>h"
     by auto
 qed
 
 lemma on_circline_x_axis_I [simp]:
   assumes "is_real z"
   shows "on_circline x_axis (of_complex z)"
   using assms
   unfolding on_circline_x_axis
   by auto
 
 lemma circline_set_x_axis:
   shows "circline_set x_axis = of_complex ` {x. is_real x} \<union> {\<infinity>\<^sub>h}"
   using on_circline_x_axis
   unfolding circline_set_def
   by auto
 
 lemma circline_set_x_axis_I:
   assumes "is_real z"
   shows "of_complex z \<in> circline_set x_axis"
   using assms
   unfolding circline_set_x_axis
   by auto
 
 lemma circline_equation_x_axis:
   shows "of_complex z \<in> circline_set x_axis \<longleftrightarrow> z = cnj z"
   unfolding circline_set_x_axis
 proof auto
   fix x
   assume "of_complex z = of_complex x" "is_real x"
   hence "z = x"
     using of_complex_inj[of z x]
     by simp
   thus "z = cnj z"
     using eq_cnj_iff_real[of z] \<open>is_real x\<close>
     by auto
 next
   assume "z = cnj z"
   thus "of_complex z \<in> of_complex ` {x. is_real x} "
     using eq_cnj_iff_real[of z]
     by auto
 qed
 
 text \<open>Positive and negative part of x-axis\<close>
 
 definition positive_x_axis where
   "positive_x_axis = {z. z \<in> circline_set x_axis \<and> z \<noteq> \<infinity>\<^sub>h \<and> Re (to_complex z) > 0}"
 
 definition negative_x_axis where
   "negative_x_axis = {z. z \<in> circline_set x_axis \<and> z \<noteq> \<infinity>\<^sub>h \<and> Re (to_complex z) < 0}"
 
 lemma circline_set_positive_x_axis_I [simp]:
   assumes "is_real z" and "Re z > 0"
   shows "of_complex z \<in> positive_x_axis"
   using assms
   unfolding positive_x_axis_def
   by simp
 
 lemma circline_set_negative_x_axis_I [simp]:
   assumes "is_real z" and "Re z < 0"
   shows "of_complex z \<in> negative_x_axis"
   using assms
   unfolding negative_x_axis_def
   by simp
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>y-axis\<close>
 (* ---------------------------------------------------------------------------- *)
 
 definition y_axis_cmat :: complex_mat where
   [simp]: "y_axis_cmat = (0, 1, 1, 0)"
 lift_definition y_axis_clmat :: circline_mat is y_axis_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition y_axis :: circline is y_axis_clmat
   done
 
 lemma special_points_on_y_axis' [simp]:
   shows "on_circline y_axis 0\<^sub>h" and "on_circline y_axis ii\<^sub>h" and "on_circline y_axis \<infinity>\<^sub>h"
   by (transfer, transfer, simp add: vec_cnj_def)+
 
 lemma special_points_on_y_axis'' [simp]:
   shows "0\<^sub>h \<in> circline_set y_axis" and "ii\<^sub>h \<in> circline_set y_axis" and "\<infinity>\<^sub>h \<in> circline_set y_axis"
   unfolding circline_set_def
   by auto
 
 lemma on_circline_y_axis: 
   shows "on_circline y_axis z \<longleftrightarrow> (\<exists> c. is_imag c \<and> z = of_complex c) \<or> z = \<infinity>\<^sub>h"
 proof safe
   fix z c
   assume "is_imag c"
   thus "on_circline y_axis (of_complex c)"                                 
   proof (transfer, transfer)
     fix c                                                       
     assume "is_imag c"
     thus "on_circline_cmat_cvec y_axis_cmat (of_complex_cvec c)"
       using eq_minus_cnj_iff_imag[of c]
       by (simp add: vec_cnj_def)
   qed
 next
   fix z
   assume "on_circline y_axis z" "z \<noteq> \<infinity>\<^sub>h"
   thus "\<exists>c. is_imag c \<and> z = of_complex c"
   proof (transfer, transfer, safe)
     fix a b
     assume "(a, b) \<noteq> vec_zero"
       "on_circline_cmat_cvec y_axis_cmat (a, b)"
       "\<not> (a, b) \<approx>\<^sub>v \<infinity>\<^sub>v"
     hence "b \<noteq> 0" "cnj a * b + cnj b * a = 0"
       using inf_cvec_z2_zero_iff
       by (blast, smt add.left_neutral add_cancel_right_right mult.commute mult.left_neutral mult_not_zero on_circline_cmat_cvec_circline_equation y_axis_cmat_def)
     thus "\<exists>c. is_imag c \<and> (a, b) \<approx>\<^sub>v of_complex_cvec c"
       using eq_minus_cnj_iff_imag[of "a / b"]
       apply (rule_tac x="a/b" in exI)
       apply (auto simp add: field_simps)
       apply (rule_tac x="1/b" in exI, simp)
       using add_eq_0_iff apply blast
       apply (rule_tac x="1/b" in exI, simp)
       done
   qed
 next
   show "on_circline y_axis \<infinity>\<^sub>h"
     by simp
 qed
 
 lemma on_circline_y_axis_I [simp]:
   assumes "is_imag z"
   shows "on_circline y_axis (of_complex z)"
   using assms
   unfolding on_circline_y_axis
   by auto
 
 lemma circline_set_y_axis:
   shows "circline_set y_axis = of_complex ` {x. is_imag x} \<union> {\<infinity>\<^sub>h}"
   using on_circline_y_axis
   unfolding circline_set_def
   by auto
 
 lemma circline_set_y_axis_I:
   assumes "is_imag z"
   shows "of_complex z \<in> circline_set y_axis"
   using assms
   unfolding circline_set_y_axis
   by auto
 
 text \<open>Positive and negative part of y-axis\<close>
 
 definition positive_y_axis where
   "positive_y_axis = {z. z \<in> circline_set y_axis \<and> z \<noteq> \<infinity>\<^sub>h \<and> Im (to_complex z) > 0}"
 
 definition negative_y_axis where
   "negative_y_axis = {z. z \<in> circline_set y_axis \<and> z \<noteq> \<infinity>\<^sub>h \<and> Im (to_complex z) < 0}"
 
 lemma circline_set_positive_y_axis_I [simp]:
   assumes "is_imag z" and "Im z > 0"
   shows "of_complex z \<in> positive_y_axis"
   using assms
   unfolding positive_y_axis_def
   by simp
 
 lemma circline_set_negative_y_axis_I [simp]:
   assumes "is_imag z" and "Im z < 0"
   shows "of_complex z \<in> negative_y_axis"
   using assms
   unfolding negative_y_axis_def
   by simp
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Point zero as a circline\<close>
 (* ---------------------------------------------------------------------------- *)
 
 definition circline_point_0_cmat :: complex_mat where
   [simp]: "circline_point_0_cmat =  (1, 0, 0, 0)"
 lift_definition circline_point_0_clmat :: circline_mat is circline_point_0_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition circline_point_0 :: circline is circline_point_0_clmat
   done
 
 lemma circline_type_circline_point_0 [simp]:
   shows "circline_type circline_point_0 = 0"
   by (transfer, transfer, simp)
 
 lemma zero_in_circline_point_0 [simp]:
   shows "0\<^sub>h \<in> circline_set circline_point_0"
   unfolding circline_set_def
   by auto (transfer, transfer, simp add: vec_cnj_def)+
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Imaginary unit circle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 definition imag_unit_circle_cmat :: complex_mat where
   [simp]: "imag_unit_circle_cmat =  (1, 0, 0, 1)"
 lift_definition imag_unit_circle_clmat :: circline_mat is imag_unit_circle_cmat
   by (simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition imag_unit_circle :: circline is imag_unit_circle_clmat
   done
 
 lemma circline_type_imag_unit_circle [simp]:
   shows "circline_type imag_unit_circle = 1"
   by (transfer, transfer, simp)
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Intersection of circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 definition circline_intersection :: "circline \<Rightarrow> circline \<Rightarrow> complex_homo set" where
   "circline_intersection H1 H2 = {z. on_circline H1 z \<and> on_circline H2 z}"
 
 lemma circline_equation_cancel_z2:
   assumes "circline_equation A B C D z1 z2 " and "z2 \<noteq> 0"
   shows "circline_equation A B C D (z1/z2) 1"
   using assms
   by (simp add: field_simps)
 
 lemma circline_equation_quadratic_equation:
   assumes "circline_equation A B (cnj B) D z 1" and 
           "Re z = x" and "Im z = y" and "Re B = bx" and "Im B = by"
   shows "A*x\<^sup>2 + A*y\<^sup>2 + 2*bx*x + 2*by*y + D = 0"
   using assms
 proof-
   have "z = x + \<i>*y" "B = bx + \<i>*by"
     using assms complex_eq
     by auto
   thus ?thesis
     using assms
     by (simp add: field_simps power2_eq_square)
 qed
 
 lemma circline_intersection_symetry:
   shows "circline_intersection H1 H2 = circline_intersection H2 H1"
   unfolding circline_intersection_def
   by auto
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Möbius action on circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 definition moebius_circline_cmat_cmat :: "complex_mat \<Rightarrow> complex_mat \<Rightarrow> complex_mat" where
   [simp]: "moebius_circline_cmat_cmat M H = congruence (mat_inv M) H"
 
 lift_definition moebius_circline_mmat_clmat :: "moebius_mat \<Rightarrow> circline_mat \<Rightarrow> circline_mat" is moebius_circline_cmat_cmat
   using mat_det_inv congruence_nonzero hermitean_congruence
   by simp
 
 lift_definition moebius_circline :: "moebius \<Rightarrow> circline \<Rightarrow> circline" is moebius_circline_mmat_clmat
 proof transfer
   fix M M' H H'
   assume "moebius_cmat_eq M M'" "circline_eq_cmat H H'"
   thus "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M' H')"
     by (auto simp add: mat_inv_mult_sm) (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
 qed
 
 lemma moebius_preserve_circline_type [simp]:                                
   shows "circline_type (moebius_circline M H) = circline_type H"
 proof (transfer, transfer)
   fix M H :: complex_mat
   assume "mat_det M \<noteq> 0" "hermitean H \<and> H \<noteq> mat_zero"
   thus "circline_type_cmat (moebius_circline_cmat_cmat M H) = circline_type_cmat H"
     using Re_det_sgn_congruence[of "mat_inv M" "H"] mat_det_inv[of "M"]
     by (simp del: congruence_def)
 qed
 
 text \<open>The central lemma in this section connects the action of Möbius transformations on points and
 on circlines.\<close>
 
 lemma moebius_circline:
   shows "{z. on_circline (moebius_circline M H) z} =
          moebius_pt M ` {z. on_circline H z}"
 proof safe
   fix z
   assume "on_circline H z"
   thus "on_circline (moebius_circline M H) (moebius_pt M z)"
   proof (transfer, transfer)
     fix z :: complex_vec and M H :: complex_mat
     assume hh: "hermitean H \<and> H \<noteq> mat_zero" "z \<noteq> vec_zero" "mat_det M \<noteq> 0"
     let ?z = "M *\<^sub>m\<^sub>v z"
     let ?H = "mat_adj (mat_inv M) *\<^sub>m\<^sub>m H *\<^sub>m\<^sub>m (mat_inv M)"
     assume *: "on_circline_cmat_cvec H z"
     hence "quad_form z H = 0"
       by simp
     hence "quad_form ?z ?H = 0"
       using quad_form_congruence[of M z H] hh
       by simp
     thus "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
       by simp
   qed
 next
   fix z
   assume "on_circline (moebius_circline M H) z"
   hence "\<exists> z'. z = moebius_pt M z' \<and> on_circline H z'"
   proof (transfer, transfer)
     fix z :: complex_vec and M H :: complex_mat
     assume hh: "hermitean H \<and> H \<noteq> mat_zero" "z \<noteq> vec_zero" "mat_det M \<noteq> 0"
     let ?iM = "mat_inv M"
     let ?z' = "?iM *\<^sub>m\<^sub>v z"
     assume *: "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
     have "?z' \<noteq> vec_zero"
       using hh
       using mat_det_inv mult_mv_nonzero
       by auto
     moreover
     have "z \<approx>\<^sub>v moebius_pt_cmat_cvec M ?z'"
       using hh eye_mv_l mat_inv_r
       by simp
     moreover
     have "M *\<^sub>m\<^sub>v (?iM *\<^sub>m\<^sub>v z) = z"
       using hh eye_mv_l mat_inv_r
       by auto
     hence "on_circline_cmat_cvec H ?z'"
       using hh *
       using quad_form_congruence[of M "?iM *\<^sub>m\<^sub>v z" H, symmetric]
       unfolding moebius_circline_cmat_cmat_def
       unfolding on_circline_cmat_cvec_def
       by simp
     ultimately
     show "\<exists>z'\<in>{v. v \<noteq> vec_zero}. z \<approx>\<^sub>v moebius_pt_cmat_cvec M z' \<and> on_circline_cmat_cvec H z'"
       by blast
   qed
   thus "z \<in> moebius_pt M ` {z. on_circline H z}"
     by auto
 qed
 
 lemma on_circline_moebius_circline_I [simp]:
   assumes "on_circline H z"
   shows "on_circline (moebius_circline M H) (moebius_pt M z)"
   using assms moebius_circline
   by fastforce
 
 lemma circline_set_moebius_circline [simp]:
   shows "circline_set (moebius_circline M H) = moebius_pt M ` circline_set H"
   using moebius_circline[of M H]
   unfolding circline_set_def
   by auto
 
 lemma circline_set_moebius_circline_I [simp]:
   assumes "z \<in> circline_set H"
   shows "moebius_pt M z \<in> circline_set (moebius_circline M H)"
   using assms
   by simp
 
 lemma circline_set_moebius_circline_E:
   assumes "moebius_pt M z \<in> circline_set (moebius_circline M H)"
   shows "z \<in> circline_set H"
   using assms
   using moebius_pt_eq_I[of M z]
   by auto
 
 lemma circline_set_moebius_circline_iff [simp]:
   shows "moebius_pt M z \<in> circline_set (moebius_circline M H) \<longleftrightarrow> 
          z \<in> circline_set H"
   using moebius_pt_eq_I[of M z]
   by auto
 
 lemma inj_moebius_circline:
   shows "inj (moebius_circline M)"
 unfolding inj_on_def
 proof (safe)
   fix H H'
   assume "moebius_circline M H = moebius_circline M H'"
   thus "H = H'"
   proof (transfer, transfer)
     fix M H H' :: complex_mat
     assume hh: "mat_det M \<noteq> 0"
     let ?iM = "mat_inv M"
     assume "circline_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 \<noteq> 0"
       by auto
     thus "circline_eq_cmat H H'"
       using hh inj_congruence[of ?iM H' "cor k *\<^sub>s\<^sub>m H"] mat_det_inv[of M]
       by auto
   qed
 qed
 
 lemma moebius_circline_eq_I:
   assumes "moebius_circline M H1 = moebius_circline M H2"
   shows "H1 = H2"
   using assms inj_moebius_circline[of M]
   unfolding inj_on_def
   by blast
 
 lemma moebius_circline_neq_I [simp]:
   assumes "H1 \<noteq> H2"
   shows "moebius_circline M H1 \<noteq> moebius_circline M H2"
   using assms inj_moebius_circline[of M]
   unfolding inj_on_def
   by blast
 
 (* ---------------------------------------------------------------------------- *)
 subsubsection \<open>Group properties of Möbius action on ciclines\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>Möbius actions on circlines have similar properties as Möbius actions on points.\<close>
 
 lemma moebius_circline_id [simp]:
   shows "moebius_circline id_moebius H = H"
   by (transfer, transfer) (simp add: mat_adj_def mat_cnj_def, rule_tac x=1 in exI, auto)
 
 lemma moebius_circline_comp [simp]:
   shows "moebius_circline (moebius_comp M1 M2) H = moebius_circline M1 (moebius_circline M2 H)"
   by (transfer, transfer) (simp add: mat_inv_mult_mm, rule_tac x=1 in exI, simp add: mult_mm_assoc)
 
 lemma moebius_circline_comp_inv_left [simp]:
   shows "moebius_circline (moebius_inv M) (moebius_circline M H) = H"
   by (subst moebius_circline_comp[symmetric], simp)
 
 lemma moebius_circline_comp_inv_right [simp]:
   shows "moebius_circline M (moebius_circline (moebius_inv M) H) = H"
   by (subst moebius_circline_comp[symmetric], simp)
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Action of Euclidean similarities on circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma moebius_similarity_lines_to_lines [simp]:
   assumes "a \<noteq> 0"
   shows "\<infinity>\<^sub>h \<in> circline_set (moebius_circline (moebius_similarity a b) H) \<longleftrightarrow> 
          \<infinity>\<^sub>h \<in> circline_set H"
   using assms       
   by (metis circline_set_moebius_circline_iff moebius_similarity_inf)
 
 lemma moebius_similarity_lines_to_lines':
   assumes "a \<noteq> 0"
   shows "on_circline (moebius_circline (moebius_similarity a b) H) \<infinity>\<^sub>h \<longleftrightarrow>
          \<infinity>\<^sub>h \<in> circline_set H"
   using moebius_similarity_lines_to_lines assms
   unfolding circline_set_def
   by simp
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Conjugation, recpiprocation and inversion of circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>Conjugation of circlines\<close>
 definition conjugate_circline_cmat :: "complex_mat \<Rightarrow> complex_mat" where
  [simp]: "conjugate_circline_cmat = mat_cnj"
 lift_definition conjugate_circline_clmat :: "circline_mat \<Rightarrow> circline_mat" is conjugate_circline_cmat
   by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition conjugate_circline :: "circline \<Rightarrow> circline" is conjugate_circline_clmat
   by transfer (metis circline_eq_cmat_def conjugate_circline_cmat_def hermitean_transpose mat_t_mult_sm)
 
 lemma conjugate_circline_set':
   shows "conjugate ` circline_set H \<subseteq> circline_set (conjugate_circline H)"
 proof (safe)
   fix z
   assume "z \<in> circline_set H"
   thus "conjugate z \<in> circline_set (conjugate_circline H)"
     unfolding circline_set_def
     apply simp
     apply (transfer, transfer)
     unfolding on_circline_cmat_cvec_def conjugate_cvec_def conjugate_circline_cmat_def
     apply (subst quad_form_vec_cnj_mat_cnj, simp_all)
     done
 qed
 
 lemma conjugate_conjugate_circline [simp]:
   shows "conjugate_circline (conjugate_circline H) = H"
   by (transfer, transfer, force)
 
 lemma circline_set_conjugate_circline [simp]:
   shows "circline_set (conjugate_circline H) = conjugate ` circline_set H" (is "?lhs = ?rhs")
 proof (safe)
   fix z
   assume "z \<in> ?lhs"
   show "z \<in> ?rhs"
   proof
     show "z = conjugate (conjugate z)"
       by simp
   next
     show "conjugate z \<in> circline_set H"
       using \<open>z \<in> circline_set (conjugate_circline H)\<close>
       using conjugate_circline_set'[of "conjugate_circline H"]
       by auto
   qed
 next
   fix z
   assume "z \<in> circline_set H"
   thus "conjugate z \<in> circline_set (conjugate_circline H)"
     using conjugate_circline_set'[of H]
     by auto
 qed
 
 lemma on_circline_conjugate_circline [simp]: 
   shows "on_circline (conjugate_circline H) z \<longleftrightarrow> on_circline H (conjugate z)"
   using circline_set_conjugate_circline[of H]
   unfolding circline_set_def
   by force
 
 text \<open>Inversion of circlines\<close>
 
 definition circline_inversion_cmat :: "complex_mat \<Rightarrow> complex_mat" where
   [simp]:  "circline_inversion_cmat H = (let (A, B, C, D) = H in (D, B, C, A))"
 lift_definition circline_inversion_clmat :: "circline_mat \<Rightarrow> circline_mat" is circline_inversion_cmat
   by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
 lift_definition circline_inversion :: "circline \<Rightarrow> circline" is circline_inversion_clmat
   by transfer auto
 
 lemma on_circline_circline_inversion [simp]:
   shows "on_circline (circline_inversion H) z \<longleftrightarrow> on_circline H (reciprocal (conjugate z))"
   by (transfer, transfer, auto simp add: vec_cnj_def field_simps)
 
 lemma circline_set_circline_inversion [simp]:
   shows "circline_set (circline_inversion H) = inversion ` circline_set H"
   unfolding circline_set_def inversion_def
   by (force simp add: comp_def image_iff)
 
 text \<open>Reciprocal of circlines\<close>
 
 definition circline_reciprocal :: "circline \<Rightarrow> circline" where
   "circline_reciprocal = conjugate_circline \<circ> circline_inversion"
 
 lemma circline_set_circline_reciprocal:
   shows "circline_set (circline_reciprocal H) = reciprocal ` circline_set H"
   unfolding circline_reciprocal_def comp_def
   by (auto simp add: inversion_def image_iff)
 
 text \<open>Rotation of circlines\<close>
 
 lemma rotation_pi_2_y_axis [simp]:
   shows "moebius_circline (moebius_rotation (pi/2)) y_axis = x_axis"
   unfolding moebius_rotation_def moebius_similarity_def
   by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)
 
 lemma rotation_minus_pi_2_y_axis [simp]:
   shows "moebius_circline (moebius_rotation (-pi/2)) y_axis = x_axis"
   unfolding moebius_rotation_def moebius_similarity_def
   by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)
 
 lemma rotation_minus_pi_2_x_axis [simp]:
   shows "moebius_circline (moebius_rotation (-pi/2)) x_axis = y_axis"
   unfolding moebius_rotation_def moebius_similarity_def
   by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)
 
 lemma rotation_pi_2_x_axis [simp]:
   shows "moebius_circline (moebius_rotation (pi/2)) x_axis = y_axis"
   unfolding moebius_rotation_def moebius_similarity_def
   by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)
 
 lemma rotation_minus_pi_2_positive_y_axis [simp]:
   shows "(moebius_pt (moebius_rotation (-pi/2))) ` positive_y_axis = positive_x_axis"
 proof safe
   fix y
   assume y: "y \<in> positive_y_axis"
   have *: "Re (a * \<i> / b) < 0 \<longleftrightarrow> Im (a / b) > 0" for a b
     by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Re_i_times) auto
   from y * show "moebius_pt (moebius_rotation (-pi/2)) y \<in> positive_x_axis"
     unfolding positive_y_axis_def positive_x_axis_def circline_set_def
     unfolding moebius_rotation_def moebius_similarity_def
     apply simp
     apply transfer
     apply transfer
     apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
     done
 next
   fix x
   assume x: "x \<in> positive_x_axis"
   let ?y = "moebius_pt (moebius_rotation (pi/2)) x"
   have *: "Im (a * \<i> / b) > 0 \<longleftrightarrow> Re (a / b) > 0" for a b
     by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Im_i_times) auto
   hence "?y \<in> positive_y_axis"
     using \<open>x \<in> positive_x_axis\<close>
     unfolding positive_x_axis_def positive_y_axis_def
     unfolding moebius_rotation_def moebius_similarity_def
     unfolding circline_set_def
     apply simp
     apply transfer
     apply transfer
     apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
     done
   thus "x \<in> moebius_pt (moebius_rotation (-pi/2)) ` positive_y_axis"
     by (auto simp add: image_iff) (rule_tac x="?y" in bexI, simp_all)
 qed
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Circline uniqueness\<close>
 (* ----------------------------------------------------------------- *)
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Zero type circline uniqueness\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma unique_circline_type_zero_0':
   shows "(circline_type circline_point_0 = 0 \<and> 0\<^sub>h \<in> circline_set circline_point_0) \<and>
          (\<forall> H. circline_type H = 0 \<and> 0\<^sub>h \<in> circline_set H \<longrightarrow> H = circline_point_0)"
 unfolding circline_set_def
 proof (safe)
   show "circline_type circline_point_0 = 0"
     by (transfer, transfer, simp)
 next
   show "on_circline circline_point_0 0\<^sub>h"
     using circline_set_def zero_in_circline_point_0
     by auto
 next
   fix H
   assume "circline_type H = 0" "on_circline H 0\<^sub>h"
   thus "H = circline_point_0"
   proof (transfer, transfer)
     fix H :: complex_mat
     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 *: "C = cnj B" "is_real A"
       using hh hermitean_elems[of A B C D]
       by auto
     assume "circline_type_cmat H = 0" "on_circline_cmat_cvec H 0\<^sub>v"
     thus "circline_eq_cmat H circline_point_0_cmat"
       using HH hh *
       by (simp add: Let_def vec_cnj_def sgn_minus sgn_mult sgn_zero_iff)
          (rule_tac x="1/Re A" in exI, cases A, cases B, simp add: Complex_eq sgn_zero_iff)
   qed
 qed
 
 lemma unique_circline_type_zero_0:
   shows "\<exists>! H. circline_type H = 0 \<and> 0\<^sub>h \<in> circline_set H"
   using unique_circline_type_zero_0'
   by blast
 
 lemma unique_circline_type_zero:
   shows "\<exists>! H. circline_type H = 0 \<and> z \<in> circline_set H"
 proof-
   obtain M where ++: "moebius_pt M z = 0\<^sub>h"
     using ex_moebius_1[of z]
     by auto
   have +++: "z = moebius_pt (moebius_inv M) 0\<^sub>h"
     by (subst ++[symmetric]) simp
   then obtain H0 where *: "circline_type H0 = 0 \<and> 0\<^sub>h \<in> circline_set H0" and
     **: "\<forall> H'. circline_type H' = 0 \<and> 0\<^sub>h \<in> circline_set H' \<longrightarrow> H' = H0"
     using unique_circline_type_zero_0
     by auto
   let ?H' = "moebius_circline (moebius_inv M) H0"
   show ?thesis
     unfolding Ex1_def
     using * +++
   proof (rule_tac x="?H'" in exI, simp, safe)
     fix H'
     assume "circline_type H' = 0" "moebius_pt (moebius_inv M) 0\<^sub>h \<in> circline_set H'"
     hence "0\<^sub>h \<in> circline_set (moebius_circline M H')"
       using ++ +++
       by force
     hence "moebius_circline M H' = H0"
       using **[rule_format, of "moebius_circline M H'"]
       using \<open>circline_type H' = 0\<close>
       by simp
     thus "H' = moebius_circline (moebius_inv M) H0"
       by auto
   qed
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Negative type circline uniqueness\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma unique_circline_01inf':
   shows "0\<^sub>h \<in> circline_set x_axis \<and> 1\<^sub>h \<in> circline_set x_axis \<and> \<infinity>\<^sub>h \<in> circline_set x_axis \<and>
         (\<forall> H. 0\<^sub>h \<in> circline_set H \<and> 1\<^sub>h \<in> circline_set H \<and> \<infinity>\<^sub>h \<in> circline_set H  \<longrightarrow> H = x_axis)"
 proof safe
   fix H
   assume "0\<^sub>h \<in> circline_set H"  "1\<^sub>h \<in> circline_set H" "\<infinity>\<^sub>h \<in> circline_set H"
   thus "H = x_axis"
     unfolding circline_set_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
     have *: "C = cnj B" "A = 0 \<and> D = 0 \<longrightarrow> B \<noteq> 0"
       using hermitean_elems[of A B C D] hh HH
       by auto
     obtain Bx By where "B = Complex Bx By"
       by (cases B) auto
     assume "on_circline_cmat_cvec H 0\<^sub>v" "on_circline_cmat_cvec H 1\<^sub>v" "on_circline_cmat_cvec H \<infinity>\<^sub>v"
     thus "circline_eq_cmat H x_axis_cmat"
       using * HH \<open>C = cnj B\<close> \<open>B = Complex Bx By\<close>
       by (simp add: Let_def vec_cnj_def Complex_eq) (rule_tac x="1/By" in exI, auto)
   qed
 qed simp_all
 
 lemma unique_circline_set:
   assumes "A \<noteq> B" and "A \<noteq> C" and "B \<noteq> C"
   shows "\<exists>! H. A \<in> circline_set H \<and> B \<in> circline_set H \<and> C \<in> circline_set H"
 proof-
   let ?P = "\<lambda> A B C. A \<noteq> B \<and> A \<noteq> C \<and> B \<noteq> C \<longrightarrow> (\<exists>! H. A \<in> circline_set H \<and> B \<in> circline_set H \<and> C \<in> circline_set H)"
   have "?P A B C"
   proof (rule wlog_moebius_01inf[of ?P])
     fix M a b c
     let ?M = "moebius_pt M"
     assume "?P a b c"
     show "?P (?M a) (?M b) (?M c)"
     proof
       assume "?M a \<noteq> ?M b \<and> ?M a \<noteq> ?M c \<and> ?M b \<noteq> ?M c"
       hence "a \<noteq> b" "b \<noteq> c" "a \<noteq> c"
         by auto
       hence "\<exists>!H. a \<in> circline_set H \<and> b \<in> circline_set H \<and> c \<in> circline_set H"
         using \<open>?P a b c\<close>
         by simp
       then obtain H where
         *: "a \<in> circline_set H \<and> b \<in> circline_set H \<and> c \<in> circline_set H" and
         **: "\<forall>H'. a \<in> circline_set H' \<and> b \<in> circline_set H' \<and> c \<in> circline_set H' \<longrightarrow> H' = H"
         unfolding Ex1_def
         by auto
       let ?H' = "moebius_circline M H"
       show "\<exists>! H. ?M a \<in> circline_set H \<and> moebius_pt M b \<in> circline_set H \<and> moebius_pt M c \<in> circline_set H"
         unfolding Ex1_def
       proof (rule_tac x="?H'" in exI, rule)
         show "?M a \<in> circline_set ?H' \<and> ?M b \<in> circline_set ?H' \<and> ?M c \<in> circline_set ?H'"
           using * 
           by auto
       next
         show "\<forall>H'. ?M a \<in> circline_set H' \<and> ?M b \<in> circline_set H' \<and> ?M c \<in> circline_set H' \<longrightarrow> H' = ?H'"
         proof (safe)
           fix H'
           let ?iH' = "moebius_circline (moebius_inv M) H'"
           assume "?M a \<in> circline_set H'" "?M b \<in> circline_set H'" "?M c \<in> circline_set H'"
           hence "a \<in> circline_set ?iH' \<and> b \<in> circline_set ?iH' \<and> c \<in> circline_set ?iH'"
             by simp
           hence "H = ?iH'"
             using **
             by blast
           thus "H' = moebius_circline M H"
             by simp
         qed
       qed
     qed
   next
     show "?P 0\<^sub>h 1\<^sub>h \<infinity>\<^sub>h"
       using unique_circline_01inf'
       unfolding Ex1_def
       by (safe, rule_tac x="x_axis" in exI) auto
   qed fact+
   thus ?thesis
     using assms
     by simp
 qed
 
 lemma zero_one_inf_x_axis [simp]:
   assumes "0\<^sub>h \<in> circline_set H" and "1\<^sub>h \<in> circline_set H" and "\<infinity>\<^sub>h \<in> circline_set H"
   shows "H = x_axis"
   using assms unique_circline_set[of "0\<^sub>h" "1\<^sub>h" "\<infinity>\<^sub>h"]
   by auto
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Circline set cardinality\<close>
 (* ----------------------------------------------------------------- *)
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Diagonal circlines\<close>
 (* ----------------------------------------------------------------- *)
 
 definition is_diag_circline_cmat :: "complex_mat \<Rightarrow> bool" where
  [simp]: "is_diag_circline_cmat H = (let (A, B, C, D) = H in B = 0 \<and> C = 0)"
 lift_definition is_diag_circline_clmat :: "circline_mat \<Rightarrow> bool" is is_diag_circline_cmat
   done
 lift_definition circline_diag :: "circline \<Rightarrow> bool" is is_diag_circline_clmat
   by transfer auto
 
 lemma circline_diagonalize:
   shows "\<exists> M H'. moebius_circline M H = H' \<and> circline_diag 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
   hence HH_elems: "is_real A" "is_real D" "C = cnj B"
     using hermitean_elems[of A B C D] hh
     by auto
   obtain M k1 k2 where *: "mat_det M \<noteq> 0" "unitary M" "congruence M H = (k1, 0, 0, k2)" "is_real k1" "is_real k2"
     using hermitean_diagonizable[of H] hh
     by auto
   have "k1 \<noteq> 0 \<or> k2 \<noteq> 0"
     using \<open>congruence M H = (k1, 0, 0, k2)\<close> hh congruence_nonzero[of H M] \<open>mat_det M \<noteq> 0\<close>
     by auto
   let ?M' = "mat_inv M"
   let ?H' = "(k1, 0, 0, k2)"
   have "circline_eq_cmat (moebius_circline_cmat_cmat ?M' H) ?H' \<and> is_diag_circline_cmat ?H'"
     using *
     by force
   moreover
   have "?H' \<in> hermitean_nonzero"
     using * \<open>k1 \<noteq> 0 \<or> k2 \<noteq> 0\<close> eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2]
     by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
   moreover
   have "mat_det ?M' \<noteq> 0"
     using * mat_det_inv[of M]
     by auto
   ultimately
   show "\<exists>M\<in>{M. mat_det M \<noteq> 0}.
             \<exists>H'\<in>hermitean_nonzero.
                circline_eq_cmat (moebius_circline_cmat_cmat M H) H' \<and> is_diag_circline_cmat H'"
     by blast
 qed
 
 lemma wlog_circline_diag:
   assumes "\<And> H. circline_diag H \<Longrightarrow> P H"
           "\<And> M H. P H \<Longrightarrow> P (moebius_circline M H)"
   shows "P H"
 proof-
   obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
     using circline_diagonalize[of H]
     by auto
   hence "P (moebius_circline M H)"
     using assms(1)
     by simp
   thus ?thesis
     using assms(2)[of "moebius_circline M H" "moebius_inv M"]
     by simp
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Zero type circline set cardinality\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma circline_type_zero_card_eq1_0:
   assumes "circline_type H = 0" and "0\<^sub>h \<in> circline_set H"
   shows "circline_set H = {0\<^sub>h}"
 using assms
 unfolding circline_set_def
 proof(safe)
   fix z
   assume "on_circline H z" "circline_type H = 0" "on_circline H 0\<^sub>h"
   hence "H = circline_point_0"
     using unique_circline_type_zero_0'
     unfolding circline_set_def
     by simp
   thus "z = 0\<^sub>h"
     using \<open>on_circline H z\<close>
     by (transfer, transfer) (case_tac z, case_tac H, force simp add: vec_cnj_def)
 qed
 
 
 lemma circline_type_zero_card_eq1:
   assumes "circline_type H = 0"
   shows "\<exists> z. circline_set H = {z}"
 proof-
   have "\<exists> z. on_circline H z"
     using assms
   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 "C = cnj B" "is_real A" "is_real D"
       using hh hermitean_elems[of A B C D]
       by auto
     assume "circline_type_cmat H = 0"
     hence "mat_det H = 0"
       by (simp add: complex_eq_if_Re_eq hh mat_det_hermitean_real sgn_eq_0_iff)
     hence "A*D = B*C"
       using HH
       by simp
     show "Bex {v. v \<noteq> vec_zero} (on_circline_cmat_cvec H)"
     proof (cases "A \<noteq> 0 \<or> B \<noteq> 0")
       case True
       thus ?thesis
         using HH \<open>A*D = B*C\<close>
         by (rule_tac x="(-B, A)" in bexI) (auto simp add: Let_def vec_cnj_def field_simps)
     next
       case False
       thus ?thesis
         using HH \<open>C = cnj B\<close>
         by (rule_tac x="(1, 0)" in bexI) (simp_all add: Let_def vec_cnj_def)
     qed
   qed
   then obtain z where "on_circline H z"
     by auto
   obtain M where "moebius_pt M z = 0\<^sub>h"
     using ex_moebius_1[of z]
     by auto
   hence "0\<^sub>h \<in> circline_set (moebius_circline M H)"
     using on_circline_moebius_circline_I[OF \<open>on_circline H z\<close>, of M]
     unfolding circline_set_def
     by simp
   hence "circline_set (moebius_circline M H) = {0\<^sub>h}"
     using circline_type_zero_card_eq1_0[of "moebius_circline M H"] \<open>circline_type H = 0\<close>
     by auto
   hence "circline_set H = {z}"
     using \<open>moebius_pt M z = 0\<^sub>h\<close>
     using bij_moebius_pt[of M] bij_image_singleton[of "moebius_pt M" "circline_set H" _ z]
     by simp
   thus ?thesis
     by auto
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Negative type circline set cardinality\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma quad_form_diagonal_iff:
   assumes "k1 \<noteq> 0" and "is_real k1" and "is_real k2" and "Re k1 * Re k2 < 0"
   shows "quad_form (z1, 1) (k1, 0, 0, k2) = 0 \<longleftrightarrow> (\<exists> \<phi>. z1 = rcis (sqrt (Re (-k2 /k1))) \<phi>)"
 proof-
   have "Re (-k2/k1) \<ge> 0"
     using \<open>Re k1 * Re k2 < 0\<close> \<open>is_real k1\<close> \<open>is_real k2\<close> \<open>k1 \<noteq> 0\<close>
     using Re_divide_real[of k1 "-k2"]
     by (smt divide_less_0_iff mult_nonneg_nonneg mult_nonpos_nonpos uminus_complex.simps(1))
 
   have "quad_form (z1, 1) (k1, 0, 0, k2) = 0 \<longleftrightarrow> (cor (cmod z1))\<^sup>2 = -k2 / k1"
     using assms add_eq_0_iff[of k2 "k1*(cor (cmod z1))\<^sup>2"]
     using eq_divide_imp[of k1 "(cor (cmod z1))\<^sup>2" "-k2"]
     by (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod)
   also have "... \<longleftrightarrow> (cmod z1)\<^sup>2 = Re (-k2 /k1)"
     using assms
     apply (subst complex_eq_if_Re_eq)
     using Re_complex_of_real[of "(cmod z1)\<^sup>2"] div_reals
     by auto
   also have "... \<longleftrightarrow> cmod z1 = sqrt (Re (-k2 /k1))"
     by (metis norm_ge_zero real_sqrt_ge_0_iff real_sqrt_pow2 real_sqrt_power)
   also have "... \<longleftrightarrow> (\<exists> \<phi>. z1 = rcis (sqrt (Re (-k2 /k1))) \<phi>)"
-    using rcis_cmod_arg[of z1, symmetric] assms abs_of_nonneg[of "sqrt (Re (-k2/k1))"]
+    using rcis_cmod_Arg[of z1, symmetric] assms abs_of_nonneg[of "sqrt (Re (-k2/k1))"]
     using \<open>Re (-k2/k1) \<ge> 0\<close>
     by auto
   finally show ?thesis
     .
 qed
 
 lemma circline_type_neg_card_gt3_diag:
   assumes "circline_type H < 0" and "circline_diag H"
   shows "\<exists> A B C. A \<noteq> B \<and> A \<noteq> C \<and> B \<noteq> C \<and> {A, B, C} \<subseteq> circline_set H"
   using assms
   unfolding circline_set_def
   apply (simp del: HOL.ex_simps)
 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 HH_elems: "is_real A" "is_real D" "C = cnj B"
     using hermitean_elems[of A B C D] hh
     by auto
   assume "circline_type_cmat H < 0" "is_diag_circline_cmat H"
   hence "B = 0" "C = 0" "Re A * Re D < 0" "A \<noteq> 0"
     using HH \<open>is_real A\<close> \<open>is_real D\<close>
     by auto
 
   let ?x = "sqrt (Re (- D / A))"
   let ?A = "(rcis ?x 0, 1)"
   let ?B = "(rcis ?x (pi/2), 1)"
   let ?C = "(rcis ?x pi, 1)"
   from quad_form_diagonal_iff[OF \<open>A \<noteq> 0\<close> \<open>is_real A\<close> \<open>is_real D\<close> \<open>Re A * Re D < 0\<close>]
   have "quad_form ?A (A, 0, 0, D) = 0"  "quad_form ?B (A, 0, 0, D) = 0"  "quad_form ?C (A, 0, 0, D) = 0"
     by (auto simp del: rcis_zero_arg)
   hence "on_circline_cmat_cvec H ?A \<and> on_circline_cmat_cvec H ?B \<and> on_circline_cmat_cvec H ?C"
     using HH \<open>B = 0\<close> \<open>C = 0\<close>
     by simp
   moreover                                    
   have "Re (D / A) < 0"
     using \<open>Re A * Re D < 0\<close> \<open>A \<noteq> 0\<close> \<open>is_real A\<close> \<open>is_real D\<close>
     using Re_divide_real[of A D]
     by (metis Re_complex_div_lt_0 Re_mult_real div_reals eq_cnj_iff_real is_real_div)
   hence "\<not> ?A \<approx>\<^sub>v ?B \<and> \<not> ?A \<approx>\<^sub>v ?C \<and> \<not> ?B \<approx>\<^sub>v ?C"
     unfolding rcis_def
     by (auto simp add: cis_def complex.corec)
   moreover
   have "?A \<noteq> vec_zero" "?B \<noteq> vec_zero" "?C \<noteq> vec_zero"
     by auto
   ultimately
   show "\<exists>A\<in>{v. v \<noteq> vec_zero}. \<exists>B\<in>{v. v \<noteq> vec_zero}. \<exists>C\<in>{v. v \<noteq> vec_zero}.
             \<not> A \<approx>\<^sub>v B \<and> \<not> A \<approx>\<^sub>v C \<and> \<not> B \<approx>\<^sub>v C \<and>
             on_circline_cmat_cvec H A \<and> on_circline_cmat_cvec H B \<and> on_circline_cmat_cvec H C"
     by blast
 qed
 
 lemma circline_type_neg_card_gt3:
   assumes "circline_type H < 0"
   shows "\<exists> A B C. A \<noteq> B \<and> A \<noteq> C \<and> B \<noteq> C \<and> {A, B, C} \<subseteq> circline_set H"
 proof-
   obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
     using circline_diagonalize[of H] assms
     by auto
   moreover
   hence "circline_type H' < 0"
     using assms moebius_preserve_circline_type
     by auto
   ultimately
   obtain A B C where "A \<noteq> B" "A \<noteq> C" "B \<noteq> C" "{A, B, C} \<subseteq> circline_set H'"
     using circline_type_neg_card_gt3_diag[of H']
     by auto
   let ?iM = "moebius_inv M"
   have "moebius_circline ?iM H' = H"
     using \<open>moebius_circline M H = H'\<close>[symmetric]
     by simp
   let ?A = "moebius_pt ?iM A" and ?B= "moebius_pt ?iM B" and ?C = "moebius_pt ?iM C"
   have "?A \<in> circline_set H"  "?B \<in> circline_set H"  "?C \<in> circline_set H"
     using \<open>moebius_circline ?iM H' = H\<close>[symmetric] \<open>{A, B, C} \<subseteq> circline_set H'\<close>
     by simp_all
   moreover
   have "?A \<noteq> ?B" "?A \<noteq> ?C" "?B \<noteq> ?C"
     using \<open>A \<noteq> B\<close> \<open>A \<noteq> C\<close> \<open>B \<noteq> C\<close>
     by auto
   ultimately
   show ?thesis
     by auto
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Positive type circline set cardinality\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma circline_type_pos_card_eq0_diag:
   assumes "circline_diag H" and "circline_type H > 0"
   shows "circline_set H = {}"
 using assms
 unfolding circline_set_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 HH_elems: "is_real A" "is_real D" "C = cnj B"
     using hermitean_elems[of A B C D] hh
     by auto
   assume "is_diag_circline_cmat H" "0 < circline_type_cmat H"
   hence "B = 0" "C = 0" "Re A * Re D > 0" "A \<noteq> 0"
     using HH \<open>is_real A\<close> \<open>is_real D\<close>
     by auto
   show "\<forall>x\<in>{v. v \<noteq> vec_zero}. \<not> on_circline_cmat_cvec H x"
   proof
     fix x
     assume "x \<in> {v. v \<noteq> vec_zero}"
     obtain x1 x2 where xx: "x = (x1, x2)"
       by (cases x, auto)
     have "(Re A > 0 \<and> Re D > 0) \<or> (Re A < 0 \<and> Re D < 0)"
       using \<open>Re A * Re D > 0\<close>
       by (metis linorder_neqE_linordered_idom mult_eq_0_iff zero_less_mult_pos zero_less_mult_pos2)
     moreover
     have "(Re (x1 * cnj x1) \<ge> 0 \<and> Re (x2 * cnj x2) > 0) \<or> (Re (x1 * cnj x1) > 0 \<and> Re (x2 * cnj x2) \<ge> 0)"
       using \<open>x \<in> {v. v \<noteq> vec_zero}\<close> xx
       apply auto
       apply (simp add: complex_neq_0 power2_eq_square)+
       done
     ultimately
     have "Re A * Re (x1 * cnj x1) + Re D * Re (x2 * cnj x2) \<noteq> 0"
       by (smt mult_neg_pos mult_nonneg_nonneg mult_nonpos_nonneg mult_pos_pos)
     hence "A * (x1 * cnj x1) + D * (x2 * cnj x2) \<noteq> 0"
       using \<open>is_real A\<close> \<open>is_real D\<close>
       by (metis Re_mult_real plus_complex.simps(1) zero_complex.simps(1))
     thus "\<not> on_circline_cmat_cvec H x"
       using HH \<open>B = 0\<close> \<open>C = 0\<close> xx
       by (simp add: vec_cnj_def field_simps)
   qed
 qed
 
 lemma circline_type_pos_card_eq0:
   assumes "circline_type H > 0"
   shows "circline_set H = {}"
 proof-
   obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
     using circline_diagonalize[of H] assms
     by auto
   moreover
   hence "circline_type H' > 0"
     using assms moebius_preserve_circline_type
     by auto
   ultimately
   have "circline_set H' = {}"
     using circline_type_pos_card_eq0_diag[of H']
     by auto
   let ?iM = "moebius_inv M"
   have "moebius_circline ?iM H' = H"
     using \<open>moebius_circline M H = H'\<close>[symmetric]
     by simp
   thus ?thesis
     using \<open>circline_set H' = {}\<close>
     by auto
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Cardinality determines type\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma card_eq1_circline_type_zero:
   assumes "\<exists> z. circline_set H = {z}"
   shows "circline_type H = 0"
 proof (cases "circline_type H < 0")
   case True
   thus ?thesis
     using circline_type_neg_card_gt3[of H] assms
     by auto
 next
   case False
   show ?thesis
   proof (cases "circline_type H > 0")
     case True
     thus ?thesis
       using circline_type_pos_card_eq0[of H] assms
       by auto
   next
     case False
     thus ?thesis
       using \<open>\<not> (circline_type H) < 0\<close>
       by simp
   qed
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Circline set is injective\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma inj_circline_set:
   assumes "circline_set H = circline_set H'" and "circline_set H \<noteq> {}"
   shows "H = H'"
 proof (cases "circline_type H < 0")
   case True
   then obtain A B C where "A \<noteq> B" "A \<noteq> C" "B \<noteq> C" "{A, B, C} \<subseteq> circline_set H"
     using circline_type_neg_card_gt3[of H]
     by auto
   hence "\<exists>!H. A \<in> circline_set H \<and> B \<in> circline_set H \<and> C \<in> circline_set H"
     using unique_circline_set[of A B C]
     by simp
   thus ?thesis
     using \<open>circline_set H = circline_set H'\<close> \<open>{A, B, C} \<subseteq> circline_set H\<close>
     by auto
 next
   case False
   show ?thesis
   proof (cases "circline_type H = 0")
     case True
     moreover
     then obtain A where "{A} = circline_set H"
       using circline_type_zero_card_eq1[of H]
       by auto
     moreover
     hence "circline_type H' = 0"
       using \<open>circline_set H = circline_set H'\<close> card_eq1_circline_type_zero[of H']
       by auto
     ultimately
     show ?thesis
       using unique_circline_type_zero[of A] \<open>circline_set H = circline_set H'\<close>
       by auto
   next
     case False
     hence "circline_type H > 0"
       using \<open>\<not> (circline_type H < 0)\<close>
       by auto
     thus ?thesis
       using \<open>circline_set H \<noteq> {}\<close>  circline_type_pos_card_eq0[of H]
       by auto
   qed
 qed
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Circline points - cross ratio real\<close>
 (* ----------------------------------------------------------------- *)
 
 lemma four_points_on_circline_iff_cross_ratio_real:
   assumes "distinct [z, u, v, w]"
   shows "is_real (to_complex (cross_ratio z u v w)) \<longleftrightarrow> 
          (\<exists> H. {z, u, v, w} \<subseteq> circline_set H)"
 proof-
   have "\<forall> z. distinct [z, u, v, w] \<longrightarrow> is_real (to_complex (cross_ratio z u v w)) \<longleftrightarrow> (\<exists> H. {z, u, v, w} \<subseteq> circline_set H)"
        (is "?P u v w")
   proof (rule wlog_moebius_01inf[of ?P u v w])
     fix M a b c
     assume aa: "?P a b c"
     let ?Ma = "moebius_pt M a" and ?Mb = "moebius_pt M b" and ?Mc = "moebius_pt M c"
     show "?P ?Ma ?Mb ?Mc"
     proof (rule allI, rule impI)
       fix z
       obtain d where *: "z = moebius_pt M d"
         using bij_moebius_pt[of M]
         unfolding bij_def
         by auto
       let ?Md = "moebius_pt M d"
       assume "distinct [z, moebius_pt M a, moebius_pt M b, moebius_pt M c]"
       hence "distinct [a, b, c, d]"
         using *
         by auto
       moreover
       have "(\<exists> H. {d, a, b, c} \<subseteq> circline_set H) \<longleftrightarrow> (\<exists> H. {z, ?Ma, ?Mb, ?Mc} \<subseteq> circline_set H)"
         using *
         apply auto
         apply (rule_tac x="moebius_circline M H" in exI, simp)
         apply (rule_tac x="moebius_circline (moebius_inv M) H" in exI, simp)
         done
       ultimately
       show "is_real (to_complex (cross_ratio z ?Ma ?Mb ?Mc)) = (\<exists>H. {z, ?Ma, ?Mb, ?Mc} \<subseteq> circline_set H)"
         using aa[rule_format, of d] *
         by auto
     qed
   next
     show "?P 0\<^sub>h 1\<^sub>h \<infinity>\<^sub>h"
     proof safe
       fix z
       assume "distinct [z, 0\<^sub>h, 1\<^sub>h, \<infinity>\<^sub>h]"
       hence "z \<noteq> \<infinity>\<^sub>h"
         by auto
       assume "is_real (to_complex (cross_ratio z 0\<^sub>h 1\<^sub>h \<infinity>\<^sub>h))"
       hence "is_real (to_complex z)"
         by simp
       hence "z \<in> circline_set x_axis"
         using of_complex_to_complex[symmetric, OF \<open>z \<noteq> \<infinity>\<^sub>h\<close>]
         using circline_set_x_axis
         by auto
       thus "\<exists>H. {z, 0\<^sub>h, 1\<^sub>h, \<infinity>\<^sub>h} \<subseteq> circline_set H"
         by (rule_tac x=x_axis in exI, auto)
     next
       fix z H
       assume *: "distinct [z, 0\<^sub>h, 1\<^sub>h, \<infinity>\<^sub>h]" "{z, 0\<^sub>h, 1\<^sub>h, \<infinity>\<^sub>h} \<subseteq> circline_set H"
       hence "H = x_axis"
         by auto
       hence "z \<in> circline_set x_axis"
         using *
         by auto
       hence "is_real (to_complex z)"
         using * circline_set_x_axis
         by auto
       thus "is_real (to_complex (cross_ratio z 0\<^sub>h 1\<^sub>h \<infinity>\<^sub>h))"
         by simp
     qed
   next
     show "u \<noteq> v" "v \<noteq> w" "u \<noteq> w"
       using assms
       by auto
   qed
   thus ?thesis
     using assms
     by auto
 qed
 
 (* ----------------------------------------------------------------- *)
 subsection \<open>Symmetric points wrt. circline\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>In the extended complex plane there are no substantial differences between circles and lines,
 so we will consider only one kind of relation and call two points \emph{circline symmetric} if they
 are mapped to one another using either reflection or inversion over arbitrary line or circle. Points
 are symmetric iff the bilinear form of their representation vectors and matrix is zero.\<close>
 
 definition circline_symmetric_cvec_cmat :: "complex_vec \<Rightarrow> complex_vec \<Rightarrow> complex_mat \<Rightarrow> bool" where
   [simp]: "circline_symmetric_cvec_cmat z1 z2 H \<longleftrightarrow> bilinear_form z1 z2 H = 0"
 lift_definition circline_symmetric_hcoords_clmat :: "complex_homo_coords \<Rightarrow> complex_homo_coords \<Rightarrow> circline_mat \<Rightarrow> bool" is circline_symmetric_cvec_cmat
   done
 lift_definition circline_symmetric :: "complex_homo \<Rightarrow> complex_homo \<Rightarrow> circline \<Rightarrow> bool" is circline_symmetric_hcoords_clmat
   apply transfer
   apply (simp del: bilinear_form_def)
   apply (erule exE)+
   apply (simp add: bilinear_form_scale_m bilinear_form_scale_v1 bilinear_form_scale_v2 del: vec_cnj_sv quad_form_def bilinear_form_def)
   done
 
 lemma symmetry_principle [simp]:
   assumes "circline_symmetric z1 z2 H"
   shows "circline_symmetric (moebius_pt M z1) (moebius_pt M z2) (moebius_circline M H)"
   using assms
   by (transfer, transfer, simp del: bilinear_form_def congruence_def)
 
 text \<open>Symmetry wrt. @{term "unit_circle"}\<close>
 lemma circline_symmetric_0inf_disc [simp]:
   shows "circline_symmetric 0\<^sub>h \<infinity>\<^sub>h unit_circle"
   by (transfer, transfer, simp add: vec_cnj_def)
 
 lemma circline_symmetric_inv_homo_disc [simp]:
   shows "circline_symmetric a (inversion a) unit_circle"
   unfolding inversion_def
   by (transfer, transfer) (case_tac a, auto simp add: vec_cnj_def)
 
 lemma circline_symmetric_inv_homo_disc':
   assumes "circline_symmetric a a' unit_circle"
   shows "a' = inversion a"
   unfolding inversion_def
   using assms
 proof (transfer, transfer)
   fix a a'
   assume vz: "a \<noteq> vec_zero" "a' \<noteq> vec_zero"
   obtain a1 a2 where aa: "a = (a1, a2)"
     by (cases a, auto)
   obtain a1' a2' where aa': "a' = (a1', a2')"
     by (cases a', auto)
   assume *: "circline_symmetric_cvec_cmat a a' unit_circle_cmat"
   show "a' \<approx>\<^sub>v (conjugate_cvec \<circ> reciprocal_cvec) a"
   proof (cases "a1' = 0")
     case True
     thus ?thesis
       using aa aa' vz *
       by (auto simp add: vec_cnj_def field_simps)
   next
     case False
     show ?thesis
     proof (cases "a2 = 0")
       case True
       thus ?thesis
         using \<open>a1' \<noteq> 0\<close>
         using aa aa' * vz
         by (simp add:  vec_cnj_def field_simps)
     next
       case False
       thus ?thesis
         using \<open>a1' \<noteq> 0\<close> aa aa' *
         by (simp add: vec_cnj_def field_simps) (rule_tac x="cnj a2 / a1'" in exI, simp add: field_simps)
     qed
   qed
 qed
 
 lemma ex_moebius_circline_x_axis:
   assumes "circline_type H < 0"
   shows "\<exists> M. moebius_circline M H = x_axis"
 proof-
   obtain A B C where *: "A \<noteq> B" "A \<noteq> C" "B \<noteq> C" "on_circline H A" "on_circline H B" "on_circline H C"
     using circline_type_neg_card_gt3[OF assms]
     unfolding circline_set_def
     by auto
   then 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 by blast
   hence "moebius_circline M H = x_axis"
     using *
     by (metis circline_set_I circline_set_moebius_circline rev_image_eqI unique_circline_01inf')
   thus ?thesis
     by blast
 qed
 
 lemma wlog_circline_x_axis:
   assumes "circline_type H < 0"
   assumes "\<And> M H. P H \<Longrightarrow> P (moebius_circline M H)"
   assumes "P x_axis"
   shows "P H"
 proof-
   obtain M where "moebius_circline M H = x_axis"
     using ex_moebius_circline_x_axis[OF assms(1)]
     by blast
   then obtain M' where "moebius_circline M' x_axis = H"
     by (metis moebius_circline_comp_inv_left)
   thus ?thesis
     using assms(2)[of x_axis M'] assms(3)
     by simp
 qed
 
 lemma circline_intersection_at_most_2_points:
   assumes "H1 \<noteq> H2"
   shows "finite (circline_intersection H1 H2) \<and> card (circline_intersection H1 H2) \<le> 2"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   hence "infinite (circline_intersection H1 H2) \<or> card (circline_intersection H1 H2) > 2"
     by auto
   hence "\<exists> A B C. A \<noteq> B \<and> B \<noteq> C \<and> A \<noteq> C \<and> {A, B, C} \<subseteq> circline_intersection H1 H2"
   proof
     assume "card (circline_intersection H1 H2) > 2"
     thus ?thesis
       using card_geq_3_iff_contains_3_elems[of "circline_intersection H1 H2"]
       by auto
   next
     assume "infinite (circline_intersection H1 H2)"
     thus ?thesis
       using infinite_contains_3_elems
       by blast
   qed
   then obtain A B C where "A \<noteq> B" "B \<noteq> C" "A \<noteq> C" "{A, B, C} \<subseteq> circline_intersection H1 H2"
     by blast
   hence "H2 = H1"
     using circline_intersection_def mem_Collect_eq unique_circline_set by fastforce
   thus False
     using assms
     by simp
 qed
               
 end
diff --git a/thys/Complex_Geometry/Elementary_Complex_Geometry.thy b/thys/Complex_Geometry/Elementary_Complex_Geometry.thy
--- a/thys/Complex_Geometry/Elementary_Complex_Geometry.thy
+++ b/thys/Complex_Geometry/Elementary_Complex_Geometry.thy
@@ -1,519 +1,519 @@
 (* ----------------------------------------------------------------- *)
 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)"
+    "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")
+    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)
+           (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)"
+  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>"
+         \<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))"
+         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 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>"
+        \<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)))"
+         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
diff --git a/thys/Complex_Geometry/Moebius.thy b/thys/Complex_Geometry/Moebius.thy
--- a/thys/Complex_Geometry/Moebius.thy
+++ b/thys/Complex_Geometry/Moebius.thy
@@ -1,1535 +1,1535 @@
 (* -------------------------------------------------------------------------- *)
 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 simp: norm_mult)
 
 (* -------------------------------------------------------------------------- *)
 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)"
+  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))"
+  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 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
+        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)
 
 lemma three_fixed_points:
   assumes "z1 \<noteq> z2" and "z1 \<noteq> z3" and "z2 \<noteq> z3"
   assumes "moebius_pt M z1 = z1" and "moebius_pt M z2 = z2" and "moebius_pt M z3 = z3"
   shows "M = id_moebius"
 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)+
 
   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_mk_moebius:
   assumes "is_pole (mk_moebius a b c d) z" and "c \<noteq> 0" and "a*d - b*c \<noteq> 0"
   shows "z = of_complex (-d/c)"
 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 "moebius_pt (?rd + ?r + ?t2) z = \<infinity>\<^sub>h"
     using assms
     unfolding is_pole_def
     apply (subst (asm) moebius_decomposition)
     apply (auto simp add: moebius_comp[symmetric] moebius_translation_def)
     apply (subst moebius_similarity_only_inf_to_inf[of 1 "a/c"], auto)
     done
   hence "moebius_pt (?r + ?t2) z = \<infinity>\<^sub>h"
     using \<open>a*d - b*c \<noteq> 0\<close> \<open>c \<noteq> 0\<close>
     unfolding moebius_rotation_dilatation_def
     by (simp del: moebius_pt_moebius_similarity)
   hence "moebius_pt ?t2 z = 0\<^sub>h"
     by simp
   thus ?thesis
     using moebius_pt_invert[of ?t2 z "0\<^sub>h"]
     by simp ((subst (asm) of_complex_zero[symmetric])+, simp del: of_complex_zero)
 qed
 
 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
diff --git a/thys/Complex_Geometry/More_Complex.thy b/thys/Complex_Geometry/More_Complex.thy
--- a/thys/Complex_Geometry/More_Complex.thy
+++ b/thys/Complex_Geometry/More_Complex.thy
@@ -1,1089 +1,1066 @@
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Library Additions for Complex Numbers\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>Some additional lemmas about complex numbers.\<close>
 
 theory More_Complex
   imports Complex_Main More_Transcendental Canonical_Angle
 begin
 
 text \<open>Conjugation and @{term cis}\<close>
-          
-declare cis_cnj[simp] 
 
-lemma rcis_cnj: 
-  shows "cnj a = rcis (cmod a) (- arg a)"
-  by (subst rcis_cmod_arg[of a, symmetric]) (simp add: rcis_def)
+declare cis_cnj[simp]
 
 lemmas complex_cnj = complex_cnj_diff complex_cnj_mult complex_cnj_add complex_cnj_divide complex_cnj_minus
 
 text \<open>Some properties for @{term complex_of_real}. Also, since it is often used in our
 formalization we abbreviate it to @{term cor}.\<close>
 
 abbreviation cor :: "real \<Rightarrow> complex" where
   "cor \<equiv> complex_of_real"
 
 lemma cmod_cis [simp]:
   assumes "a \<noteq> 0"
-  shows "cor (cmod a) * cis (arg a) = a"
+  shows "of_real (cmod a) * cis (Arg a) = a"
   using assms
-  by (metis rcis_cmod_arg rcis_def)
+  by (metis rcis_cmod_Arg rcis_def)
 
 lemma cis_cmod [simp]:
   assumes "a \<noteq> 0"
-  shows "cis (arg a) * cor (cmod a) = a"
-  using assms cmod_cis[of a]
-  by (simp add: field_simps)
+  shows "cis (Arg a) * of_real (cmod a) = a"
+  by (metis assms cmod_cis mult.commute)
 
 lemma cor_squared:
   shows "(cor x)\<^sup>2 = cor (x\<^sup>2)"
   by (simp add: power2_eq_square)
 
 lemma cor_sqrt_mult_cor_sqrt [simp]:
   shows "cor (sqrt A) * cor (sqrt A) = cor \<bar>A\<bar>"
   by (metis of_real_mult real_sqrt_mult_self)
 
 lemma cor_eq_0: "cor x + \<i> * cor y = 0 \<longleftrightarrow> x = 0 \<and> y = 0"
  by (metis Complex_eq Im_complex_of_real Im_i_times Re_complex_of_real add_cancel_left_left of_real_eq_0_iff plus_complex.sel(2) zero_complex.code)
 
 lemma one_plus_square_neq_zero [simp]:
   shows "1 + (cor x)\<^sup>2 \<noteq> 0"
   by (metis (hide_lams, no_types) of_real_1 of_real_add of_real_eq_0_iff of_real_power power_one sum_power2_eq_zero_iff zero_neq_one)
 
 text \<open>Additional lemmas about @{term Complex} constructor. Following newer versions of Isabelle,
 these should be deprecated.\<close>
 
 lemma complex_real_two [simp]:
   shows "Complex 2 0 = 2"
   by (simp add: Complex_eq)
 
 lemma complex_double [simp]:
   shows "(Complex a b) * 2 = Complex (2*a) (2*b)"
   by (simp add: Complex_eq)
 
-lemma complex_half [simp]: 
+lemma complex_half [simp]:
   shows "(Complex a b) / 2 = Complex (a/2) (b/2)"
   by (subst complex_eq_iff) auto
 
 lemma Complex_scale1:
   shows "Complex (a * b) (a * c) = cor a * Complex b c"
   unfolding complex_of_real_def
   unfolding Complex_eq
   by (auto simp add: field_simps)
 
-lemma Complex_scale2: 
+lemma Complex_scale2:
   shows "Complex (a * c) (b * c) = Complex a b * cor c"
   unfolding complex_of_real_def
   unfolding Complex_eq
   by (auto simp add: field_simps)
 
-lemma Complex_scale3: 
+lemma Complex_scale3:
   shows "Complex (a / b) (a / c) = cor a * Complex (1 / b) (1 / c)"
   unfolding complex_of_real_def
   unfolding Complex_eq
   by (auto simp add: field_simps)
 
 lemma Complex_scale4:
   shows "c \<noteq> 0 \<Longrightarrow> Complex (a / c) (b / c) = Complex a b / cor c"
   unfolding complex_of_real_def
   unfolding Complex_eq
   by (auto simp add: field_simps power2_eq_square)
 
 lemma Complex_Re_express_cnj:
   shows "Complex (Re z) 0 = (z + cnj z) / 2"
   by (cases z) (simp add: Complex_eq)
 
 lemma Complex_Im_express_cnj:
   shows "Complex 0 (Im z) = (z - cnj z)/2"
   by (cases z) (simp add: Complex_eq)
 
 text \<open>Additional properties of @{term cmod}.\<close>
 
 lemma complex_mult_cnj_cmod:
   shows "z * cnj z = cor ((cmod z)\<^sup>2)"
   using complex_norm_square
   by auto
 
-lemma cmod_square: 
+lemma cmod_square:
   shows "(cmod z)\<^sup>2 = Re (z * cnj z)"
   using complex_mult_cnj_cmod[of z]
   by (simp add: power2_eq_square)
 
 lemma cor_cmod_power_4 [simp]:
   shows "cor (cmod z) ^ 4 = (z * cnj z)\<^sup>2"
   by (simp add: complex_mult_cnj_cmod)
 
 lemma cnjE:
   assumes "x \<noteq> 0"
   shows "cnj x = cor ((cmod x)\<^sup>2) / x"
   using complex_mult_cnj_cmod[of x] assms
   by (auto simp add: field_simps)
 
 lemma cmod_cor_divide [simp]:
   shows "cmod (z / cor k) = cmod z / \<bar>k\<bar>"
   by (simp add: norm_divide)
 
 lemma cmod_mult_minus_left_distrib [simp]:
   shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)"
   by (metis norm_mult right_diff_distrib)
 
 lemma cmod_eqI:
   assumes "z1 * cnj z1 = z2 * cnj z2"
   shows "cmod z1 = cmod z2"
   using assms
   by (subst complex_mod_sqrt_Re_mult_cnj)+ auto
 
 lemma cmod_eqE:
   assumes "cmod z1 = cmod z2"
   shows "z1 * cnj z1 = z2 * cnj z2"
   by (simp add: assms complex_mult_cnj_cmod)
 
 lemma cmod_eq_one [simp]:
   shows "cmod a = 1 \<longleftrightarrow> a*cnj a = 1"
   by (metis cmod_eqE cmod_eqI complex_cnj_one monoid_mult_class.mult.left_neutral norm_one)
 
 text \<open>We introduce @{term is_real} (the imaginary part of complex number is zero) and @{term is_imag}
 (real part of complex number is zero) operators and prove some of their properties.\<close>
 
 abbreviation is_real where
   "is_real z \<equiv> Im z = 0"
 
 abbreviation is_imag where
   "is_imag z \<equiv> Re z = 0"
 
 lemma real_imag_0:
-  assumes "is_real a" "is_imag a" 
+  assumes "is_real a" "is_imag a"
   shows "a = 0"
   using assms
   by (simp add: complex.expand)
 
 lemma complex_eq_if_Re_eq:
   assumes "is_real z1" and "is_real z2"
   shows "z1 = z2 \<longleftrightarrow> Re z1 = Re z2"
   using assms
   by (cases z1, cases z2) auto
 
 lemma mult_reals [simp]:
   assumes "is_real a" and "is_real b"
   shows "is_real (a * b)"
   using assms
   by auto
 
 lemma div_reals [simp]:
   assumes "is_real a" and "is_real b"
   shows "is_real (a / b)"
   using assms
   by (simp add: complex_is_Real_iff)
 
 lemma complex_of_real_Re [simp]:
   assumes "is_real k"
   shows "cor (Re k) = k"
   using assms
   by (cases k) (auto simp add: complex_of_real_def)
 
 lemma cor_cmod_real:
   assumes "is_real a"
   shows "cor (cmod a) = a \<or> cor (cmod a) = -a"
   using assms
   unfolding cmod_def
   by (cases "Re a > 0") auto
 
 lemma eq_cnj_iff_real:
   shows "cnj z = z \<longleftrightarrow> is_real z"
   by (cases z) (simp add: Complex_eq)
 
 lemma eq_minus_cnj_iff_imag:
   shows "cnj z = -z \<longleftrightarrow> is_imag z"
   by (cases z) (simp add: Complex_eq)
 
 lemma Re_divide_real:
   assumes "is_real b" and "b \<noteq> 0"
   shows "Re (a / b) = (Re a) / (Re b)"
   using assms
   by (simp add: complex_is_Real_iff)
 
 lemma Re_mult_real:
   assumes "is_real a"
   shows "Re (a * b) = (Re a) * (Re b)"
   using assms
   by simp
 
 lemma Im_mult_real:
   assumes "is_real a"
   shows "Im (a * b) = (Re a) * (Im b)"
   using assms
   by simp
 
 lemma Im_divide_real:
   assumes "is_real b" and "b \<noteq> 0"
   shows "Im (a / b) = (Im a) / (Re b)"
   using assms
   by (simp add: complex_is_Real_iff)
 
 lemma Re_sgn:
   assumes "is_real R"
   shows "Re (sgn R) = sgn (Re R)"
   using assms
   by (metis Re_sgn complex_of_real_Re norm_of_real real_sgn_eq)
 
 lemma is_real_div:
   assumes "b \<noteq> 0"
   shows "is_real (a / b) \<longleftrightarrow> a*cnj b = b*cnj a"
   using assms
   by (metis complex_cnj_divide complex_cnj_zero_iff eq_cnj_iff_real frac_eq_eq mult.commute)
 
 lemma is_real_mult_real:
   assumes "is_real a" and "a \<noteq> 0"
   shows "is_real b \<longleftrightarrow> is_real (a * b)"
   using assms
   by (cases a, auto simp add: Complex_eq)
 
 lemma Im_express_cnj:
   shows "Im z = (z - cnj z) / (2 * \<i>)"
   by (simp add: complex_diff_cnj field_simps)
 
-lemma Re_express_cnj: 
+lemma Re_express_cnj:
   shows "Re z = (z + cnj z) / 2"
   by (simp add: complex_add_cnj)
 
 text \<open>Rotation of complex number for 90 degrees in the positive direction.\<close>
 
 abbreviation rot90 where
   "rot90 z \<equiv> Complex (-Im z) (Re z)"
 
-lemma rot90_ii: 
+lemma rot90_ii:
   shows "rot90 z = z * \<i>"
   by (metis Complex_mult_i complex_surj)
 
 text \<open>With @{term cnj_mix} we introduce scalar product between complex vectors. This operation shows
 to be useful to succinctly express some conditions.\<close>
 
 abbreviation cnj_mix where
   "cnj_mix z1 z2 \<equiv> cnj z1 * z2 + z1 * cnj z2"
 
 abbreviation scalprod where
   "scalprod z1 z2 \<equiv> cnj_mix z1 z2 / 2"
 
 lemma cnj_mix_minus:
   shows "cnj z1*z2 - z1*cnj z2 = \<i> * cnj_mix (rot90 z1) z2"
   by (cases z1, cases z2) (simp add: Complex_eq field_simps)
 
 lemma cnj_mix_minus':
   shows "cnj z1*z2 - z1*cnj z2 = rot90 (cnj_mix (rot90 z1) z2)"
   by (cases z1, cases z2) (simp add: Complex_eq field_simps)
 
 lemma cnj_mix_real [simp]:
   shows "is_real (cnj_mix z1 z2)"
   by (cases z1, cases z2) simp
 
 lemma scalprod_real [simp]:
   shows "is_real (scalprod z1 z2)"
   using cnj_mix_real
   by simp
 
 text \<open>Additional properties of @{term cis} function.\<close>
 
 lemma cis_minus_pi2 [simp]:
   shows "cis (-pi/2) = -\<i>"
   by (simp add: cis_inverse[symmetric])
 
 lemma cis_pi2_minus_x [simp]:
   shows "cis (pi/2 - x) = \<i> * cis(-x)"
   using cis_divide[of "pi/2" x, symmetric]
   using cis_divide[of 0 x, symmetric]
   by simp
 
-lemma cis_pm_pi [simp]: 
+lemma cis_pm_pi [simp]:
   shows "cis (x - pi) = - cis x" and  "cis (x + pi) = - cis x"
   by (simp add: cis.ctr complex_minus)+
 
 
-lemma cis_times_cis_opposite [simp]: 
+lemma cis_times_cis_opposite [simp]:
   shows "cis \<phi> * cis (- \<phi>) = 1"
   by (simp add: cis_mult)
 
 text \<open>@{term cis} repeats only after $2k\pi$\<close>
 lemma cis_eq:
   assumes "cis a = cis b"
   shows "\<exists> k::int. a - b = 2 * k * pi"
   using assms sin_cos_eq[of a b]
   using cis.sel[of a] cis.sel[of b]
   by (cases "cis a", cases "cis b") auto
 
 text \<open>@{term cis} is injective on $(-\pi, \pi]$.\<close>
 lemma cis_inj:
   assumes "-pi < \<alpha>" and "\<alpha> \<le> pi" and "-pi < \<alpha>'" and "\<alpha>' \<le> pi"
   assumes "cis \<alpha> = cis \<alpha>'"
   shows "\<alpha> = \<alpha>'"
   using assms
   by (metis arg_unique sgn_cis)
 
 text \<open>@{term cis} of an angle combined with @{term cis} of the opposite angle\<close>
 
-lemma cis_diff_cis_opposite [simp]: 
+lemma cis_diff_cis_opposite [simp]:
   shows "cis \<phi> - cis (- \<phi>) = 2 * \<i> * sin \<phi>"
   using Im_express_cnj[of "cis \<phi>"]
   by simp
 
 lemma cis_opposite_diff_cis [simp]:
   shows "cis (-\<phi>) - cis (\<phi>) = - 2 * \<i> * sin \<phi>"
   using cis_diff_cis_opposite[of "-\<phi>"]
   by simp
 
-lemma cis_add_cis_opposite [simp]: 
+lemma cis_add_cis_opposite [simp]:
   shows "cis \<phi> + cis (-\<phi>) = 2 * cos \<phi>"
   by (metis cis.sel(1) cis_cnj complex_add_cnj)
 
 text \<open>@{term cis} equal to 1 or -1\<close>
 lemma cis_one [simp]:
   assumes "sin \<phi> = 0" and "cos \<phi> = 1"
   shows "cis \<phi> = 1"
   using assms
   by (auto simp add: cis.ctr one_complex.code)
 
 lemma cis_minus_one [simp]:
   assumes "sin \<phi> = 0" and "cos \<phi> = -1"
   shows "cis \<phi> = -1"
   using assms
   by (auto simp add: cis.ctr Complex_eq_neg_1)
 
 (* -------------------------------------------------------------------------- *)
 subsubsection \<open>Additional properties of complex number argument\<close>
 (* -------------------------------------------------------------------------- *)
 
-text \<open>@{term arg} of real numbers\<close>
+text \<open>@{term Arg} of real numbers\<close>
 
 lemma is_real_arg1:
-  assumes "arg z = 0 \<or> arg z = pi"
+  assumes "Arg z = 0 \<or> Arg z = pi"
   shows "is_real z"
   using assms
-  using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"]
+  using rcis_cmod_Arg[of z] Im_rcis[of "cmod z" "Arg z"]
   by auto
 
 lemma is_real_arg2:
   assumes "is_real z"
-  shows "arg z = 0 \<or> arg z = pi"
+  shows "Arg z = 0 \<or> Arg z = pi"
 proof (cases "z = 0")
   case False
   thus ?thesis
-    using arg_bounded[of z]
-    by (smt (verit, best) Im_sgn assms cis.simps(2) cis_arg div_0 sin_zero_pi_iff)
-qed (auto simp add: arg_zero)
+    using Arg_bounded[of z]
+    by (smt (verit, best) Im_sgn assms cis.simps(2) cis_Arg div_0 sin_zero_pi_iff)
+qed (auto simp add: Arg_zero)
 
 lemma arg_complex_of_real_positive [simp]:
   assumes "k > 0"
-  shows "arg (cor k) = 0"
+  shows "Arg (cor k) = 0"
 proof-
-  have "cos (arg (Complex k 0)) > 0"
+  have "cos (Arg (Complex k 0)) > 0"
     using assms
-    using rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
+    using rcis_cmod_Arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "Arg (Complex k 0)"]
     using cmod_eq_Re by force
   thus ?thesis
     using assms is_real_arg2[of "cor k"]
     unfolding complex_of_real_def
     by auto
 qed
 
 lemma arg_complex_of_real_negative [simp]:
   assumes "k < 0"
-  shows "arg (cor k) = pi"
+  shows "Arg (cor k) = pi"
 proof-
-  have "cos (arg (Complex k 0)) < 0"
-    using \<open>k < 0\<close> rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
+  have "cos (Arg (Complex k 0)) < 0"
+    using \<open>k < 0\<close> rcis_cmod_Arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "Arg (Complex k 0)"]
     by (metis complex.sel(1) mult_less_0_iff norm_not_less_zero)
   thus ?thesis
     using assms is_real_arg2[of "cor k"]
     unfolding complex_of_real_def
     by auto
 qed
 
 lemma arg_0_iff:
-  shows "z \<noteq> 0 \<and> arg z = 0 \<longleftrightarrow> is_real z \<and> Re z > 0"
-  by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
+  shows "z \<noteq> 0 \<and> Arg z = 0 \<longleftrightarrow> is_real z \<and> Re z > 0"
+  by (smt arg_complex_of_real_negative arg_complex_of_real_positive Arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
 
 lemma arg_pi_iff:
-  shows "arg z = pi \<longleftrightarrow> is_real z \<and> Re z < 0"
-  by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
+  shows "Arg z = pi \<longleftrightarrow> is_real z \<and> Re z < 0"
+  by (smt arg_complex_of_real_negative arg_complex_of_real_positive Arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
 
 
-text \<open>@{term arg} of imaginary numbers\<close>
+text \<open>@{term Arg} of imaginary numbers\<close>
 
 lemma is_imag_arg1:
-  assumes "arg z = pi/2 \<or> arg z = -pi/2"
+  assumes "Arg z = pi/2 \<or> Arg z = -pi/2"
   shows "is_imag z"
   using assms
-  using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"]
+  using rcis_cmod_Arg[of z] Re_rcis[of "cmod z" "Arg z"]
   by (metis cos_minus cos_pi_half minus_divide_left mult_eq_0_iff)
 
 lemma is_imag_arg2:
   assumes "is_imag z" and "z \<noteq> 0"
-  shows "arg z = pi/2 \<or> arg z = -pi/2"
-  using arg_bounded assms cos_0_iff_canon cos_arg_i_mult_zero by presburger
+  shows "Arg z = pi/2 \<or> Arg z = -pi/2"
+  using Arg_bounded assms cos_0_iff_canon cos_Arg_i_mult_zero by presburger
 
 lemma arg_complex_of_real_times_i_positive [simp]:
   assumes "k > 0"
-  shows "arg (cor k * \<i>) = pi / 2"
+  shows "Arg (cor k * \<i>) = pi / 2"
 proof-
-  have "sin (arg (Complex 0 k)) > 0"
-    using \<open>k > 0\<close> rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
+  have "sin (Arg (Complex 0 k)) > 0"
+    using \<open>k > 0\<close> rcis_cmod_Arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "Arg (Complex 0 k)"]
     by (smt complex.sel(2) mult_nonneg_nonpos norm_ge_zero)
   thus ?thesis
     using assms is_imag_arg2[of "cor k * \<i>"]
-    using arg_zero complex_of_real_i
+    using Arg_zero complex_of_real_i
     by force
 qed
 
 lemma arg_complex_of_real_times_i_negative [simp]:
   assumes "k < 0"
-  shows "arg (cor k * \<i>) = - pi / 2"
+  shows "Arg (cor k * \<i>) = - pi / 2"
 proof-
-  have "sin (arg (Complex 0 k)) < 0"
-    using \<open>k < 0\<close> rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
+  have "sin (Arg (Complex 0 k)) < 0"
+    using \<open>k < 0\<close> rcis_cmod_Arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "Arg (Complex 0 k)"]
     by (metis complex.sel(2) mult_less_0_iff norm_not_less_zero)
   thus ?thesis
     using assms is_imag_arg2[of "cor k * \<i>"]
-    using arg_zero complex_of_real_i[of k]
+    using Arg_zero complex_of_real_i[of k]
     by (smt complex.sel(1) sin_pi_half sin_zero)
 qed
 
 lemma arg_pi2_iff:
-  shows "z \<noteq> 0 \<and> arg z = pi / 2 \<longleftrightarrow> is_imag z \<and> Im z > 0"
-  by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff)
+  shows "z \<noteq> 0 \<and> Arg z = pi / 2 \<longleftrightarrow> is_imag z \<and> Im z > 0"
+  by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_Arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff)
 
 lemma arg_minus_pi2_iff:
-  shows "z \<noteq> 0 \<and> arg z = - pi / 2 \<longleftrightarrow> is_imag z \<and> Im z < 0"
+  shows "z \<noteq> 0 \<and> Arg z = - pi / 2 \<longleftrightarrow> is_imag z \<and> Im z < 0"
   by (smt arg_pi2_iff complex.expand divide_cancel_right pi_neq_zero is_imag_arg1 is_imag_arg2 zero_complex.simps(1) zero_complex.simps(2))
 
-lemma arg_ii [simp]:
-  shows "arg \<i> = pi/2"
-  by (metis arg_pi2_iff imaginary_unit.sel zero_less_one)
-
-lemma arg_minus_ii [simp]: 
-  shows "arg (-\<i>) = -pi/2"
-proof-
-  have "-\<i> = cis (arg (- \<i>))"
-    using rcis_cmod_arg[of "-\<i>"]
-    by (simp add: rcis_def)
-  hence "cos (arg (-\<i>)) = 0" "sin (arg (-\<i>)) = -1"
-    using cis.simps[of "arg (-\<i>)"]
-    by auto
-  thus ?thesis
-    using cos_0_iff_canon[of "arg (-\<i>)"] arg_bounded[of "-\<i>"]
-    by fastforce
-qed
-
 text \<open>Argument is a canonical angle\<close>
 
 lemma canon_ang_arg:
-  shows "\<downharpoonright>arg z\<downharpoonleft> = arg z"
-  using canon_ang_id[of "arg z"] arg_bounded
+  shows "\<downharpoonright>Arg z\<downharpoonleft> = Arg z"
+  using canon_ang_id[of "Arg z"] Arg_bounded
   by simp
 
 lemma arg_cis:
-  shows "arg (cis \<phi>) = \<downharpoonright>\<phi>\<downharpoonleft>"
+  shows "Arg (cis \<phi>) = \<downharpoonright>\<phi>\<downharpoonleft>"
   using arg_unique canon_ang canon_ang_cos canon_ang_sin cis.ctr sgn_cis by presburger
 
-text \<open>Cosine and sine of @{term arg}\<close>
+text \<open>Cosine and sine of @{term Arg}\<close>
 
 lemma cos_arg:
   assumes "z \<noteq> 0"
-  shows "cos (arg z) = Re z / cmod z"
-  by (metis Complex.Re_sgn cis.simps(1) assms cis_arg)
+  shows "cos (Arg z) = Re z / cmod z"
+  by (metis Complex.Re_sgn cis.simps(1) assms cis_Arg)
 
 lemma sin_arg:
   assumes "z \<noteq> 0"
-  shows "sin (arg z) = Im z / cmod z"
-  by (metis Complex.Im_sgn cis.simps(2) assms cis_arg)
+  shows "sin (Arg z) = Im z / cmod z"
+  by (metis Complex.Im_sgn cis.simps(2) assms cis_Arg)
 
 text \<open>Argument of product\<close>
 
 lemma cis_arg_mult:
   assumes "z1 * z2 \<noteq> 0"
-  shows "cis (arg (z1 * z2)) = cis (arg z1 + arg z2)"
-  by (metis assms cis_arg cis_mult mult_eq_0_iff sgn_mult)
+  shows "cis (Arg (z1 * z2)) = cis (Arg z1 + Arg z2)"
+  by (metis assms cis_Arg cis_mult mult_eq_0_iff sgn_mult)
 
 lemma arg_mult_2kpi:
   assumes "z1 * z2 \<noteq> 0"
-  shows "\<exists> k::int. arg (z1 * z2) = arg z1 + arg z2 + 2*k*pi"
+  shows "\<exists> k::int. Arg (z1 * z2) = Arg z1 + Arg z2 + 2*k*pi"
 proof-
-  have "cis (arg (z1*z2)) = cis (arg z1 + arg z2)"
+  have "cis (Arg (z1*z2)) = cis (Arg z1 + Arg z2)"
     by (rule cis_arg_mult[OF assms])
   thus ?thesis
-    using cis_eq[of "arg (z1*z2)" "arg z1 + arg z2"]
+    using cis_eq[of "Arg (z1*z2)" "Arg z1 + Arg z2"]
     by (auto simp add: field_simps)
 qed
 
 lemma arg_mult:
   assumes "z1 * z2 \<noteq> 0"
-  shows "arg(z1 * z2) = \<downharpoonright>arg z1 + arg z2\<downharpoonleft>"
+  shows "Arg(z1 * z2) = \<downharpoonright>Arg z1 + Arg z2\<downharpoonleft>"
 proof-
-  obtain k::int where "arg(z1 * z2) = arg z1 + arg z2 + 2*k*pi"
+  obtain k::int where "Arg(z1 * z2) = Arg z1 + Arg z2 + 2*k*pi"
     using arg_mult_2kpi[of z1 z2]
     using assms
     by auto
-  hence "\<downharpoonright>arg(z1 * z2)\<downharpoonleft> = \<downharpoonright>arg z1 + arg z2\<downharpoonleft>"
+  hence "\<downharpoonright>Arg(z1 * z2)\<downharpoonleft> = \<downharpoonright>Arg z1 + Arg z2\<downharpoonleft>"
     using canon_ang_eq
     by(simp add:field_simps)
   thus ?thesis
     using canon_ang_arg[of "z1*z2"]
     by auto
 qed
 
 lemma arg_mult_real_positive [simp]:
   assumes "k > 0"
-  shows "arg (cor k * z) = arg z"
+  shows "Arg (cor k * z) = Arg z"
 proof (cases "z = 0")
   case False
   thus ?thesis
     using arg_mult assms canon_ang_arg by force
-qed (auto simp: arg_zero)
+qed (auto simp: Arg_zero)
 
 lemma arg_mult_real_negative [simp]:
   assumes "k < 0"
-  shows "arg (cor k * z) = arg (-z)"
+  shows "Arg (cor k * z) = Arg (-z)"
 proof (cases "z = 0")
   case False
   thus ?thesis
     using assms
     by (metis arg_mult_real_positive minus_mult_commute neg_0_less_iff_less of_real_minus minus_minus)
-qed (auto simp: arg_zero)
+qed (auto simp: Arg_zero)
 
 lemma arg_div_real_positive [simp]:
   assumes "k > 0"
-  shows "arg (z / cor k) = arg z"
+  shows "Arg (z / cor k) = Arg z"
 proof(cases "z = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
   thus ?thesis
     using assms
     using arg_mult_real_positive[of "1/k" z]
     by auto
 qed
 
 lemma arg_div_real_negative [simp]:
   assumes "k < 0"
-  shows "arg (z / cor k) = arg (-z)"
+  shows "Arg (z / cor k) = Arg (-z)"
 proof(cases "z = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
   thus ?thesis
     using assms
     using arg_mult_real_negative[of "1/k" z]
     by auto
 qed
 
 lemma arg_mult_eq:
   assumes "z * z1 \<noteq> 0" and "z * z2 \<noteq> 0"
-  assumes "arg (z * z1) = arg (z * z2)"
-  shows "arg z1 = arg z2"
-  by (metis (no_types, lifting) arg_cis assms canon_ang_arg cis_arg mult_eq_0_iff nonzero_mult_div_cancel_left sgn_divide)
+  assumes "Arg (z * z1) = Arg (z * z2)"
+  shows "Arg z1 = Arg z2"
+  by (metis (no_types, lifting) arg_cis assms canon_ang_arg cis_Arg mult_eq_0_iff nonzero_mult_div_cancel_left sgn_divide)
 
 text \<open>Argument of conjugate\<close>
 
 lemma arg_cnj_pi:
-  assumes "arg z = pi"
-  shows "arg (cnj z) = pi"
+  assumes "Arg z = pi"
+  shows "Arg (cnj z) = pi"
   using arg_pi_iff assms by auto
 
 lemma arg_cnj_not_pi:
-  assumes "arg z \<noteq> pi"
-  shows "arg (cnj z) = -arg z"
-proof(cases "arg z = 0")
+  assumes "Arg z \<noteq> pi"
+  shows "Arg (cnj z) = -Arg z"
+proof(cases "Arg z = 0")
   case True
   thus ?thesis
     using eq_cnj_iff_real[of z] is_real_arg1[of z] by force
 next
   case False
-  have "arg (cnj z) = arg z \<or> arg(cnj z) = -arg z"
-    using arg_bounded[of z] arg_bounded[of "cnj z"]
+  have "Arg (cnj z) = Arg z \<or> Arg(cnj z) = -Arg z"
+    using Arg_bounded[of z] Arg_bounded[of "cnj z"]
     by (smt (verit, best) arccos_cos arccos_cos2 cnj.sel(1) complex_cnj_zero_iff complex_mod_cnj cos_arg)
   moreover
-  have "arg (cnj z) \<noteq> arg z"
-    using sin_0_iff_canon[of "arg (cnj z)"] arg_bounded False assms
-    by (metis complex_mod_cnj eq_cnj_iff_real is_real_arg2 rcis_cmod_arg)
+  have "Arg (cnj z) \<noteq> Arg z"
+    using sin_0_iff_canon[of "Arg (cnj z)"] Arg_bounded False assms
+    by (metis complex_mod_cnj eq_cnj_iff_real is_real_arg2 rcis_cmod_Arg)
   ultimately
   show ?thesis
     by auto
 qed
 
 text \<open>Argument of reciprocal\<close>
 
 lemma arg_inv_not_pi:
-  assumes "z \<noteq> 0" and "arg z \<noteq> pi"
-  shows "arg (1 / z) = - arg z"
-proof-
-  have "1/z = cnj z / cor ((cmod z)\<^sup>2 )"
-    using \<open>z \<noteq> 0\<close> complex_mult_cnj_cmod[of z]
-    by (auto simp add:field_simps)
-  thus ?thesis
-    using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \<open>z \<noteq> 0\<close>
-    using arg_cnj_not_pi[of z] \<open>arg z \<noteq> pi\<close>
-    by auto
-qed
-
-lemma arg_inv_pi:
-  assumes "z \<noteq> 0" and "arg z = pi"
-  shows "arg (1 / z) = pi"
+  assumes "z \<noteq> 0" and "Arg z \<noteq> pi"
+  shows "Arg (1 / z) = - Arg z"
 proof-
   have "1/z = cnj z / cor ((cmod z)\<^sup>2 )"
     using \<open>z \<noteq> 0\<close> complex_mult_cnj_cmod[of z]
     by (auto simp add:field_simps)
   thus ?thesis
     using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \<open>z \<noteq> 0\<close>
-    using arg_cnj_pi[of z] \<open>arg z = pi\<close>
+    using arg_cnj_not_pi[of z] \<open>Arg z \<noteq> pi\<close>
+    by auto
+qed
+
+lemma arg_inv_pi:
+  assumes "z \<noteq> 0" and "Arg z = pi"
+  shows "Arg (1 / z) = pi"
+proof-
+  have "1/z = cnj z / cor ((cmod z)\<^sup>2 )"
+    using \<open>z \<noteq> 0\<close> complex_mult_cnj_cmod[of z]
+    by (auto simp add:field_simps)
+  thus ?thesis
+    using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \<open>z \<noteq> 0\<close>
+    using arg_cnj_pi[of z] \<open>Arg z = pi\<close>
     by auto
 qed
 
 lemma arg_inv_2kpi:
   assumes "z \<noteq> 0"
-  shows "\<exists> k::int. arg (1 / z) = - arg z + 2*k*pi"
+  shows "\<exists> k::int. Arg (1 / z) = - Arg z + 2*k*pi"
   using arg_inv_pi[OF assms]
   using arg_inv_not_pi[OF assms]
-  by (cases "arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp)
+  by (cases "Arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp)
 
 lemma arg_inv:
   assumes "z \<noteq> 0"
-  shows "arg (1 / z) = \<downharpoonright>- arg z\<downharpoonleft>"
+  shows "Arg (1 / z) = \<downharpoonright>- Arg z\<downharpoonleft>"
   by (metis arg_inv_not_pi arg_inv_pi assms canon_ang_arg canon_ang_uminus_pi)
 
 text \<open>Argument of quotient\<close>
 
 lemma arg_div_2kpi:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
-  shows "\<exists> k::int. arg (z1 / z2) = arg z1 - arg z2 + 2*k*pi"
+  shows "\<exists> k::int. Arg (z1 / z2) = Arg z1 - Arg z2 + 2*k*pi"
 proof-
-  obtain x1 where "arg (z1 * (1 / z2)) = arg z1 + arg (1 / z2) + 2 * real_of_int x1 * pi"
+  obtain x1 where "Arg (z1 * (1 / z2)) = Arg z1 + Arg (1 / z2) + 2 * real_of_int x1 * pi"
     using assms arg_mult_2kpi[of z1 "1/z2"]
     by auto
   moreover
-  obtain x2 where "arg (1 / z2) = - arg z2 + 2 * real_of_int x2 * pi"
+  obtain x2 where "Arg (1 / z2) = - Arg z2 + 2 * real_of_int x2 * pi"
     using assms arg_inv_2kpi[of z2]
     by auto
   ultimately
   show ?thesis
     by (rule_tac x="x1 + x2" in exI, simp add: field_simps)
 qed
 
 lemma arg_div:
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
-  shows "arg(z1 / z2) = \<downharpoonright>arg z1 - arg z2\<downharpoonleft>"
+  shows "Arg(z1 / z2) = \<downharpoonright>Arg z1 - Arg z2\<downharpoonleft>"
 proof-
-  obtain k::int where "arg(z1 / z2) = arg z1 - arg z2 + 2*k*pi"
+  obtain k::int where "Arg(z1 / z2) = Arg z1 - Arg z2 + 2*k*pi"
     using arg_div_2kpi[of z1 z2]
     using assms
     by auto
-  hence "canon_ang(arg(z1 / z2)) = canon_ang(arg z1 - arg z2)"
+  hence "canon_ang(Arg(z1 / z2)) = canon_ang(Arg z1 - Arg z2)"
     using canon_ang_eq
     by(simp add:field_simps)
   thus ?thesis
     using canon_ang_arg[of "z1/z2"]
     by auto
 qed
 
 text \<open>Argument of opposite\<close>
 
 lemma arg_uminus:
   assumes "z \<noteq> 0"
-  shows "arg (-z) = \<downharpoonright>arg z + pi\<downharpoonleft>"
+  shows "Arg (-z) = \<downharpoonright>Arg z + pi\<downharpoonleft>"
   using assms
   using arg_mult[of "-1" z]
   using arg_complex_of_real_negative[of "-1"]
   by (auto simp add: field_simps)
 
 lemma arg_uminus_opposite_sign:
   assumes "z \<noteq> 0"
-  shows "arg z > 0 \<longleftrightarrow> \<not> arg (-z) > 0"
-proof (cases "arg z = 0")
+  shows "Arg z > 0 \<longleftrightarrow> \<not> Arg (-z) > 0"
+proof (cases "Arg z = 0")
   case True
   thus ?thesis
     using assms
     by (simp add: arg_uminus)
 next
   case False
   show ?thesis
-  proof (cases "arg z > 0")
+  proof (cases "Arg z > 0")
     case True
     thus ?thesis
       using assms
-      using arg_bounded[of z]
-      using canon_ang_plus_pi1[of "arg z"]
+      using Arg_bounded[of z]
+      using canon_ang_plus_pi1[of "Arg z"]
       by (simp add: arg_uminus)
   next
     case False
     thus ?thesis
-      using \<open>arg z \<noteq> 0\<close>
+      using \<open>Arg z \<noteq> 0\<close>
       using assms
-      using arg_bounded[of z]
-      using canon_ang_plus_pi2[of "arg z"]
+      using Arg_bounded[of z]
+      using canon_ang_plus_pi2[of "Arg z"]
       by (simp add: arg_uminus)
   qed
 qed
 
 text \<open>Sign of argument is the same as the sign of the Imaginary part\<close>
 
 lemma arg_Im_sgn:
   assumes "\<not> is_real z"
-  shows "sgn (arg z) = sgn (Im z)"
+  shows "sgn (Arg z) = sgn (Im z)"
 proof-
   have "z \<noteq> 0"
     using assms
     by auto
-  then obtain r \<phi> where polar: "z = cor r * cis \<phi>" "\<phi> = arg z" "r > 0"
+  then obtain r \<phi> where polar: "z = cor r * cis \<phi>" "\<phi> = Arg z" "r > 0"
     by (smt cmod_cis mult_eq_0_iff norm_ge_zero of_real_0)
   hence "Im z = r * sin \<phi>"
     by (metis Im_mult_real Re_complex_of_real cis.simps(2) Im_complex_of_real)
   hence  "Im z > 0 \<longleftrightarrow> sin \<phi> > 0" "Im z < 0 \<longleftrightarrow> sin \<phi> < 0"
     using \<open>r > 0\<close>
     using mult_pos_pos mult_nonneg_nonneg zero_less_mult_pos mult_less_cancel_left
     by smt+
   moreover
   have "\<phi> \<noteq> pi" "\<phi> \<noteq> 0"
     using \<open>\<not> is_real z\<close> polar cis_pi
     by force+
   hence "sin \<phi> > 0 \<longleftrightarrow> \<phi> > 0" "\<phi> < 0 \<longleftrightarrow> sin \<phi> < 0"
-    using \<open>\<phi> = arg z\<close> \<open>\<phi> \<noteq> 0\<close> \<open>\<phi> \<noteq> pi\<close>
-    using arg_bounded[of z]
+    using \<open>\<phi> = Arg z\<close> \<open>\<phi> \<noteq> 0\<close> \<open>\<phi> \<noteq> pi\<close>
+    using Arg_bounded[of z]
     by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
   ultimately
   show ?thesis
-    using \<open>\<phi> = arg z\<close>
+    using \<open>\<phi> = Arg z\<close>
     by auto
 qed
 
 
 subsubsection \<open>Complex square root\<close>
 
 definition
-  "ccsqrt z = rcis (sqrt (cmod z)) (arg z / 2)"
+  "ccsqrt z = rcis (sqrt (cmod z)) (Arg z / 2)"
 
 lemma square_ccsqrt [simp]:
   shows "(ccsqrt x)\<^sup>2 = x"
   unfolding ccsqrt_def
-  by (subst DeMoivre2) (simp add: rcis_cmod_arg)
+  by (subst DeMoivre2) (simp add: rcis_cmod_Arg)
 
 lemma ex_complex_sqrt:
   shows "\<exists> s::complex. s*s = z"
   unfolding power2_eq_square[symmetric]
   by (rule_tac x="csqrt z" in exI) simp
 
 lemma ccsqrt:
   assumes "s * s = z"
   shows "s = ccsqrt z \<or> s = -ccsqrt z"
 proof (cases "s = 0")
   case True
   thus ?thesis
     using assms
     unfolding ccsqrt_def
     by simp
 next
   case False
-  then obtain k::int where "cmod s * cmod s = cmod z" "2 * arg s - arg z = 2*k*pi"
+  then obtain k::int where "cmod s * cmod s = cmod z" "2 * Arg s - Arg z = 2*k*pi"
     using assms
-    using rcis_cmod_arg[of z] rcis_cmod_arg[of s]
+    using rcis_cmod_Arg[of z] rcis_cmod_Arg[of s]
     using arg_mult[of s s]
-    using canon_ang(3)[of "2*arg s"]
+    using canon_ang(3)[of "2*Arg s"]
     by (auto simp add: norm_mult arg_mult)
   have *: "sqrt (cmod z) = cmod s"
     using \<open>cmod s * cmod s = cmod z\<close>
     by (smt norm_not_less_zero real_sqrt_abs2)
 
-  have **: "arg z / 2 = arg s - k*pi"
-    using \<open>2 * arg s - arg z = 2*k*pi\<close>
+  have **: "Arg z / 2 = Arg s - k*pi"
+    using \<open>2 * Arg s - Arg z = 2*k*pi\<close>
     by simp
 
-  have "cis (arg s - k*pi) = cis (arg s) \<or> cis (arg s - k*pi) = -cis (arg s)"
+  have "cis (Arg s - k*pi) = cis (Arg s) \<or> cis (Arg s - k*pi) = -cis (Arg s)"
   proof (cases "even k")
     case True
-    hence "cis (arg s - k*pi) = cis (arg s)"
+    hence "cis (Arg s - k*pi) = cis (Arg s)"
       by (simp add: cis_def complex.corec cos_diff sin_diff)
     thus ?thesis
       by simp
   next
     case False
-    hence "cis (arg s - k*pi) = -cis (arg s)"
+    hence "cis (Arg s - k*pi) = -cis (Arg s)"
       by (simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
     thus ?thesis
       by simp
   qed
   thus ?thesis
   proof
-    assume ***: "cis (arg s - k * pi) = cis (arg s)"
+    assume ***: "cis (Arg s - k * pi) = cis (Arg s)"
     hence "s = ccsqrt z"
-      using rcis_cmod_arg[of s]
+      using rcis_cmod_Arg[of s]
       unfolding ccsqrt_def rcis_def
       by (subst *, subst **, subst ***, simp)
     thus ?thesis
       by simp
   next
-    assume ***: "cis (arg s - k * pi) = -cis (arg s)"
+    assume ***: "cis (Arg s - k * pi) = -cis (Arg s)"
     hence "s = - ccsqrt z"
-      using rcis_cmod_arg[of s]
+      using rcis_cmod_Arg[of s]
       unfolding ccsqrt_def rcis_def
       by (subst *, subst **, subst ***, simp)
     thus ?thesis
       by simp
   qed
 qed
 
 lemma null_ccsqrt [simp]:
   shows "ccsqrt x = 0 \<longleftrightarrow> x = 0"
   unfolding ccsqrt_def
   by auto
 
 lemma ccsqrt_mult:
   shows "ccsqrt (a * b) = ccsqrt a * ccsqrt b \<or>
          ccsqrt (a * b) = - ccsqrt a * ccsqrt b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
-  obtain k::int where "arg a + arg b - \<downharpoonright>arg a + arg b\<downharpoonleft> = 2 * real_of_int k * pi"
-    using canon_ang(3)[of "arg a + arg b"]
+  obtain k::int where "Arg a + Arg b - \<downharpoonright>Arg a + Arg b\<downharpoonleft> = 2 * real_of_int k * pi"
+    using canon_ang(3)[of "Arg a + Arg b"]
     by auto
-  hence *: "\<downharpoonright>arg a + arg b\<downharpoonleft> = arg a + arg b - 2 * (real_of_int k) * pi"
+  hence *: "\<downharpoonright>Arg a + Arg b\<downharpoonleft> = Arg a + Arg b - 2 * (real_of_int k) * pi"
     by (auto simp add: field_simps)
 
-  have "cis (\<downharpoonright>arg a + arg b\<downharpoonleft> / 2) = cis (arg a / 2 + arg b / 2) \<or> cis (\<downharpoonright>arg a + arg b\<downharpoonleft> / 2) = - cis (arg a / 2 + arg b / 2)"
+  have "cis (\<downharpoonright>Arg a + Arg b\<downharpoonleft> / 2) = cis (Arg a / 2 + Arg b / 2) \<or> cis (\<downharpoonright>Arg a + Arg b\<downharpoonleft> / 2) = - cis (Arg a / 2 + Arg b / 2)"
     using cos_even_kpi[of k] cos_odd_kpi[of k]
     by ((subst *)+, (subst diff_divide_distrib)+, (subst add_divide_distrib)+)
        (cases "even k", auto simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
   thus ?thesis
     using False
     unfolding ccsqrt_def
     by (smt (verit, best) arg_mult mult_minus_left mult_minus_right no_zero_divisors norm_mult rcis_def rcis_mult real_sqrt_mult)
 qed
 
 lemma csqrt_real:
   assumes "is_real x"
   shows "(Re x \<ge> 0 \<and> ccsqrt x = cor (sqrt (Re x))) \<or>
          (Re x < 0 \<and> ccsqrt x = \<i> * cor (sqrt (- (Re x))))"
 proof (cases "x = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
   show ?thesis
   proof (cases "Re x > 0")
     case True
-    hence "arg x = 0"
+    hence "Arg x = 0"
       using \<open>is_real x\<close>
       by (metis arg_complex_of_real_positive complex_of_real_Re)
     thus ?thesis
       using \<open>Re x > 0\<close> \<open>is_real x\<close>
       unfolding ccsqrt_def
       by (simp add: cmod_eq_Re)
   next
     case False
     hence "Re x < 0"
       using \<open>x \<noteq> 0\<close> \<open>is_real x\<close>
       using complex_eq_if_Re_eq by auto
-    hence "arg x = pi"
+    hence "Arg x = pi"
       using \<open>is_real x\<close>
       by (metis arg_complex_of_real_negative complex_of_real_Re)
     thus ?thesis
       using \<open>Re x < 0\<close> \<open>is_real x\<close>
       unfolding ccsqrt_def rcis_def
       by (simp add: cis_def complex.corec Complex_eq cmod_eq_Re)
   qed
 qed
 
 
 text \<open>Rotation of complex vector to x-axis.\<close>
 
 lemma is_real_rot_to_x_axis:
   assumes "z \<noteq> 0"
-  shows "is_real (cis (-arg z) * z)"
-proof (cases "arg z = pi")
+  shows "is_real (cis (-Arg z) * z)"
+proof (cases "Arg z = pi")
   case True
   thus ?thesis
     using is_real_arg1[of z]
     by auto
 next
   case False
-  hence "\<downharpoonright>- arg z\<downharpoonleft> = - arg z"
-    using canon_ang_eqI[of "- arg z" "-arg z"]
-    using arg_bounded[of z]
+  hence "\<downharpoonright>- Arg z\<downharpoonleft> = - Arg z"
+    using canon_ang_eqI[of "- Arg z" "-Arg z"]
+    using Arg_bounded[of z]
     by (auto simp add: field_simps)
-  hence "arg (cis (- (arg z)) * z) = 0"
-    using arg_mult[of "cis (- (arg z))" z] \<open>z \<noteq> 0\<close>
-    using arg_cis[of "- arg z"]
+  hence "Arg (cis (- (Arg z)) * z) = 0"
+    using arg_mult[of "cis (- (Arg z))" z] \<open>z \<noteq> 0\<close>
+    using arg_cis[of "- Arg z"]
     by simp
   thus ?thesis
-    using is_real_arg1[of "cis (- arg z) * z"]
+    using is_real_arg1[of "cis (- Arg z) * z"]
     by auto
 qed
 
 lemma positive_rot_to_x_axis:
   assumes "z \<noteq> 0"
-  shows "Re (cis (-arg z) * z) > 0"
+  shows "Re (cis (-Arg z) * z) > 0"
   using assms
-  by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_arg rcis_mult rcis_zero_arg zero_less_norm_iff)
+  by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_Arg rcis_mult rcis_zero_arg zero_less_norm_iff)
 
 text \<open>Inequalities involving @{term cmod}.\<close>
 
 lemma cmod_1_plus_mult_le:
   shows "cmod (1 + z*w) \<le> sqrt((1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2))"
 proof-
   have "Re ((1+z*w)*(1+cnj z*cnj w)) \<le> Re (1+z*cnj z)* Re (1+w*cnj w)"
   proof-
     have "Re ((w - cnj z)*cnj(w - cnj z)) \<ge> 0"
       by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
     hence "Re (z*w + cnj z * cnj w) \<le> Re (w*cnj w) + Re(z*cnj z)"
       by (simp add: field_simps)
     thus ?thesis
       by (simp add: field_simps)
   qed
   hence "(cmod (1 + z * w))\<^sup>2 \<le> (1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2)"
     by (subst cmod_square)+ simp
   thus ?thesis
     by (metis abs_norm_cancel real_sqrt_abs real_sqrt_le_iff)
 qed
 
-lemma cmod_diff_ge: 
+lemma cmod_diff_ge:
   shows "cmod (b - c) \<ge> sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)"
 proof-
   have "(cmod (b - c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \<ge> 0"
     by simp
   hence "(cmod (b - c))\<^sup>2 \<ge> - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2"
     by simp
   hence "(cmod (b - c))\<^sup>2 \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) "
     by (auto simp add: power2_eq_square field_simps)
   hence "Re ((b - c)*(cnj b - cnj c)) \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)"
     by (subst (asm) cmod_square) simp
   moreover
   have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
     by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
   moreover
   have "(1 + Re (scalprod b c))\<^sup>2 = 1 + 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)"
     by (subst power2_sum) simp
   hence "(1 + Re (scalprod b c))\<^sup>2 = 1 + Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2"
     by simp
   ultimately
   have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \<ge> (1 + Re (scalprod b c))\<^sup>2"
     by (simp add: field_simps)
   moreover
   have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 0"
     by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
   ultimately
   have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 1 + Re (scalprod b c)"
     by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
   hence "Re ((b - c) * (cnj b - cnj c)) \<ge> 1 + Re (c*cnj c) + 1 + Re (b*cnj b) - 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))"
     by (simp add: field_simps)
   hence *: "(cmod (b - c))\<^sup>2 \<ge> (sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2))\<^sup>2"
     apply (subst cmod_square)+
     apply (subst (asm) cmod_square)+
     apply (subst power2_diff)
     apply (subst real_sqrt_pow2, simp)
     apply (subst real_sqrt_pow2, simp)
     apply (simp add: real_sqrt_mult)
     done
   thus ?thesis
   proof (cases "sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2) > 0")
     case True
     thus ?thesis
       using power2_le_imp_le[OF *]
       by simp
   next
     case False
     hence "0 \<ge> sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)"
       by (metis less_eq_real_def linorder_neqE_linordered_idom)
     moreover
     have "cmod (b - c) \<ge> 0"
       by simp
     ultimately
     show ?thesis
       by (metis add_increasing monoid_add_class.add.right_neutral)
   qed
 qed
 
 lemma cmod_diff_le:
   shows "cmod (b - c) \<le> sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2)"
 proof-
   have "(cmod (b + c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \<ge> 0"
     by simp
   hence "(cmod (b + c))\<^sup>2 \<ge> - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2"
     by simp
   hence "(cmod (b + c))\<^sup>2 \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) "
     by (auto simp add: power2_eq_square field_simps)
   hence "Re ((b + c)*(cnj b + cnj c)) \<ge> (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)"
     by (subst (asm) cmod_square) simp
   moreover
   have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
     by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
   moreover
   have ++: "2*Re(scalprod b c) = Re(b*cnj c + c*cnj b)"
     by simp
   have "(1 - Re (scalprod b c))\<^sup>2 = 1 - 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)"
     by (subst power2_diff) simp
   hence "(1 - Re (scalprod b c))\<^sup>2 = 1 - Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2"
     by (subst ++[symmetric]) simp
   ultimately
   have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \<ge> (1 - Re (scalprod b c))\<^sup>2"
     by (simp add: field_simps)
   moreover
   have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 0"
     by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
   ultimately
   have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \<ge> 1 - Re (scalprod b c)"
     by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
   hence "Re ((b - c) * (cnj b - cnj c)) \<le> 1 + Re (c*cnj c) + 1 + Re (b*cnj b) + 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))"
     by (simp add: field_simps)
   hence *: "(cmod (b - c))\<^sup>2 \<le> (sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2))\<^sup>2"
     apply (subst cmod_square)+
     apply (subst (asm) cmod_square)+
     apply (subst power2_sum)
     apply (subst real_sqrt_pow2, simp)
     apply (subst real_sqrt_pow2, simp)
     apply (simp add: real_sqrt_mult)
     done
   thus ?thesis
     using power2_le_imp_le[OF *]
     by simp
 qed
 
 
 text \<open>Definition of Euclidean distance between two complex numbers.\<close>
 
 definition cdist where
   [simp]: "cdist z1 z2 \<equiv> cmod (z2 - z1)"
 
 text \<open>Misc. properties of complex numbers.\<close>
 
 lemma ex_complex_to_complex [simp]:
   fixes z1 z2 :: complex
   assumes "z1 \<noteq> 0" and "z2 \<noteq> 0"
   shows "\<exists>k. k \<noteq> 0 \<and> z2 = k * z1"
   using assms
   by (rule_tac x="z2/z1" in exI) simp
 
 lemma ex_complex_to_one [simp]:
   fixes z::complex
   assumes "z \<noteq> 0"
   shows "\<exists>k. k \<noteq> 0 \<and> k * z = 1"
   using assms
   by (rule_tac x="1/z" in exI) simp
 
 lemma ex_complex_to_complex2 [simp]:
   fixes z::complex
   shows "\<exists>k. k \<noteq> 0 \<and> k * z = z"
   by (rule_tac x="1" in exI) simp
 
 lemma complex_sqrt_1:
   fixes z::complex
   assumes "z \<noteq> 0"
   shows "z = 1 / z \<longleftrightarrow> z = 1 \<or> z = -1"
   using assms
   using nonzero_eq_divide_eq square_eq_iff
   by fastforce
 
 end
diff --git a/thys/Complex_Geometry/Oriented_Circlines.thy b/thys/Complex_Geometry/Oriented_Circlines.thy
--- a/thys/Complex_Geometry/Oriented_Circlines.thy
+++ b/thys/Complex_Geometry/Oriented_Circlines.thy
@@ -1,1373 +1,1373 @@
 (* -------------------------------------------------------------------------- *)
 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)))))"
+              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]
+  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_cmat [simp]:
   assumes "hermitean H \<and> H \<noteq> mat_zero"
   shows  "pos_oriented_cmat (opposite_ocircline_cmat H) \<longleftrightarrow> \<not> pos_oriented_cmat H"
 proof-
   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 assms 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]
+  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)
   moreover
-  have "B \<noteq> 0 \<and> 0 < arg B \<longrightarrow> \<not> 0 < arg (- B)"
-    using canon_ang_plus_pi1[of "arg B"] arg_bounded[of B]
+  have "B \<noteq> 0 \<and> 0 < Arg B \<longrightarrow> \<not> 0 < Arg (- B)"
+    using canon_ang_plus_pi1[of "Arg B"] Arg_bounded[of B]
     by (auto simp add: arg_uminus)
   ultimately
   show "pos_oriented_cmat (opposite_ocircline_cmat H) = (\<not> pos_oriented_cmat H)"
     by simp (metis not_less_iff_gr_or_eq)
 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 \<open>\<not> Re A > 0\<close> mult_neg_pos
           by fastforce
       next
         case False
         thus ?thesis
           using arg_uminus_opposite_sign[of B] arg_mult_real_negative
           using assms * ** H1 \<open>\<not> Re A > 0\<close> 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 \<open>\<not> Re A > 0\<close>
           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 \<open>\<not> Re A > 0\<close> 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
 
 lemma moebius_ocircline_circline:
   shows "moebius_ocircline M H = of_circline (moebius_circline M (of_ocircline H)) \<or>
          moebius_ocircline M H = opposite_ocircline (of_circline (moebius_circline M (of_ocircline H)))"
   apply (transfer, simp add: of_circline_clmat_def', safe)
   apply (transfer, simp, rule_tac x="1" in exI, simp)
   apply (transfer, simp, erule_tac x="1" in allE, 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
diff --git a/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy b/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy
--- a/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy
+++ b/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy
@@ -1,1202 +1,1202 @@
 (* ---------------------------------------------------------------------------- *)
 section \<open>Unit circle preserving Möbius transformations\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>In this section we shall examine Möbius transformations that map the unit circle onto itself.
 We shall say that they fix or preserve the unit circle (although, they do not need to fix each of
 its points).\<close>
 
 theory Unit_Circle_Preserving_Moebius
 imports Unitary11_Matrices Moebius Oriented_Circlines
 begin
 
 (* ---------------------------------------------------------------------------- *)
 subsection \<open>Möbius transformations that fix the unit circle\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>We define Möbius transformations that preserve unit circle as transformations represented by
 generalized unitary matrices with the $1-1$ signature (elements of the gruop $GU_{1,1}(2,
 \mathbb{C})$, defined earlier in the theory Unitary11Matrices).\<close>
 
 lift_definition unit_circle_fix_mmat :: "moebius_mat \<Rightarrow> bool" is unitary11_gen
   done
 
 lift_definition unit_circle_fix :: "moebius \<Rightarrow> bool" is unit_circle_fix_mmat
   apply transfer
   apply (auto simp del: mult_sm.simps)
   apply (simp del: mult_sm.simps add: unitary11_gen_mult_sm)
   apply (simp del: mult_sm.simps add: unitary11_gen_div_sm)
   done
 
 text \<open>Our algebraic characterisation (by matrices) is geometrically correct.\<close>
 
 lemma unit_circle_fix_iff:
   shows "unit_circle_fix M \<longleftrightarrow> 
          moebius_circline M unit_circle = unit_circle" (is "?rhs = ?lhs")
 proof
   assume ?lhs
   thus ?rhs
   proof (transfer, transfer)
     fix M :: complex_mat
     assume "mat_det M \<noteq> 0"
     assume "circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
     then obtain k where "k \<noteq> 0" "(1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m congruence (mat_inv M) (1, 0, 0, -1)"
       by auto
     hence "(1/cor k, 0, 0, -1/cor k) = congruence (mat_inv M) (1, 0, 0, -1)"
       using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) (1, 0, 0, -1)" ]
       by simp
     hence "congruence M (1/cor k, 0, 0, -1/cor k) = (1, 0, 0, -1)"
       using \<open>mat_det M \<noteq> 0\<close> mat_det_inv[of M]
       using congruence_inv[of "mat_inv M" "(1, 0, 0, -1)" "(1/cor k, 0, 0, -1/cor k)"]
       by simp
     hence "congruence M (1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)"
       using congruence_scale_m[of "M" "1/cor k" "(1, 0, 0, -1)"]
       using mult_sm_inv_l[of "1/ cor k" "congruence M (1, 0, 0, -1)"  "(1, 0, 0, -1)"] \<open>k \<noteq> 0\<close>
       by simp
     thus "unitary11_gen M"
       using \<open>k \<noteq> 0\<close>
       unfolding unitary11_gen_def
       by simp
   qed
 next
   assume ?rhs
   thus ?lhs
   proof (transfer, transfer)
     fix M :: complex_mat
     assume "mat_det M \<noteq> 0"
     assume "unitary11_gen M"
     hence "unitary11_gen (mat_inv M)"
       using \<open>mat_det M \<noteq> 0\<close>
       using unitary11_gen_mat_inv
       by simp
     thus " circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
       unfolding unitary11_gen_real
       by auto (rule_tac x="1/k" in exI, simp)
   qed
 qed
 
 lemma circline_set_fix_iff_circline_fix:
   assumes "circline_set H' \<noteq> {}"
   shows "circline_set (moebius_circline M H) = circline_set H' \<longleftrightarrow> 
          moebius_circline M H = H'"
   using assms
   by auto (rule inj_circline_set, auto)
 
 lemma unit_circle_fix_iff_unit_circle_set:
   shows "unit_circle_fix M \<longleftrightarrow> moebius_pt M ` unit_circle_set = unit_circle_set"
 proof-
   have "circline_set unit_circle \<noteq> {}"
     using one_in_unit_circle_set
     by auto
   thus ?thesis
     using unit_circle_fix_iff[of M] circline_set_fix_iff_circline_fix[of unit_circle M unit_circle]
     by (simp add: unit_circle_set_def)
 qed
 
 
 text \<open>Unit circle preserving Möbius transformations form a group. \<close>
 
 lemma unit_circle_fix_id_moebius [simp]:
   shows "unit_circle_fix id_moebius"
   by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
 
 lemma unit_circle_fix_moebius_add [simp]:
   assumes "unit_circle_fix M1" and "unit_circle_fix M2"
   shows "unit_circle_fix (M1 + M2)"
   using assms
   unfolding unit_circle_fix_iff
   by auto
 
 lemma unit_circle_fix_moebius_comp [simp]:
   assumes "unit_circle_fix M1" and "unit_circle_fix M2"
   shows "unit_circle_fix (moebius_comp M1 M2)"
   using unit_circle_fix_moebius_add[OF assms]
   by simp
 
 lemma unit_circle_fix_moebius_uminus [simp]:
   assumes "unit_circle_fix M"
   shows "unit_circle_fix (-M)"
   using assms
   unfolding unit_circle_fix_iff
   by (metis moebius_circline_comp_inv_left uminus_moebius_def)
 
 lemma unit_circle_fix_moebius_inv [simp]:
   assumes "unit_circle_fix M"
   shows "unit_circle_fix (moebius_inv M)"
   using unit_circle_fix_moebius_uminus[OF assms]
   by simp
 
 text \<open>Unit circle fixing transforms preserve inverse points.\<close>
 
 lemma unit_circle_fix_moebius_pt_inversion [simp]:
   assumes "unit_circle_fix M"
   shows "moebius_pt M (inversion z) = inversion (moebius_pt M z)"
   using assms
   using symmetry_principle[of z "inversion z" unit_circle M]
   using unit_circle_fix_iff[of M, symmetric]
   using circline_symmetric_inv_homo_disc[of z]
   using circline_symmetric_inv_homo_disc'[of "moebius_pt M z" "moebius_pt M (inversion z)"]
   by metis
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Möbius transformations that fix the imaginary unit circle\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>Only for completeness we show that Möbius transformations that preserve the imaginary unit
 circle are exactly those characterised by generalized unitary matrices (with the (2, 0) signature).\<close>
 lemma imag_unit_circle_fixed_iff_unitary_gen:
   assumes "mat_det (A, B, C, D) \<noteq> 0"
   shows "moebius_circline (mk_moebius A B C D) imag_unit_circle = imag_unit_circle \<longleftrightarrow>
          unitary_gen (A, B, C, D)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   thus ?rhs
     using assms
   proof (transfer, transfer)
     fix A B C D :: complex
     let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
     assume "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
            "mat_det ?M \<noteq> 0"
     then obtain k where "k \<noteq> 0" "?E = cor k *\<^sub>s\<^sub>m congruence (mat_inv ?M) ?E"
       by auto
     hence "unitary_gen (mat_inv ?M)"
       using mult_sm_inv_l[of "cor k" "congruence (mat_inv ?M) ?E" "?E"]
       unfolding unitary_gen_def
       by (metis congruence_def divide_eq_0_iff eye_def mat_eye_r of_real_eq_0_iff one_neq_zero)
     thus "unitary_gen ?M"
       using unitary_gen_inv[of "mat_inv ?M"] \<open>mat_det ?M \<noteq> 0\<close>
       by (simp del: mat_inv.simps)
   qed
 next
   assume ?rhs
   thus ?lhs
     using assms
   proof (transfer, transfer)
     fix A B C D :: complex
     let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
     assume "unitary_gen ?M" "mat_det ?M \<noteq> 0"
     hence "unitary_gen (mat_inv ?M)"
       using unitary_gen_inv[of ?M]
       by simp
     then obtain k where "k \<noteq> 0" "mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M) = cor k *\<^sub>s\<^sub>m eye"
       using unitary_gen_real[of "mat_inv ?M"] mat_det_inv[of ?M]
       by auto
     hence *: "?E = (1 / cor k) *\<^sub>s\<^sub>m (mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M))"
       using mult_sm_inv_l[of "cor k" eye "mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M)"]
       by simp
     have "\<exists>k. k \<noteq> 0 \<and>
             (1, 0, 0, 1) = cor k *\<^sub>s\<^sub>m (mat_adj (mat_inv (A, B, C, D)) *\<^sub>m\<^sub>m (1, 0, 0, 1) *\<^sub>m\<^sub>m mat_inv (A, B, C, D))"
       using \<open>mat_det ?M \<noteq> 0\<close> \<open>k \<noteq> 0\<close> 
       by (metis "*" Im_complex_of_real Re_complex_of_real \<open>mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m mat_inv ?M = cor k *\<^sub>s\<^sub>m eye\<close> complex_of_real_Re eye_def mat_eye_l mult_mm_assoc mult_mm_sm mult_sm_eye_mm of_real_1 of_real_divide of_real_eq_1_iff zero_eq_1_divide_iff)
     thus "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
       using \<open>mat_det ?M \<noteq> 0\<close> \<open>k \<noteq> 0\<close> 
       by (simp del: mat_inv.simps)
   qed
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Möbius transformations that fix the oriented unit circle and the unit disc\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>Möbius transformations that fix the unit circle either map the unit disc onto itself or
 exchange it with its exterior. The transformations that fix the unit disc can be recognized from
 their matrices -- they have the form as before, but additionally it must hold that $|a|^2 > |b|^2$.\<close>
   
 definition unit_disc_fix_cmat :: "complex_mat \<Rightarrow> bool" where
  [simp]: "unit_disc_fix_cmat M \<longleftrightarrow>
           (let (A, B, C, D) = M
             in unitary11_gen (A, B, C, D) \<and> (B = 0 \<or> Re ((A*D)/(B*C)) > 1))"
 
 lift_definition unit_disc_fix_mmat :: "moebius_mat \<Rightarrow> bool" is unit_disc_fix_cmat
   done
 
 lift_definition unit_disc_fix :: "moebius \<Rightarrow> bool" is unit_disc_fix_mmat
 proof transfer
   fix M M' :: complex_mat
   assume det: "mat_det M \<noteq> 0" "mat_det M' \<noteq> 0"
   assume "moebius_cmat_eq M M'"
   then obtain k where *: "k \<noteq> 0" "M' = k *\<^sub>s\<^sub>m M"
     by auto
   hence **: "unitary11_gen M \<longleftrightarrow> unitary11_gen M'"
     using unitary11_gen_mult_sm[of k M] unitary11_gen_div_sm[of k M]
     by auto
   obtain A B C D where MM: "(A, B, C, D) = M"
     by (cases M) auto
   obtain A' B' C' D' where MM': "(A', B', C', D') = M'"
     by (cases M') auto
 
   show "unit_disc_fix_cmat M = unit_disc_fix_cmat M'"
     using * ** MM MM'
     by auto
 qed
 
 text \<open>Transformations that fix the unit disc also fix the unit circle.\<close>
 lemma unit_disc_fix_unit_circle_fix [simp]:
   assumes "unit_disc_fix M"
   shows "unit_circle_fix M"
   using assms
   by (transfer, transfer, auto)
 
 text \<open>Transformations that preserve the unit disc preserve the orientation of the unit circle.\<close>
 lemma unit_disc_fix_iff_ounit_circle:
   shows "unit_disc_fix M \<longleftrightarrow> 
          moebius_ocircline M ounit_circle = ounit_circle" (is "?rhs \<longleftrightarrow> ?lhs")
 proof
   assume *: ?lhs
   have "moebius_circline M unit_circle = unit_circle"
     apply (subst moebius_circline_ocircline[of M unit_circle])
     apply (subst of_circline_unit_circle)
     apply (subst *)
     by simp
 
   hence "unit_circle_fix M"
     by (simp add: unit_circle_fix_iff)
   thus ?rhs
     using *
   proof (transfer, transfer)
     fix M :: complex_mat
     assume "mat_det M \<noteq> 0"
     let ?H = "(1, 0, 0, -1)"
     obtain A B C D where MM: "(A, B, C, D) = M"
       by (cases M) auto
     assume "unitary11_gen M" "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
     then obtain k where "0 < k" "?H = cor k *\<^sub>s\<^sub>m congruence (mat_inv M) ?H"
       by auto
     hence "congruence M ?H = cor k *\<^sub>s\<^sub>m ?H"
       using congruence_inv[of "mat_inv M" "?H" "(1/cor k) *\<^sub>s\<^sub>m ?H"] \<open>mat_det M \<noteq> 0\<close>
       using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) ?H" "?H"]
       using mult_sm_inv_l[of "1/cor k" "congruence M ?H"]
       using congruence_scale_m[of M "1/cor k" "?H"]
       using \<open>\<And>B. \<lbrakk>1 / cor k \<noteq> 0; (1 / cor k) *\<^sub>s\<^sub>m congruence M (1, 0, 0, - 1) = B\<rbrakk> \<Longrightarrow> congruence M (1, 0, 0, - 1) = (1 / (1 / cor k)) *\<^sub>s\<^sub>m B\<close>
       by (auto simp add: mat_det_inv)
     then obtain a b k' where "k' \<noteq> 0" "M = k' *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" "sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1"
       using unitary11_sgn_det_orientation'[of M k] \<open>k > 0\<close>
       by auto
     moreover
     have "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
       using \<open>sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1\<close>
       by (smt sgn_0 zero_complex.simps(1))
     ultimately
     show "unit_disc_fix_cmat M"
       using unitary11_sgn_det[of k' a b M A B C D]
       using MM[symmetric] \<open>k > 0\<close> \<open>unitary11_gen M\<close>
       by (simp add: sgn_1_pos split: if_split_asm)
   qed
 next
   assume ?rhs
   thus ?lhs
   proof (transfer, transfer)
     fix M :: complex_mat
     assume "mat_det M \<noteq> 0"
 
     obtain A B C D where MM: "(A, B, C, D) = M"
       by (cases M) auto
     assume "unit_disc_fix_cmat M"
     hence "unitary11_gen M" "B = 0 \<or> 1 < Re (A * D / (B * C))"
       using MM[symmetric]
       by auto
     have "sgn (if B = 0 then 1 else sgn (Re (A * D / (B * C)) - 1)) = 1"
       using \<open>B = 0 \<or> 1 < Re (A * D / (B * C))\<close>
       by auto
     then obtain k' where "k' > 0" "congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)"
       using unitary11_orientation[OF \<open>unitary11_gen M\<close> MM[symmetric]]
       by (auto simp add: sgn_1_pos)
     thus "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
       using congruence_inv[of M "(1, 0, 0, -1)" "cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)"] \<open>mat_det M \<noteq> 0\<close>
       using congruence_scale_m[of "mat_inv M" "cor k'" "(1, 0, 0, -1)"]
       by auto
   qed
 qed
 
 
 text \<open>Our algebraic characterisation (by matrices) is geometrically correct.\<close>
 
 lemma unit_disc_fix_iff [simp]:
   assumes "unit_disc_fix M"
   shows "moebius_pt M ` unit_disc = unit_disc"
   using assms
   using unit_disc_fix_iff_ounit_circle[of M]
   unfolding unit_disc_def
   by (subst disc_moebius_ocircline[symmetric], simp)
 
 lemma unit_disc_fix_discI [simp]:
   assumes "unit_disc_fix M" and "u \<in> unit_disc"
   shows "moebius_pt M u \<in> unit_disc"
   using unit_disc_fix_iff assms
   by blast
 
 text \<open>Unit disc preserving transformations form a group.\<close>
 
 lemma unit_disc_fix_id_moebius [simp]:
   shows "unit_disc_fix id_moebius"
   by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
 
 lemma unit_disc_fix_moebius_add [simp]:
   assumes "unit_disc_fix M1" and "unit_disc_fix M2"
   shows "unit_disc_fix (M1 + M2)"
   using assms
   unfolding unit_disc_fix_iff_ounit_circle
   by auto
 
 lemma unit_disc_fix_moebius_comp [simp]:
   assumes "unit_disc_fix M1" and "unit_disc_fix M2"
   shows "unit_disc_fix (moebius_comp M1 M2)"
   using unit_disc_fix_moebius_add[OF assms]
   by simp
 
 lemma unit_disc_fix_moebius_uminus [simp]:
   assumes "unit_disc_fix M"
   shows "unit_disc_fix (-M)"
   using assms
   unfolding unit_disc_fix_iff_ounit_circle
   by (metis moebius_ocircline_comp_inv_left uminus_moebius_def)
 
 lemma unit_disc_fix_moebius_inv [simp]:
   assumes "unit_disc_fix M"
   shows "unit_disc_fix (moebius_inv M)"
   using unit_disc_fix_moebius_uminus[OF assms]
   by simp
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Rotations are unit disc preserving transformations\<close>
 (* -------------------------------------------------------------------------- *)
 
 lemma unit_disc_fix_rotation [simp]:
   shows "unit_disc_fix (moebius_rotation \<phi>)"      
   unfolding moebius_rotation_def moebius_similarity_def
   by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def cis_mult)
 
 lemma moebius_rotation_unit_circle_fix [simp]:
   shows "moebius_pt (moebius_rotation \<phi>) u \<in> unit_circle_set \<longleftrightarrow> u \<in> unit_circle_set"
   using moebius_pt_moebius_inv_in_set unit_circle_fix_iff_unit_circle_set
   by fastforce
 
 lemma ex_rotation_mapping_u_to_positive_x_axis:
   assumes "u \<noteq> 0\<^sub>h" and "u \<noteq> \<infinity>\<^sub>h"
   shows "\<exists> \<phi>. moebius_pt (moebius_rotation \<phi>) u \<in> positive_x_axis"
 proof-
   from assms obtain c where *: "u = of_complex c"
     using inf_or_of_complex
     by blast
-  have "is_real (cis (- arg c) * c)" "Re (cis (-arg c) * c) > 0"
+  have "is_real (cis (- Arg c) * c)" "Re (cis (-Arg c) * c) > 0"
     using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
     by blast+
   thus ?thesis
     using *
-    by (rule_tac x="-arg c" in exI) (simp add: positive_x_axis_def circline_set_x_axis)
+    by (rule_tac x="-Arg c" in exI) (simp add: positive_x_axis_def circline_set_x_axis)
 qed
 
 lemma ex_rotation_mapping_u_to_positive_y_axis:
   assumes "u \<noteq> 0\<^sub>h" and "u \<noteq> \<infinity>\<^sub>h"
   shows "\<exists> \<phi>. moebius_pt (moebius_rotation \<phi>) u \<in> positive_y_axis"
 proof-
   from assms obtain c where *: "u = of_complex c"
     using inf_or_of_complex
     by blast
-  have "is_imag (cis (pi/2 - arg c) * c)" "Im (cis (pi/2 - arg c) * c) > 0"
+  have "is_imag (cis (pi/2 - Arg c) * c)" "Im (cis (pi/2 - Arg c) * c) > 0"
     using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
     by - (simp, simp, simp add: field_simps)
   thus ?thesis
     using *
-    by (rule_tac x="pi/2-arg c" in exI) (simp add: positive_y_axis_def circline_set_y_axis)
+    by (rule_tac x="pi/2-Arg c" in exI) (simp add: positive_y_axis_def circline_set_y_axis)
 qed
 
 lemma wlog_rotation_to_positive_x_axis:
   assumes in_disc: "u \<in> unit_disc" and not_zero: "u \<noteq> 0\<^sub>h"
   assumes preserving: "\<And>\<phi> u. \<lbrakk>u \<in> unit_disc; u \<noteq> 0\<^sub>h; P (moebius_pt (moebius_rotation \<phi>) u)\<rbrakk> \<Longrightarrow> P u"
   assumes x_axis: "\<And>x. \<lbrakk>is_real x; 0 < Re x; Re x < 1\<rbrakk> \<Longrightarrow> P (of_complex x)"
   shows "P u"
 proof-
   from in_disc obtain \<phi> where *:
     "moebius_pt (moebius_rotation \<phi>) u \<in> positive_x_axis"
     using ex_rotation_mapping_u_to_positive_x_axis[of u]
     using inf_notin_unit_disc not_zero
     by blast
   let ?Mu = "moebius_pt (moebius_rotation \<phi>) u"
   have "P ?Mu"
   proof-
     let ?x = "to_complex ?Mu"
     have "?Mu \<in> unit_disc" "?Mu \<noteq> 0\<^sub>h" "?Mu \<noteq> \<infinity>\<^sub>h"
       using \<open>u \<in> unit_disc\<close> \<open>u \<noteq> 0\<^sub>h\<close>
       by auto
     hence "is_real (to_complex ?Mu)"  "0 < Re ?x" "Re ?x < 1"
       using *
       unfolding positive_x_axis_def circline_set_x_axis
       by (auto simp add: cmod_eq_Re)
     thus ?thesis
       using x_axis[of ?x] \<open>?Mu \<noteq> \<infinity>\<^sub>h\<close>
       by simp
   qed
   thus ?thesis
     using preserving[OF in_disc] not_zero
     by simp
 qed
 
 lemma wlog_rotation_to_positive_x_axis':
   assumes not_zero: "u \<noteq> 0\<^sub>h" and not_inf: "u \<noteq> \<infinity>\<^sub>h"
   assumes preserving: "\<And>\<phi> u. \<lbrakk>u \<noteq> 0\<^sub>h; u \<noteq> \<infinity>\<^sub>h; P (moebius_pt (moebius_rotation \<phi>) u)\<rbrakk> \<Longrightarrow> P u"
   assumes x_axis: "\<And>x. \<lbrakk>is_real x; 0 < Re x\<rbrakk> \<Longrightarrow> P (of_complex x)"
   shows "P u"
 proof-
   from not_zero and not_inf obtain \<phi> where *:
     "moebius_pt (moebius_rotation \<phi>) u \<in> positive_x_axis"
     using ex_rotation_mapping_u_to_positive_x_axis[of u]
     using inf_notin_unit_disc
     by blast
   let ?Mu = "moebius_pt (moebius_rotation \<phi>) u"
   have "P ?Mu"
   proof-
     let ?x = "to_complex ?Mu"
     have "?Mu \<noteq> 0\<^sub>h" "?Mu \<noteq> \<infinity>\<^sub>h"
       using \<open>u \<noteq> \<infinity>\<^sub>h\<close> \<open>u \<noteq> 0\<^sub>h\<close>
       by auto
     hence "is_real (to_complex ?Mu)"  "0 < Re ?x"
       using *
       unfolding positive_x_axis_def circline_set_x_axis
       by (auto simp add: cmod_eq_Re)
     thus ?thesis
       using x_axis[of ?x] \<open>?Mu \<noteq> \<infinity>\<^sub>h\<close>
       by simp
   qed
   thus ?thesis
     using preserving[OF not_zero not_inf]
     by simp
 qed
 
 lemma wlog_rotation_to_positive_y_axis:
   assumes in_disc: "u \<in> unit_disc" and not_zero: "u \<noteq> 0\<^sub>h"
   assumes preserving: "\<And>\<phi> u. \<lbrakk>u \<in> unit_disc; u \<noteq> 0\<^sub>h; P (moebius_pt (moebius_rotation \<phi>) u)\<rbrakk> \<Longrightarrow> P u"
   assumes y_axis: "\<And>x. \<lbrakk>is_imag x; 0 < Im x; Im x < 1\<rbrakk> \<Longrightarrow> P (of_complex x)"
   shows "P u"
 proof-
   from in_disc and not_zero obtain \<phi> where *:
     "moebius_pt (moebius_rotation \<phi>) u \<in> positive_y_axis"
     using ex_rotation_mapping_u_to_positive_y_axis[of u]
     using inf_notin_unit_disc
     by blast
   let ?Mu = "moebius_pt (moebius_rotation \<phi>) u"
   have "P ?Mu"
   proof-
     let ?y = "to_complex ?Mu"
     have "?Mu \<in> unit_disc" "?Mu \<noteq> 0\<^sub>h" "?Mu \<noteq> \<infinity>\<^sub>h"
       using \<open>u \<in> unit_disc\<close> \<open>u \<noteq> 0\<^sub>h\<close>
       by auto
     hence "is_imag (to_complex ?Mu)"  "0 < Im ?y" "Im ?y < 1"
       using *
       unfolding positive_y_axis_def circline_set_y_axis
       by (auto simp add: cmod_eq_Im)
     thus ?thesis
       using y_axis[of ?y] \<open>?Mu \<noteq> \<infinity>\<^sub>h\<close>
       by simp
   qed
   thus ?thesis
     using preserving[OF in_disc not_zero]
     by simp
 qed
 
 (* ---------------------------------------------------------------------------- *)
 subsection \<open>Blaschke factors are unit disc preserving transformations\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>For a given point $a$, Blaschke factor transformations are of the form $k \cdot
 \left(\begin{array}{cc}1 & -a\\ -\overline{a} & 1\end{array}\right)$. It is a disc preserving
 Möbius transformation that maps the point $a$ to zero (by the symmetry principle, it must map the
 inverse point of $a$ to infinity).\<close>
 
 definition blaschke_cmat :: "complex \<Rightarrow> complex_mat" where
  [simp]: "blaschke_cmat a = (if cmod a \<noteq> 1 then (1, -a, -cnj a, 1) else eye)"
 lift_definition blaschke_mmat :: "complex \<Rightarrow> moebius_mat" is blaschke_cmat
   by simp
 lift_definition blaschke :: "complex \<Rightarrow> moebius" is blaschke_mmat
   done
 
 lemma blaschke_0_id [simp]: "blaschke 0 = id_moebius"
   by (transfer, transfer, simp)
 
 lemma blaschke_a_to_zero [simp]:
   assumes "cmod a \<noteq> 1"
   shows "moebius_pt (blaschke a) (of_complex a) = 0\<^sub>h"
   using assms
   by (transfer, transfer, simp)
 
 lemma blaschke_inv_a_inf [simp]:
   assumes "cmod a \<noteq> 1"
   shows "moebius_pt (blaschke a) (inversion (of_complex a)) = \<infinity>\<^sub>h"
   using assms
   unfolding inversion_def
   by (transfer, transfer) (simp add: vec_cnj_def, rule_tac x="1/(1 - a*cnj a)" in exI, simp)
 
 lemma blaschke_inf [simp]:
   assumes "cmod a < 1" and "a \<noteq> 0"
   shows "moebius_pt (blaschke a) \<infinity>\<^sub>h = of_complex (- 1 / cnj a)"
   using assms
   by (transfer, transfer, simp add: complex_mod_sqrt_Re_mult_cnj)
 
 lemma blaschke_0_minus_a [simp]:
   assumes "cmod a \<noteq> 1"
   shows "moebius_pt (blaschke a) 0\<^sub>h = ~\<^sub>h (of_complex a)"
   using assms
   by (transfer, transfer, simp)
                                                 
 lemma blaschke_unit_circle_fix [simp]:
   assumes "cmod a \<noteq> 1"
   shows "unit_circle_fix (blaschke a)"
   using assms
   by (transfer, transfer) (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
 
 lemma blaschke_unit_disc_fix [simp]:
   assumes "cmod a < 1"
   shows "unit_disc_fix (blaschke a)"
   using assms
 proof (transfer, transfer)
   fix a
   assume *: "cmod a < 1"
   show "unit_disc_fix_cmat (blaschke_cmat a)"
   proof (cases "a = 0")
     case True
     thus ?thesis
       by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
   next
     case False
     hence "Re (a * cnj a) < 1"
       using *
       by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
     hence "1 / Re (a * cnj a) > 1"
       using False
       by (smt complex_div_gt_0 less_divide_eq_1_pos one_complex.simps(1) right_inverse_eq)
     hence "Re (1 / (a * cnj a)) > 1"
       by (simp add: complex_is_Real_iff)
     thus ?thesis
       by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
   qed
 qed
 
 lemma blaschke_unit_circle_fix':
   assumes "cmod a \<noteq> 1"
   shows "moebius_circline (blaschke a) unit_circle = unit_circle"
   using assms
   using blaschke_unit_circle_fix unit_circle_fix_iff
   by simp
 
 lemma blaschke_ounit_circle_fix':
   assumes "cmod a < 1"
   shows "moebius_ocircline (blaschke a) ounit_circle = ounit_circle"
 proof-
   have "Re (a * cnj a) < 1"
     using assms
     by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
   thus ?thesis
     using assms
     using blaschke_unit_disc_fix unit_disc_fix_iff_ounit_circle
     by simp
 qed
 
 lemma moebius_pt_blaschke [simp]:
   assumes "cmod a \<noteq> 1" and "z \<noteq> 1 / cnj a"
   shows "moebius_pt (blaschke a) (of_complex z) = of_complex ((z - a) / (1 - cnj a * z))"
   using assms
 proof (cases "a = 0")
   case True
   thus ?thesis
     by auto
 next
   case False
   thus ?thesis
     using assms
     apply (transfer, transfer)
     apply (simp add: complex_mod_sqrt_Re_mult_cnj)
     apply (rule_tac x="1 / (1 - cnj a * z)" in exI)
     apply (simp add: field_simps)
     done
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsubsection \<open>Blaschke factors for a real point $a$\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>If the point $a$ is real, the Blaschke factor preserve x-axis and the upper and the lower
 halfplane.\<close>
 
 lemma blaschke_real_preserve_x_axis [simp]:
   assumes "is_real a" and "cmod a < 1"
   shows "moebius_pt (blaschke a) z \<in> circline_set x_axis \<longleftrightarrow> z \<in> circline_set x_axis"
 proof (cases "a = 0")
   case True
   thus ?thesis
     by simp
 next
   case False
   have "cmod a \<noteq> 1"
     using assms
     by linarith
   let ?a = "of_complex a"
   let ?i = "inversion ?a"
   let ?M = "moebius_pt (blaschke a)"
   have *: "?M ?a = 0\<^sub>h" "?M ?i = \<infinity>\<^sub>h" "?M 0\<^sub>h = of_complex (-a)"
     using \<open>cmod a \<noteq> 1\<close> blaschke_a_to_zero[of a] blaschke_inv_a_inf[of a] blaschke_0_minus_a[of a]
     by auto
   let ?Mx = "moebius_circline (blaschke a) x_axis"
   have "?a \<in> circline_set x_axis" "?i \<in> circline_set x_axis" "0\<^sub>h \<in> circline_set x_axis"
     using \<open>is_real a\<close> \<open>a \<noteq> 0\<close> eq_cnj_iff_real[of a]
     by auto
   hence "0\<^sub>h \<in> circline_set ?Mx" "\<infinity>\<^sub>h \<in> circline_set ?Mx" "of_complex (-a) \<in> circline_set ?Mx"
     using *
     apply -                          
     apply (force simp add: image_iff)+
     apply (simp add: image_iff, rule_tac x="0\<^sub>h" in bexI, simp_all)   
     done
   moreover
   have "0\<^sub>h \<in> circline_set x_axis" "\<infinity>\<^sub>h \<in> circline_set x_axis" "of_complex (-a) \<in> circline_set x_axis"
     using \<open>is_real a\<close> 
     by auto
   moreover
   have "of_complex (-a) \<noteq> 0\<^sub>h"
     using \<open>a \<noteq> 0\<close>
     by simp
   hence "0\<^sub>h \<noteq> of_complex (-a)"
     by metis
   hence "\<exists>!H. 0\<^sub>h \<in> circline_set H \<and> \<infinity>\<^sub>h \<in> circline_set H \<and> of_complex (- a) \<in> circline_set H"
     using unique_circline_set[of "0\<^sub>h" "\<infinity>\<^sub>h" "of_complex (-a)"] \<open>a \<noteq> 0\<close>
     by simp
   ultimately
   have "moebius_circline (blaschke a) x_axis = x_axis"
     by auto
   thus ?thesis
     by (metis circline_set_moebius_circline_iff)
 qed
 
 lemma blaschke_real_preserve_sgn_Im [simp]:
   assumes "is_real a" and "cmod a < 1" and "z \<noteq> \<infinity>\<^sub>h" and "z \<noteq> inversion (of_complex a)"
   shows "sgn (Im (to_complex (moebius_pt (blaschke a) z))) = sgn (Im (to_complex z))"
 proof (cases "a = 0")
   case True
   thus ?thesis
     by simp
 next
   case False
   obtain z' where z': "z = of_complex z'"
     using inf_or_of_complex[of z] \<open>z \<noteq> \<infinity>\<^sub>h\<close>
     by auto
   have "z' \<noteq> 1 / cnj a"
     using assms z' \<open>a \<noteq> 0\<close>
     by (auto simp add: of_complex_inj)
   moreover
   have "a * cnj a \<noteq> 1"
     using \<open>cmod a < 1\<close>
     by auto (simp add: complex_mod_sqrt_Re_mult_cnj)
   moreover
   have "sgn (Im ((z' - a) / (1 - a * z'))) = sgn (Im z')"
   proof-
     have "a * z' \<noteq> 1"
       using \<open>is_real a\<close> \<open>z' \<noteq> 1 / cnj a\<close> \<open>a \<noteq> 0\<close> eq_cnj_iff_real[of a]
       by (simp add: field_simps)
     moreover                             
     have "Re (1 - a\<^sup>2) > 0"
       using \<open>is_real a\<close> \<open>cmod a < 1\<close>
       by (smt Re_power2 minus_complex.simps(1) norm_complex_def one_complex.simps(1) power2_less_0 real_sqrt_lt_1_iff)
     moreover
     have "Im ((z' - a) / (1 - a * z')) = Re (((1 - a\<^sup>2) * Im z') / (cmod (1 - a*z'))\<^sup>2)"
     proof-
       have "1 - a * cnj z' \<noteq> 0"
         using \<open>z' \<noteq> 1 / cnj a\<close>
         by (metis Im_complex_div_eq_0  complex_cnj_zero_iff diff_eq_diff_eq diff_numeral_special(9) eq_divide_imp is_real_div mult_not_zero one_complex.simps(2) zero_neq_one)
       hence "Im ((z' - a) / (1 - a * z')) = Im (((z' - a) * (1 - a * cnj z')) / ((1 - a * z') * cnj (1 - a * z')))"
         using \<open>is_real a\<close> eq_cnj_iff_real[of a]
         by simp
       also have "... = Im ((z' - a - a * z' * cnj z' + a\<^sup>2 * cnj z') / (cmod (1 - a*z'))\<^sup>2)"
         unfolding complex_mult_cnj_cmod
         by (simp add: power2_eq_square field_simps)
       finally show ?thesis
         using \<open>is_real a\<close>
         by (simp add: field_simps) 
     qed
     moreover
     have "0 < (1 - (Re a)\<^sup>2) * Im z' / (cmod (1 - a * z'))\<^sup>2 \<Longrightarrow> Im z' > 0"
       using \<open>is_real a\<close> \<open>0 < Re (1 - a\<^sup>2)\<close> 
       by (smt Re_power_real divide_le_0_iff minus_complex.simps(1) not_sum_power2_lt_zero one_complex.simps(1) zero_less_mult_pos)
     ultimately
     show ?thesis
       unfolding sgn_real_def
       using \<open>cmod a < 1\<close> \<open>a * z' \<noteq> 1\<close> \<open>is_real a\<close>
       by (auto simp add: cmod_eq_Re)
   qed
   ultimately
   show ?thesis
     using assms z' moebius_pt_blaschke[of a z'] \<open>is_real a\<close> eq_cnj_iff_real[of a]                  
     by simp
 qed
 
 lemma blaschke_real_preserve_sgn_arg [simp]:
   assumes "is_real a" and "cmod a < 1" and "z \<notin> circline_set x_axis"
-  shows "sgn (arg (to_complex (moebius_pt (blaschke a) z))) = sgn (arg (to_complex z))"
+  shows "sgn (Arg (to_complex (moebius_pt (blaschke a) z))) = sgn (Arg (to_complex z))"
 proof-
   have "z \<noteq> \<infinity>\<^sub>h"
     using assms
     using special_points_on_x_axis''(3) by blast
   moreover
   have "z \<noteq> inversion (of_complex a)"
     using assms
     by (metis calculation circline_equation_x_axis circline_set_x_axis_I conjugate_of_complex inversion_of_complex inversion_sym is_real_inversion o_apply of_complex_zero reciprocal_zero to_complex_of_complex)
   ultimately
   show ?thesis
     using blaschke_real_preserve_sgn_Im[OF assms(1) assms(2), of z]
     by (smt arg_Im_sgn assms(3) circline_set_x_axis_I norm_sgn of_complex_to_complex)
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsubsection \<open>Inverse Blaschke transform\<close>
 (* -------------------------------------------------------------------------- *)
 
 definition inv_blaschke_cmat :: "complex \<Rightarrow> complex_mat" where
  [simp]: "inv_blaschke_cmat a = (if cmod a \<noteq> 1 then (1, a, cnj a, 1) else eye)"
 lift_definition inv_blaschke_mmat :: "complex \<Rightarrow> moebius_mat" is inv_blaschke_cmat
   by simp
 lift_definition inv_blaschke :: "complex \<Rightarrow> moebius" is inv_blaschke_mmat
   done
 
 lemma inv_blaschke_neg [simp]: "inv_blaschke a = blaschke (-a)"
   by (transfer, transfer) simp
 
 lemma inv_blaschke:
   assumes "cmod a \<noteq> 1"
   shows "blaschke a + inv_blaschke a = 0"
   apply simp
   apply (transfer, transfer)
   by auto (rule_tac x="1/(1 - a*cnj a)" in exI, simp)
 
 lemma ex_unit_disc_fix_mapping_u_to_zero:
   assumes "u \<in> unit_disc"
   shows "\<exists> M. unit_disc_fix M \<and> moebius_pt M u = 0\<^sub>h"
 proof-
   from assms obtain c where *: "u = of_complex c"
     by (metis inf_notin_unit_disc inf_or_of_complex)
   hence "cmod c < 1"
     using assms unit_disc_iff_cmod_lt_1
     by simp
   thus ?thesis
     using *
     by (rule_tac x="blaschke c" in exI)
        (smt blaschke_a_to_zero blaschke_ounit_circle_fix' unit_disc_fix_iff_ounit_circle)
 qed
 
 lemma wlog_zero:
   assumes in_disc: "u \<in> unit_disc"
   assumes preserving: "\<And> a u. \<lbrakk>u \<in> unit_disc; cmod a < 1; P (moebius_pt (blaschke a) u)\<rbrakk> \<Longrightarrow> P u"
   assumes zero: "P 0\<^sub>h"
   shows "P u"
 proof-
   have *: "moebius_pt (blaschke (to_complex u)) u = 0\<^sub>h"
     by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
   thus ?thesis
     using preserving[of u "to_complex u"] in_disc zero
     using inf_or_of_complex[of u]
     by auto
 qed
 
 lemma wlog_real_zero:
   assumes in_disc: "u \<in> unit_disc" and real: "is_real (to_complex u)"
   assumes preserving: "\<And> a u. \<lbrakk>u \<in> unit_disc; is_real a; cmod a < 1; P (moebius_pt (blaschke a) u)\<rbrakk> \<Longrightarrow> P u"
   assumes zero: "P 0\<^sub>h"
   shows "P u"
 proof-
   have *: "moebius_pt (blaschke (to_complex u)) u = 0\<^sub>h"
     by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
   thus ?thesis
     using preserving[of u "to_complex u"] in_disc zero real
     using inf_or_of_complex[of u]
     by auto
 qed
 
 lemma unit_disc_fix_transitive:
   assumes in_disc: "u \<in> unit_disc" and "u' \<in> unit_disc"
   shows "\<exists> M. unit_disc_fix M \<and> moebius_pt M u = u'"
 proof-
   have "\<forall> u \<in> unit_disc. \<exists> M. unit_disc_fix M \<and> moebius_pt M u = u'" (is "?P u'")
   proof (rule wlog_zero)
     show "u' \<in> unit_disc" by fact
   next
     show "?P 0\<^sub>h"
       by (simp add: ex_unit_disc_fix_mapping_u_to_zero)
   next
     fix a u
     assume "cmod a < 1" and *: "?P (moebius_pt (blaschke a) u)"
     show "?P u"
     proof
       fix u'
       assume "u' \<in> unit_disc"
       then obtain M' where "unit_disc_fix M'" "moebius_pt M' u' = moebius_pt (blaschke a) u"
         using *
         by auto
       thus "\<exists>M. unit_disc_fix M \<and> moebius_pt M u' = u"
         using \<open>cmod a < 1\<close> blaschke_unit_disc_fix[of a]
         using unit_disc_fix_moebius_comp[of "- blaschke a" "M'"]
         using unit_disc_fix_moebius_inv[of "blaschke a"]
         by (rule_tac x="(- (blaschke a)) + M'" in exI, simp)
     qed
   qed
   thus ?thesis
     using assms
     by auto
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Decomposition of unit disc preserving Möbius transforms\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>Each transformation preserving unit disc can be decomposed to a rotation around the origin and
 a Blaschke factors that maps a point within the unit disc to zero.\<close>
 
 lemma unit_disc_fix_decompose_blaschke_rotation:
   assumes "unit_disc_fix M"
   shows "\<exists> k \<phi>. cmod k < 1 \<and> M = moebius_rotation \<phi> + blaschke k"
   using assms
   unfolding moebius_rotation_def moebius_similarity_def
 proof (simp, transfer, transfer)
   fix M
   assume *: "mat_det M \<noteq> 0" "unit_disc_fix_cmat M"
   then obtain k a b :: complex where
     **: "k \<noteq> 0" "mat_det (a, b, cnj b, cnj a) \<noteq> 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
     using unitary11_gen_iff[of M]
     by auto
   have "a \<noteq> 0"
     using * **
     by auto
   then obtain a' k' \<phi>
     where ***: "k' \<noteq> 0 \<and> a' * cnj a' \<noteq> 1 \<and> M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (1, - a', - cnj a', 1)"
     using ** unitary11_gen_cis_blaschke[of k M a b]
     by auto blast
   have "a' = 0 \<or> 1 < 1 / (cmod a')\<^sup>2"
     using * *** complex_mult_cnj_cmod[of a']
     by simp
   hence "cmod a' < 1"
     by (smt less_divide_eq_1_pos norm_zero one_less_power one_power2 pos2)
   thus "\<exists>k. cmod k < 1 \<and>
             (\<exists>\<phi>. moebius_cmat_eq M (moebius_comp_cmat (mk_moebius_cmat (cis \<phi>) 0 0 1) (blaschke_cmat k)))"
     using ***
     apply (rule_tac x=a' in exI)
     apply simp
     apply (rule_tac x=\<phi> in exI)
     apply simp
     apply (rule_tac x="1/k'" in exI)
     by auto
 qed
 
 lemma wlog_unit_disc_fix:
   assumes "unit_disc_fix M"
   assumes b: "\<And> k. cmod k < 1 \<Longrightarrow> P (blaschke k)"
   assumes r: "\<And> \<phi>. P (moebius_rotation \<phi>)"
   assumes comp: "\<And>M1 M2. \<lbrakk>unit_disc_fix M1; P M1; unit_disc_fix M2; P M2\<rbrakk> \<Longrightarrow> P (M1 + M2)"
   shows "P M"
   using assms
   using unit_disc_fix_decompose_blaschke_rotation[OF assms(1)]
   using blaschke_unit_disc_fix
   by auto
 
 lemma ex_unit_disc_fix_to_zero_positive_x_axis:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "u \<noteq> v"
   shows "\<exists> M. unit_disc_fix M \<and>
               moebius_pt M u = 0\<^sub>h \<and> moebius_pt M v \<in> positive_x_axis"
 proof-
   from assms obtain B where
     *: "unit_disc_fix B" "moebius_pt B u = 0\<^sub>h"
     using ex_unit_disc_fix_mapping_u_to_zero
     by blast
 
   let ?v = "moebius_pt B v"
   have "?v \<in> unit_disc"
     using \<open>v \<in> unit_disc\<close> *
     by auto
   hence "?v \<noteq> \<infinity>\<^sub>h"
     using inf_notin_unit_disc by auto
   have "?v \<noteq> 0\<^sub>h"
     using \<open>u \<noteq> v\<close> *
     by (metis moebius_pt_invert)
 
   obtain R where
     "unit_disc_fix R"
     "moebius_pt R 0\<^sub>h = 0\<^sub>h" "moebius_pt R ?v \<in> positive_x_axis"
     using ex_rotation_mapping_u_to_positive_x_axis[of ?v] \<open>?v \<noteq> 0\<^sub>h\<close> \<open>?v \<noteq> \<infinity>\<^sub>h\<close>
     using moebius_pt_rotation_inf_iff moebius_pt_moebius_rotation_zero unit_disc_fix_rotation
     by blast
   thus ?thesis
     using * moebius_comp[of R B, symmetric]
     using unit_disc_fix_moebius_comp
     by (rule_tac x="R + B" in exI) (simp add: comp_def)
 qed
 
 lemma wlog_x_axis:
   assumes in_disc: "u \<in> unit_disc" "v \<in> unit_disc"
   assumes preserved: "\<And> M u v. \<lbrakk>unit_disc_fix M; u \<in> unit_disc; v \<in> unit_disc; P (moebius_pt M u) (moebius_pt M v)\<rbrakk> \<Longrightarrow> P u v"
   assumes axis: "\<And> x. \<lbrakk>is_real x; 0 \<le> Re x;  Re x < 1\<rbrakk> \<Longrightarrow> P 0\<^sub>h (of_complex x)"
   shows "P u v"
 proof (cases "u = v")
   case True
   have "P u u" (is "?Q u")
   proof (rule wlog_zero[where P="?Q"])
     show "u \<in> unit_disc"
       by fact
   next
     show "?Q 0\<^sub>h"
       using axis[of 0]
       by simp
   next
     fix a u
     assume "u \<in> unit_disc" "cmod a < 1" "?Q (moebius_pt (blaschke a) u)"
     thus "?Q u"
       using preserved[of "blaschke a" u u]
       using blaschke_unit_disc_fix[of a]
       by simp
   qed
   thus ?thesis
     using True
     by simp
 next
   case False
   from in_disc obtain M where
     *: "unit_disc_fix M" "moebius_pt M u = 0\<^sub>h" "moebius_pt M v \<in> positive_x_axis"
     using ex_unit_disc_fix_to_zero_positive_x_axis False
     by auto
   then obtain x where **: "moebius_pt M v = of_complex x" "is_real x"
     unfolding positive_x_axis_def circline_set_x_axis
     by auto
   moreover
   have "of_complex x \<in> unit_disc"
     using \<open>unit_disc_fix M\<close> \<open>v \<in> unit_disc\<close> **
     using unit_disc_fix_discI
     by fastforce
   hence "0 < Re x" "Re x < 1"
     using \<open>moebius_pt M v \<in> positive_x_axis\<close> **
     by (auto simp add: positive_x_axis_def cmod_eq_Re)
   ultimately
   have "P 0\<^sub>h (of_complex x)"
     using \<open>is_real x\<close> axis
     by auto
   thus ?thesis
     using preserved[OF *(1) assms(1-2)] *(2) **(1)
     by simp
 qed
 
 lemma wlog_positive_x_axis:
   assumes in_disc: "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
   assumes preserved: "\<And> M u v. \<lbrakk>unit_disc_fix M; u \<in> unit_disc; v \<in> unit_disc; u \<noteq> v; P (moebius_pt M u) (moebius_pt M v)\<rbrakk> \<Longrightarrow> P u v"
   assumes axis: "\<And> x. \<lbrakk>is_real x; 0 < Re x;  Re x < 1\<rbrakk> \<Longrightarrow> P 0\<^sub>h (of_complex x)"
   shows "P u v"
 proof-
   have "u \<noteq> v \<longrightarrow> P u v" (is "?Q u v")
   proof (rule wlog_x_axis)
     show "u \<in> unit_disc" "v \<in> unit_disc"
       by fact+
   next
     fix M u v
     assume "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc"
            "?Q (moebius_pt M u) (moebius_pt M v)"
     thus "?Q u v"
       using preserved[of M u v]
       using moebius_pt_invert
       by blast
   next
     fix x
     assume "is_real x" "0 \<le> Re x" "Re x < 1"
     thus "?Q 0\<^sub>h (of_complex x)"
       using axis[of x] of_complex_zero_iff[of x] complex.expand[of x 0]
       by fastforce
   qed
   thus ?thesis
     using \<open>u \<noteq> v\<close>
     by simp
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>All functions that fix the unit disc\<close>
 (* -------------------------------------------------------------------------- *)
 
 text \<open>It can be proved that continuous functions that fix the unit disc are either actions of
 Möbius transformations that fix the unit disc (homographies), or are compositions of actions of
 Möbius transformations that fix the unit disc and the conjugation (antihomographies). We postulate
 this as a definition, but it this characterisation could also be formally shown (we do not need this
 for our further applications).\<close>
 
 definition unit_disc_fix_f where
   "unit_disc_fix_f f \<longleftrightarrow> 
    (\<exists> M. unit_disc_fix M \<and> (f = moebius_pt M \<or> f = moebius_pt M \<circ> conjugate))"
 
 text \<open>Unit disc fixing functions really fix unit disc.\<close>
 lemma unit_disc_fix_f_unit_disc:
   assumes "unit_disc_fix_f M"
   shows "M ` unit_disc = unit_disc"
   using assms
   unfolding unit_disc_fix_f_def
   using image_comp
   by force
 
 text \<open>Actions of unit disc fixing Möbius transformations (unit disc fixing homographies) are unit
 disc fixing functions.\<close>
 lemma unit_disc_fix_f_moebius_pt [simp]:
   assumes "unit_disc_fix M"
   shows "unit_disc_fix_f (moebius_pt M)"
   using assms
   unfolding unit_disc_fix_f_def
   by auto
 
 text \<open>Compositions of unit disc fixing Möbius transformations and conjugation (unit disc fixing
 antihomographies) are unit disc fixing functions.\<close>
 lemma unit_disc_fix_conjugate_moebius [simp]:
   assumes "unit_disc_fix M"
   shows "unit_disc_fix (conjugate_moebius M)"
 proof-
   have "\<And>a aa ab b. \<lbrakk>1 < Re (a * b / (aa * ab)); \<not> 1 < Re (cnj a * cnj b / (cnj aa * cnj ab))\<rbrakk> \<Longrightarrow> aa = 0"
     by (metis cnj.simps(1) complex_cnj_divide complex_cnj_mult)
   thus ?thesis
     using assms
     by (transfer, transfer)
        (auto simp add: mat_cnj_def unitary11_gen_def mat_adj_def field_simps)
 qed
 
 lemma unit_disc_fix_conjugate_comp_moebius [simp]:
   assumes "unit_disc_fix M"
   shows "unit_disc_fix_f (conjugate \<circ> moebius_pt M)"
   using assms
   apply (subst conjugate_moebius)
   apply (simp add: unit_disc_fix_f_def)
   apply (rule_tac x="conjugate_moebius M" in exI, simp)
   done
 
 
 text \<open>Uniti disc fixing functions form a group under function composition.\<close>
 
 lemma unit_disc_fix_f_comp [simp]:
   assumes "unit_disc_fix_f f1" and "unit_disc_fix_f f2"
   shows "unit_disc_fix_f (f1 \<circ> f2)"
   using assms
   apply (subst (asm) unit_disc_fix_f_def)
   apply (subst (asm) unit_disc_fix_f_def)
 proof safe
   fix M M'
   assume "unit_disc_fix M" "unit_disc_fix M'"
   thus "unit_disc_fix_f (moebius_pt M \<circ> moebius_pt M')"
     unfolding unit_disc_fix_f_def
     by (rule_tac x="M + M'" in exI) auto
 next
   fix M M'
   assume "unit_disc_fix M" "unit_disc_fix M'"
   thus "unit_disc_fix_f (moebius_pt M \<circ> (moebius_pt M' \<circ> conjugate))"
     unfolding unit_disc_fix_f_def
     by (subst comp_assoc[symmetric])+
        (rule_tac x="M + M'" in exI, auto)
 next
   fix M M'
   assume "unit_disc_fix M" "unit_disc_fix M'"
   thus "unit_disc_fix_f ((moebius_pt M \<circ> conjugate) \<circ> moebius_pt M')"
     unfolding unit_disc_fix_f_def
     by (subst comp_assoc, subst conjugate_moebius, subst comp_assoc[symmetric])+
        (rule_tac x="M + conjugate_moebius M'" in exI, auto)
 next
   fix M M'
   assume "unit_disc_fix M" "unit_disc_fix M'"
   thus "unit_disc_fix_f ((moebius_pt M \<circ> conjugate) \<circ> (moebius_pt M' \<circ> conjugate))"
     apply (subst comp_assoc[symmetric], subst comp_assoc)
     apply (subst conjugate_moebius, subst comp_assoc, subst comp_assoc)
     apply (simp add: unit_disc_fix_f_def)
     apply (rule_tac x="M + conjugate_moebius M'" in exI, auto)
     done
 qed
 
 lemma unit_disc_fix_f_inv:
   assumes "unit_disc_fix_f M"
   shows "unit_disc_fix_f (inv M)"
   using assms
   apply (subst (asm) unit_disc_fix_f_def)
 proof safe
   fix M
   assume "unit_disc_fix M"
   have "inv (moebius_pt M) = moebius_pt (-M)"
     by (rule ext) (simp add: moebius_inv)
   thus "unit_disc_fix_f (inv (moebius_pt M))"
     using \<open>unit_disc_fix M\<close>
     unfolding unit_disc_fix_f_def
     by (rule_tac x="-M" in exI, simp)
 next
   fix M
   assume "unit_disc_fix M"
   have "inv (moebius_pt M \<circ> conjugate) = conjugate \<circ> inv (moebius_pt M)"
     by (subst o_inv_distrib, simp_all)
   also have "... = conjugate \<circ> (moebius_pt (-M))"
     using moebius_inv
     by auto
   also have "... = moebius_pt (conjugate_moebius (-M)) \<circ> conjugate"
     by (simp add: conjugate_moebius)
   finally
   show "unit_disc_fix_f (inv (moebius_pt M \<circ> conjugate))"
     using \<open>unit_disc_fix M\<close>
     unfolding unit_disc_fix_f_def
     by (rule_tac x="conjugate_moebius (-M)" in exI, simp)
 qed
 
 (* -------------------------------------------------------------------------- *)
 subsubsection \<open>Action of unit disc fixing functions on circlines\<close>
 (* -------------------------------------------------------------------------- *)
 
 definition unit_disc_fix_f_circline where
   "unit_disc_fix_f_circline f H = 
       (if \<exists> M. unit_disc_fix M \<and> f = moebius_pt M then
           moebius_circline (THE M. unit_disc_fix M \<and> f = moebius_pt M) H
        else if \<exists> M. unit_disc_fix M \<and> f = moebius_pt M \<circ> conjugate then
           (moebius_circline (THE M. unit_disc_fix M \<and> f = moebius_pt M \<circ> conjugate) \<circ> conjugate_circline) H
        else
           H)"
 
 
 lemma unique_moebius_pt_conjugate:
   assumes "moebius_pt M1 \<circ> conjugate = moebius_pt M2 \<circ> conjugate"
   shows "M1 = M2"
 proof-               
   from assms have "moebius_pt M1 = moebius_pt M2"
     using conjugate_conjugate_comp rewriteL_comp_comp2 by fastforce
   thus ?thesis
     using unique_moebius_pt
     by auto
 qed
 
 lemma unit_disc_fix_f_circline_direct:
   assumes "unit_disc_fix M" and "f = moebius_pt M"
   shows "unit_disc_fix_f_circline f H = moebius_circline M H"
 proof-
   have "M = (THE M. unit_disc_fix M \<and> f = moebius_pt M)"
     using assms
     using theI_unique[of "\<lambda> M. unit_disc_fix M \<and> f = moebius_pt M" M]
     using unique_moebius_pt[of M]
     by auto
   thus ?thesis
     using assms
     unfolding unit_disc_fix_f_circline_def
     by auto
 qed
 
 lemma unit_disc_fix_f_circline_indirect:
   assumes "unit_disc_fix M" and "f = moebius_pt M \<circ> conjugate"
   shows "unit_disc_fix_f_circline f H = ((moebius_circline M) \<circ> conjugate_circline) H"
 proof-
   have "\<not> (\<exists> M. unit_disc_fix M \<and> f = moebius_pt M)"
     using assms homography_antihomography_exclusive[of f]
     unfolding is_homography_def is_antihomography_def is_moebius_def
     by auto
   moreover
   have "M = (THE M. unit_disc_fix M \<and> f = moebius_pt M \<circ> conjugate)"
     using assms
     using theI_unique[of "\<lambda> M. unit_disc_fix M \<and> f = moebius_pt M \<circ> conjugate" M]
     using unique_moebius_pt_conjugate[of M] 
     by auto
   ultimately
   show ?thesis
     using assms
     unfolding unit_disc_fix_f_circline_def
     by metis
 qed
 
 text \<open>Disc automorphisms - it would be nice to show that there are no disc automorphisms other than
 unit disc fixing homographies and antihomographies, but this part of the theory is not yet
 developed.\<close>
 
 definition is_disc_aut where "is_disc_aut f \<longleftrightarrow> bij_betw f unit_disc unit_disc"
 
 end
\ No newline at end of file
diff --git a/thys/Complex_Geometry/Unitary11_Matrices.thy b/thys/Complex_Geometry/Unitary11_Matrices.thy
--- a/thys/Complex_Geometry/Unitary11_Matrices.thy
+++ b/thys/Complex_Geometry/Unitary11_Matrices.thy
@@ -1,607 +1,607 @@
 (* ----------------------------------------------------------------- *)
 subsection \<open>Generalized unitary matrices with signature $(1, 1)$\<close>
 (* ----------------------------------------------------------------- *)
 
 theory Unitary11_Matrices
 imports Matrices More_Complex
 begin
 
 text \<open> When acting as Möbius transformations in the extended
 complex plane, generalized complex $2\times 2$ unitary matrices fix
 the imaginary unit circle (a Hermitean form with (2, 0) signature). We
 now describe matrices that fix the ordinary unit circle (a Hermitean
 form with (1, 1) signature, i.e., one positive and one negative
 element on the diagonal). These are extremely important for further
 formalization, since they will represent disc automorphisims and
 isometries of the Poincar\'e disc. The development of this theory
 follows the development of the theory of generalized unitary matrices.
 \<close>
 
 text \<open>Unitary11 matrices\<close>
 definition unitary11 where
   "unitary11 M \<longleftrightarrow> congruence M (1, 0, 0, -1) = (1, 0, 0, -1)"
 
 text \<open>Generalized unitary11 matrices\<close>
 definition unitary11_gen where
   "unitary11_gen M \<longleftrightarrow> (\<exists> k. k \<noteq> 0 \<and> congruence M (1, 0, 0, -1) = k *\<^sub>s\<^sub>m (1, 0, 0, -1))"
 
 text \<open>Scalar can always be a non-zero real number\<close>
 lemma unitary11_gen_real:
   shows "unitary11_gen M \<longleftrightarrow> (\<exists> k. k \<noteq> 0 \<and> congruence M (1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1))"
   unfolding unitary11_gen_def
 proof (auto simp del: congruence_def)
   fix k
   assume "k \<noteq> 0" "congruence M (1, 0, 0, -1) = (k, 0, 0, - k)"
   hence "mat_det (congruence M (1, 0, 0, -1)) = -k*k"
     by simp
   moreover
   have "is_real (mat_det (congruence M (1, 0, 0, -1)))" "Re (mat_det (congruence M (1, 0, 0, -1))) \<le> 0"
     by (auto simp add: mat_det_adj)
   ultimately
   have "is_real (k*k)" "Re (-k*k) \<le> 0"
     by auto
   hence "is_real (k*k) \<and> Re (k * k) > 0"
     using \<open>k \<noteq> 0\<close>
     by (smt complex_eq_if_Re_eq mult_eq_0_iff mult_minus_left uminus_complex.simps(1) zero_complex.simps(1) zero_complex.simps(2))
   hence "is_real k"
     by auto
   thus "\<exists>ka. ka \<noteq> 0 \<and> k = cor ka"
     using \<open>k \<noteq> 0\<close>
     by (rule_tac x="Re k" in exI) (cases k, auto simp add: Complex_eq)
 qed
 
 text \<open>Unitary11 matrices are special cases of generalized unitary 11 matrices\<close>
 lemma unitary11_unitary11_gen [simp]:
   assumes "unitary11 M"
   shows "unitary11_gen M"
   using assms
   unfolding unitary11_gen_def unitary11_def
   by (rule_tac x="1" in exI, auto)
 
 text \<open>All generalized unitary11 matrices are regular\<close>
 lemma unitary11_gen_regular:
   assumes "unitary11_gen M"
   shows "mat_det M \<noteq> 0"
 proof-
   from assms obtain k where
     "k \<noteq> 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)"
     unfolding unitary11_gen_real
     by auto
   hence "mat_det (mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M) \<noteq> 0"
     by simp
   thus ?thesis
     by (simp add: mat_det_adj)
 qed
 
 lemmas unitary11_regular = unitary11_gen_regular[OF unitary11_unitary11_gen]
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>The characterization in terms of matrix elements\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>Special matrices are those having the determinant equal to 1. We first give their characterization.\<close>
 lemma unitary11_special:
   assumes "unitary11 M" and "mat_det M = 1"
   shows "\<exists> a b. M = (a, b, cnj b, cnj a)"
 proof-
   have "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) = (1, 0, 0, -1) *\<^sub>m\<^sub>m mat_inv M"
     using assms mult_mm_inv_r
     by (simp add: unitary11_def)
   thus ?thesis
     using assms(2)
     by (cases M) (simp add: mat_adj_def mat_cnj_def)
 qed
 
 lemma unitary11_gen_special:
   assumes "unitary11_gen M" and "mat_det M = 1"
   shows "\<exists> a b. M = (a, b, cnj b, cnj a) \<or> M = (a, b, -cnj b, -cnj a)"
 proof-
   from assms
   obtain k where *: "k \<noteq> 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)"
     unfolding unitary11_gen_real
     by auto
   hence "mat_det (mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M) = -  cor k* cor k"
     by simp
   hence "mat_det (mat_adj M *\<^sub>m\<^sub>m M) = cor k* cor k"
     by simp
   hence "cor k* cor k = 1"
     using assms(2)
     by (simp add: mat_det_adj)
   hence "cor k = 1 \<or> cor k = -1"
     using square_eq_1_iff[of "cor k"]
     by simp
   moreover
   have "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) = (cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)) *\<^sub>m\<^sub>m mat_inv M "
     using *
     using assms mult_mm_inv_r mat_eye_r mat_eye_l
     by auto
   moreover
   obtain a b c d where "M = (a, b, c, d)"
     by (cases M) auto
   ultimately
   have "M = (a, b, cnj b, cnj a) \<or> M = (a, b, -cnj b, -cnj a)"
     using assms(2)
     by (auto simp add: mat_adj_def mat_cnj_def)
   thus ?thesis
     by auto
 qed
 
 text \<open>A characterization of all generalized unitary11 matrices\<close>
 lemma unitary11_gen_iff':
   shows "unitary11_gen M \<longleftrightarrow>
          (\<exists> a b k. k \<noteq> 0 \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0 \<and>
                            (M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<or> 
                             M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)))" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   obtain d where *: "d*d = mat_det M"
     using ex_complex_sqrt
     by auto
   hence "d \<noteq> 0"
     using unitary11_gen_regular[OF \<open>unitary11_gen M\<close>]
     by auto
   from \<open>unitary11_gen M\<close>
   obtain k where "k \<noteq> 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)"
     unfolding unitary11_gen_real
     by auto
   hence "mat_adj ((1/d)*\<^sub>s\<^sub>mM)*\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m ((1/d)*\<^sub>s\<^sub>mM) = (cor k / (d*cnj d)) *\<^sub>s\<^sub>m (1, 0, 0, -1)"
     by simp
   moreover
   have "is_real (cor k / (d * cnj d))"
     by (metis complex_In_mult_cnj_zero div_reals Im_complex_of_real)
   hence "cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)"
     by simp
   ultimately
   have "unitary11_gen ((1/d)*\<^sub>s\<^sub>mM)"
     unfolding unitary11_gen_real
     using \<open>d \<noteq> 0\<close> \<open>k \<noteq> 0\<close>
     using \<open>cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)\<close>
     by (rule_tac x="Re (cor k / (d * cnj d))" in exI, auto, simp add: *)
   moreover
   have "mat_det ((1 / d) *\<^sub>s\<^sub>m M) = 1"
     using * unitary11_gen_regular[of M] \<open>unitary11_gen M\<close>
     by auto
   ultimately
   obtain a b where "(a, b, cnj b, cnj a) = (1 / d) *\<^sub>s\<^sub>m M \<or> (a, b, -cnj b, -cnj a) = (1 / d) *\<^sub>s\<^sub>m M"
     using unitary11_gen_special[of "(1 / d) *\<^sub>s\<^sub>m M"]
     by force
   thus ?rhs
   proof
     assume "(a, b, cnj b, cnj a) = (1 / d) *\<^sub>s\<^sub>m M"
     moreover
     hence "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
       using unitary11_gen_regular[OF \<open>unitary11_gen M\<close>] \<open>d \<noteq> 0\<close>
       by auto
     ultimately
     show ?rhs
       using \<open>d \<noteq> 0\<close>
       by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI, simp)
   next
     assume *: "(a, b, -cnj b, -cnj a) = (1 / d) *\<^sub>s\<^sub>m M"
     hence " (1 / d) *\<^sub>s\<^sub>m M = (a, b, -cnj b, -cnj a)"
       by simp
     hence "M = (a * d, b * d, - (d * cnj b), - (d * cnj a))"
       using \<open>d \<noteq> 0\<close>
       using mult_sm_inv_l[of "1/d" M "(a, b, -cnj b, -cnj a)", symmetric]
       by (simp add: field_simps)
     moreover
     have "mat_det (a, b, -cnj b, -cnj a) \<noteq> 0"
       using * unitary11_gen_regular[OF \<open>unitary11_gen M\<close>] \<open>d \<noteq> 0\<close>
       by auto
     ultimately
     show ?thesis
       using \<open>d \<noteq> 0\<close>
       by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="-d" in exI) (simp add: field_simps)
   qed
 next
   assume ?rhs
   then obtain a b k where "k \<noteq> 0" "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
     "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<or> M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)"
     by auto
   moreover
   let ?x = "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b))"
   have "?x = (k*cnj k)*(a*cnj a - b*cnj b)"
     by (auto simp add: field_simps)
   hence "is_real ?x"
     by simp
   hence "cor (Re ?x) = ?x"
     by (rule complex_of_real_Re)
   moreover
   have "?x \<noteq> 0"
     using mult_eq_0_iff[of "cnj k * k" "(cnj a * a + - cnj b * b)"]
     using \<open>mat_det (a, b, cnj b, cnj a) \<noteq> 0\<close> \<open>k \<noteq> 0\<close>
     by (auto simp add: field_simps)
   hence "Re ?x \<noteq> 0"
     using \<open>is_real ?x\<close>
     by (metis calculation(4) of_real_0)
   ultimately
   show ?lhs
     unfolding unitary11_gen_real
     by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
 qed
 
 text \<open>Another characterization of all generalized unitary11 matrices. They are products of 
 rotation and Blaschke factor matrices.\<close>
 lemma unitary11_gen_cis_blaschke:
   assumes "k \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and 
           "a \<noteq> 0" and "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
   shows "\<exists> k' \<phi> a'. k' \<noteq> 0 \<and> a' * cnj a' \<noteq> 1 \<and> 
                                  M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)"
 proof-
-  have "a = cnj a * cis (2 * arg a)"
-    using rcis_cmod_arg[of a] rcis_cnj[of a]
+  have "a = cnj a * cis (2 * Arg a)"
+    using rcis_cmod_Arg[of a] rcis_cnj[of a]
     using cis_rcis_eq rcis_mult
     by simp
   thus ?thesis
     using assms
-    by (rule_tac x="k*cnj a" in exI, rule_tac x="2*arg a" in exI, rule_tac x="- b / a" in exI) (auto simp add: field_simps)
+    by (rule_tac x="k*cnj a" in exI, rule_tac x="2*Arg a" in exI, rule_tac x="- b / a" in exI) (auto simp add: field_simps)
 qed
 
 lemma unitary11_gen_cis_blaschke':
   assumes "k \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)" and
           "a \<noteq> 0" and "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
   shows "\<exists> k' \<phi> a'. k' \<noteq> 0 \<and> a' * cnj a' \<noteq> 1 \<and>
                                  M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)"
 proof-
   obtain k' \<phi> a' where *: "k' \<noteq> 0" "k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" "a' * cnj a' \<noteq> 1"
     using unitary11_gen_cis_blaschke[OF \<open>k \<noteq> 0\<close> _ \<open>a \<noteq> 0\<close>] \<open>mat_det (a, b, cnj b, cnj a) \<noteq> 0\<close>
     by blast
   have "(cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (-1, 0, 0, 1) = (cis (\<phi> + pi), 0, 0, 1)"
    by (simp add: cis_def complex.corec Complex_eq)
   thus ?thesis
     using * \<open>M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)\<close>
     by (rule_tac x="k'" in exI, rule_tac x="\<phi> + pi" in exI, rule_tac x="a'" in exI, simp)
 qed
 
 lemma unitary11_gen_cis_blaschke_rev:
   assumes "k' \<noteq> 0" and "M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" and
           "a' * cnj a' \<noteq> 1"
   shows "\<exists> k a b. k \<noteq> 0 \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0  \<and>
                           M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
   using assms
   apply (rule_tac x="k'*cis(\<phi>/2)" in exI, rule_tac x="cis(\<phi>/2)" in exI, rule_tac x="-a'*cis(\<phi>/2)" in exI)
   apply (simp add: cis_mult mult.commute mult.left_commute)
   done
 
 lemma unitary11_gen_cis_inversion:
   assumes "k \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (0, b, cnj b, 0)" and "b \<noteq> 0"
   shows "\<exists> k' \<phi>. k' \<noteq> 0 \<and>
                               M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)"
 using assms
-using rcis_cmod_arg[of b, symmetric] rcis_cnj[of b] cis_rcis_eq
-by simp (rule_tac x="2*arg b" in exI, simp add: rcis_mult)
+using rcis_cmod_Arg[of b, symmetric] rcis_cnj[of b] cis_rcis_eq
+by simp (rule_tac x="2*Arg b" in exI, simp add: rcis_mult)
 
 lemma unitary11_gen_cis_inversion':
   assumes "k \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (0, b, cnj b, 0)" and "b \<noteq> 0"
   shows "\<exists> k' \<phi>. k' \<noteq> 0 \<and>
                    M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)"
 proof-
   obtain k' \<phi> where *: "k' \<noteq> 0" "k *\<^sub>s\<^sub>m (0, b, cnj b, 0) = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)"
     using unitary11_gen_cis_inversion[OF \<open>k \<noteq> 0\<close> _ \<open>b \<noteq> 0\<close>]
     by metis
   have "(cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (-1, 0, 0, 1) = (cis (\<phi> + pi), 0, 0, 1)"
     by (simp add: cis_def complex.corec Complex_eq)
   thus ?thesis
     using * \<open>M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (0, b, cnj b, 0)\<close>
     by (rule_tac x="k'" in exI, rule_tac x="\<phi> + pi" in exI, simp)
 qed
 
 lemma unitary11_gen_cis_inversion_rev:
   assumes "k' \<noteq> 0" and "M = k' *\<^sub>s\<^sub>m (cis \<phi>, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)"
   shows "\<exists> k a b. k \<noteq> 0 \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0 \<and>
                           M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
   using assms
   by (rule_tac x="k'*cis(\<phi>/2)" in exI, rule_tac x=0 in exI, rule_tac x="cis(\<phi>/2)" in exI) (simp add: cis_mult)
 
 text \<open>Another characterization of generalized unitary11 matrices\<close>
 lemma unitary11_gen_iff:
   shows "unitary11_gen M \<longleftrightarrow> 
          (\<exists> k a b. k \<noteq> 0 \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0 \<and>
                            M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain a b k where *: "k \<noteq> 0" "mat_det (a, b, cnj b, cnj a) \<noteq> 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<or> M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)"
     using unitary11_gen_iff'
     by auto
   show ?rhs
   proof (cases "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)")
     case True
     thus ?thesis
       using *
       by auto
   next
     case False
     hence **: "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)"
       using *
       by simp
     show ?thesis
     proof (cases "a = 0")
       case True
       hence "b \<noteq> 0"
         using *
         by auto
       show ?thesis
         using unitary11_gen_cis_inversion_rev[of _ M]
         using ** \<open>a = 0\<close>
         using unitary11_gen_cis_inversion'[OF \<open>k \<noteq> 0\<close> _ \<open>b \<noteq> 0\<close>, of M]
         by auto
     next
       case False
       show ?thesis
         using unitary11_gen_cis_blaschke_rev[of _ M]
         using **
         using unitary11_gen_cis_blaschke'[OF \<open>k \<noteq> 0\<close> _ \<open>a \<noteq> 0\<close>, of M b] \<open>mat_det (a, b, cnj b, cnj a) \<noteq> 0\<close>
         by blast
     qed
   qed
 next
   assume ?rhs
   thus ?lhs
     using unitary11_gen_iff'
     by auto
 qed
 
 lemma unitary11_iff:
   shows "unitary11 M \<longleftrightarrow>
          (\<exists> a b k. (cmod a)\<^sup>2 > (cmod b)\<^sup>2 \<and>
                            (cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) \<and>
                            M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   obtain k a b where *:
     "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)""mat_det (a, b, cnj b, cnj a) \<noteq> 0" "k \<noteq> 0"
     using unitary11_gen_iff unitary11_unitary11_gen[OF \<open>unitary11 M\<close>]
     by auto
 
   have md: "mat_det (a, b, cnj b, cnj a) = cor ((cmod a)\<^sup>2 - (cmod b)\<^sup>2)"
     by (auto simp add: complex_mult_cnj_cmod)
   hence **: "(cmod a)\<^sup>2 \<noteq> (cmod b)\<^sup>2"
     using \<open>mat_det (a, b, cnj b, cnj a) \<noteq> 0\<close>
     by auto
 
   have "k * cnj k * mat_det (a, b, cnj b, cnj a) = 1"
     using \<open>M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\<close>
     using \<open>unitary11 M\<close>
     unfolding unitary11_def
     by (auto simp add: mat_adj_def mat_cnj_def) (simp add: field_simps)
   hence ***: "(cmod k)\<^sup>2 * ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) = 1"
     by (metis complex_mult_cnj_cmod md of_real_1 of_real_eq_iff of_real_mult)
   hence "((cmod a)\<^sup>2 - (cmod b)\<^sup>2) = 1 / (cmod k)\<^sup>2"
     by (cases "k=0") (auto simp add: field_simps)
   hence "cmod a ^ 2 = cmod b ^ 2 + 1 / cmod k ^ 2"
     by simp
   thus ?rhs
     using \<open>M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\<close> ** mat_eye_l
     by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)
        (auto simp add: complex_mult_cnj_cmod intro!: )
 next
   assume ?rhs
   then obtain a b k where "(cmod b)\<^sup>2 < (cmod a)\<^sup>2 \<and> (cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) \<and> M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
     by auto
   moreover
   have "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b)) = (cor ((cmod k)\<^sup>2 * ((cmod a)\<^sup>2 - (cmod b)\<^sup>2)))"
   proof-
     have "cnj k * cnj a * (k * a) = cor ((cmod k)\<^sup>2 * (cmod a)\<^sup>2)"
       using complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of k]
       by (auto simp add: field_simps)
     moreover
     have "cnj k * b * (k * cnj b) = cor ((cmod k)\<^sup>2 * (cmod b)\<^sup>2)"
       using complex_mult_cnj_cmod[of b, symmetric] complex_mult_cnj_cmod[of k]
       by (auto simp add: field_simps)
     ultimately
     show ?thesis
       by (auto simp add: field_simps)
   qed
   ultimately
   show ?lhs
     unfolding unitary11_def
     by (auto simp add: mat_adj_def mat_cnj_def field_simps)
 qed
 
 (* ----------------------------------------------------------------- *)
 subsubsection \<open>Group properties\<close>
 (* ----------------------------------------------------------------- *)
 
 text \<open>Generalized unitary11 matrices form a group under
 multiplication (it is sometimes denoted by $GU_{1, 1}(2,
 \mathbb{C})$). The group is also closed under non-zero complex scalar
 multiplication. Since these matrices are always regular, they form a
 subgroup of general linear group (usually denoted by $GL(2,
 \mathbb{C})$) of all regular matrices.\<close>
 
 lemma unitary11_gen_mult_sm:
   assumes "k \<noteq> 0" and "unitary11_gen M"
   shows "unitary11_gen (k *\<^sub>s\<^sub>m M)"
 proof-
   have "k * cnj k = cor (Re (k * cnj k))"
     by (subst complex_of_real_Re) auto
   thus ?thesis
     using assms
     unfolding unitary11_gen_real
     by auto (rule_tac x="Re (k*cnj k) * ka" in exI, auto)
 qed
 
 lemma unitary11_gen_div_sm:
   assumes "k \<noteq> 0" and "unitary11_gen (k *\<^sub>s\<^sub>m M)"
   shows "unitary11_gen M"
   using assms unitary11_gen_mult_sm[of "1/k" "k *\<^sub>s\<^sub>m M"]
   by simp
 
 
 lemma unitary11_inv:
   assumes "k \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and "mat_det (a, b, cnj b, cnj a) \<noteq> 0"
   shows "\<exists> k' a' b'. k' \<noteq> 0 \<and> mat_inv M = k' *\<^sub>s\<^sub>m (a', b', cnj b', cnj a') \<and> mat_det (a', b', cnj b', cnj a') \<noteq> 0"
   using assms
   by (subst assms, subst mat_inv_mult_sm[OF assms(1)])
      (rule_tac x="1/(k * mat_det (a, b, cnj b, cnj a))" in exI, rule_tac x="cnj a" in exI, rule_tac x="-b" in exI, simp add: field_simps)
 
 lemma unitary11_comp:
   assumes "k1 \<noteq> 0" and "M1 = k1 *\<^sub>s\<^sub>m (a1, b1, cnj b1, cnj a1)" and "mat_det (a1, b1, cnj b1, cnj a1) \<noteq> 0"
           "k2 \<noteq> 0" "M2 = k2 *\<^sub>s\<^sub>m (a2, b2, cnj b2, cnj a2)" "mat_det (a2, b2, cnj b2, cnj a2) \<noteq> 0"
   shows "\<exists> k a b. k \<noteq> 0 \<and> M1 *\<^sub>m\<^sub>m M2 = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0"
   using assms
   apply (rule_tac x="k1*k2" in exI)
   apply (rule_tac x="a1*a2 + b1*cnj b2" in exI)
   apply (rule_tac x="a1*b2 + b1*cnj a2" in exI)
 proof (auto simp add: algebra_simps)
   assume *: "a1 * (a2 * (cnj a1 * cnj a2)) + b1 * (b2 * (cnj b1 * cnj b2)) =
             a1 * (b2 * (cnj a1 * cnj b2)) + a2 * (b1 * (cnj a2 * cnj b1))" and
          **: "a1*cnj a1 \<noteq> b1 * cnj b1" "a2*cnj a2 \<noteq> b2*cnj b2"
   hence "(a1*cnj a1)*(a2*cnj a2 - b2*cnj b2) = (b1*cnj b1)*(a2*cnj a2 - b2*cnj b2)"
     by (simp add: field_simps)
   hence "a1*cnj a1 = b1*cnj b1"
     using **(2)
     by simp
   thus False
     using **(1)
     by simp
 qed
 
 lemma unitary11_gen_mat_inv:
   assumes "unitary11_gen M" and "mat_det M \<noteq> 0"
   shows "unitary11_gen (mat_inv M)"
 proof-
   obtain k a b where "k \<noteq> 0 \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0 \<and> M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
     using assms unitary11_gen_iff[of M]
     by auto
   then obtain k' a' b' where "k' \<noteq> 0 \<and> mat_inv M = k' *\<^sub>s\<^sub>m (a', b', cnj b', cnj a') \<and> mat_det (a', b', cnj b', cnj a') \<noteq> 0"
     using unitary11_inv [of k M a b]
     by auto
   thus ?thesis
     using unitary11_gen_iff[of "mat_inv M"]
     by auto
 qed
 
 lemma unitary11_gen_comp:
   assumes "unitary11_gen M1" and "mat_det M1 \<noteq> 0" and "unitary11_gen M2"  and "mat_det M2 \<noteq> 0"
   shows "unitary11_gen (M1 *\<^sub>m\<^sub>m M2)"
 proof-
   from assms obtain k1 k2 a1 a2 b1 b2 where
     "k1 \<noteq> 0 \<and> mat_det (a1, b1, cnj b1, cnj a1) \<noteq> 0 \<and> M1 = k1 *\<^sub>s\<^sub>m (a1, b1, cnj b1, cnj a1)"
     "k2 \<noteq> 0 \<and> mat_det (a2, b2, cnj b2, cnj a2) \<noteq> 0 \<and> M2 = k2 *\<^sub>s\<^sub>m (a2, b2, cnj b2, cnj a2)"
     using unitary11_gen_iff[of M1]  unitary11_gen_iff[of M2]
     by blast
   then obtain k a b where "k \<noteq> 0 \<and> M1 *\<^sub>m\<^sub>m M2 = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<and> mat_det (a, b, cnj b, cnj a) \<noteq> 0"
     using unitary11_comp[of k1 M1 a1 b1 k2 M2 a2 b2]
     by blast
   thus ?thesis
     using unitary11_gen_iff[of "M1 *\<^sub>m\<^sub>m M2"]
     by blast
 qed
 
 text \<open>Classification into orientation-preserving and orientation-reversing matrices\<close>
 lemma unitary11_sgn_det_orientation:
   assumes "k \<noteq> 0" and "mat_det (a, b, cnj b, cnj a) \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
   shows "\<exists> k'. sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a))) \<and> congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)"
 proof-
   let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
   have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
     by (auto simp add: field_simps)
   hence "is_real ?x"
     by auto
   hence "cor (Re ?x) = ?x"
     by (rule complex_of_real_Re)
   moreover
   have "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
   proof-
     have *: "Re ?x = (cmod k)\<^sup>2 * Re (a * cnj a - b * cnj b)"
       by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
     show ?thesis
       using \<open>k \<noteq> 0\<close>
       by (subst *) (simp add: sgn_mult)
   qed
   ultimately
   show ?thesis
     using assms(3)
     by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
 qed
 
 lemma unitary11_sgn_det:
   assumes "k \<noteq> 0" and "mat_det (a, b, cnj b, cnj a) \<noteq> 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and "M = (A, B, C, D)"
   shows "sgn (Re (mat_det (a, b, cnj b, cnj a))) = (if b = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1))"
 proof (cases "b = 0")
   case True
   thus ?thesis
     using assms
     by (simp only: mat_det.simps, subst complex_mult_cnj_cmod, subst minus_complex.sel, subst Re_complex_of_real, simp)
 next
   case False
   from assms have *: "A =  k * a" "B =  k * b" "C =  k * cnj b" "D =  k * cnj a"
     by auto
   hence *: "(A*D)/(B*C) = (a*cnj a)/(b*cnj b)"
     using \<open>k \<noteq> 0\<close>
     by simp
   show ?thesis
     using \<open>b \<noteq> 0\<close>
     apply (subst *, subst Re_divide_real, simp, simp)
     apply (simp only: mat_det.simps)
     apply (subst complex_mult_cnj_cmod)+
     apply ((subst Re_complex_of_real)+, subst minus_complex.sel, (subst Re_complex_of_real)+, simp add: field_simps sgn_if)
     done
 qed
 
 lemma unitary11_orientation:
   assumes "unitary11_gen M" and "M = (A, B, C, D)"
   shows "\<exists> k'. sgn k' = sgn (if B = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1)) \<and> congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)"
 proof-
   from \<open>unitary11_gen M\<close>
   obtain k a b where *: "k \<noteq> 0" "mat_det (a, b, cnj b, cnj a) \<noteq> 0" "M = k*\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
     using unitary11_gen_iff[of M]
     by auto
   moreover
   have "b = 0 \<longleftrightarrow> B = 0"
     using \<open>M = (A, B, C, D)\<close> *
     by auto
   ultimately
   show ?thesis
     using unitary11_sgn_det_orientation[OF *] unitary11_sgn_det[OF * \<open>M = (A, B, C, D)\<close>]
     by auto
 qed
 
 lemma unitary11_sgn_det_orientation':
   assumes "congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)" and "k' \<noteq> 0"
   shows "\<exists> a b k. k \<noteq> 0 \<and> M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \<and> sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
 proof-
   obtain a b k where
     "k \<noteq> 0" "mat_det (a, b, cnj b, cnj a) \<noteq> 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)"
     using assms
     using unitary11_gen_iff[of M]
     unfolding unitary11_gen_def
     by auto
   moreover
   have "sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
   proof-
     let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
     have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
       by (auto simp add: field_simps)
     hence "is_real ?x"
       by auto
     hence "cor (Re ?x) = ?x"
       by (rule complex_of_real_Re)
 
     have **: "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
     proof-
       have *: "Re ?x = (cmod k)\<^sup>2 * Re (a * cnj a - b * cnj b)"
         by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
       show ?thesis
         using \<open>k \<noteq> 0\<close>
         by (subst *) (simp add: sgn_mult)
     qed
     moreover
     have "?x = cor k'"
       using \<open>M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\<close> assms
       by (simp add: mat_adj_def mat_cnj_def)
     hence "sgn (Re ?x) = sgn k'"
       using \<open>cor (Re ?x) = ?x\<close>
       unfolding complex_of_real_def
       by simp
     ultimately
     show ?thesis
       by simp
   qed
   ultimately
   show ?thesis
     by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)  simp
 qed
 
 end
diff --git a/thys/Lambda_Free_KBOs/Lambda_Free_TKBO_Coefs.thy b/thys/Lambda_Free_KBOs/Lambda_Free_TKBO_Coefs.thy
--- a/thys/Lambda_Free_KBOs/Lambda_Free_TKBO_Coefs.thy
+++ b/thys/Lambda_Free_KBOs/Lambda_Free_TKBO_Coefs.thy
@@ -1,1999 +1,1997 @@
 (*  Title:       The Graceful Transfinite Knuth-Bendix Order with Subterm Coefficients for Lambda-Free Higher-Order Terms
     Author:      Heiko Becker <heikobecker92@gmail.com>, 2016
     Author:      Jasmin Blanchette <jasmin.blanchette at inria.fr>, 2016
     Author:      Uwe Waldmann <waldmann at mpi-inf.mpg.de>, 2016
     Author:      Daniel Wand <dwand at mpi-inf.mpg.de>, 2016
     Maintainer:  Jasmin Blanchette <jasmin.blanchette at inria.fr>
 *)
 
 section \<open>The Graceful Transfinite Knuth--Bendix Order with Subterm Coefficients for
   Lambda-Free Higher-Order Terms\<close>
 
 theory Lambda_Free_TKBO_Coefs
 imports Lambda_Free_KBO_Util Nested_Multisets_Ordinals.Signed_Syntactic_Ordinal
 abbrevs "=p" = "=\<^sub>p"
   and ">p" = ">\<^sub>p"
   and "\<ge>p" = "\<ge>\<^sub>p"
   and ">t" = ">\<^sub>t"
   and "\<ge>t" = "\<ge>\<^sub>t"
   and "!h" = "\<^sub>h"
 begin
 
 text \<open>
 This theory defines the graceful transfinite Knuth--Bendix order (KBO) with
 subterm coefficients for \<open>\<lambda>\<close>-free higher-order terms. The proof was
 developed by copying that of the standard KBO and generalizing it along two
 axes:\ subterm coefficients and ordinals. Both features complicate the
 definitions and proofs substantially.
 \<close>
 
 
 subsection \<open>Setup\<close>
 
-hide_const (open) Complex.arg
-
 locale tkbo_coefs = kbo_std_basis _ _ arity_sym arity_var wt_sym
     for
       arity_sym :: "'s \<Rightarrow> enat" and
       arity_var :: "'v \<Rightarrow> enat" and
       wt_sym :: "'s \<Rightarrow> hmultiset" +
   fixes coef_sym :: "'s \<Rightarrow> nat \<Rightarrow> hmultiset"
   assumes coef_sym_gt_0: "coef_sym f i > 0"
 begin
 
 abbreviation \<delta>\<^sub>h :: hmultiset where
   "\<delta>\<^sub>h \<equiv> of_nat \<delta>"
 
 abbreviation \<epsilon>\<^sub>h :: hmultiset where
   "\<epsilon>\<^sub>h \<equiv> of_nat \<epsilon>"
 
 abbreviation arity_sym\<^sub>h :: "'s \<Rightarrow> hmultiset" where
   "arity_sym\<^sub>h f \<equiv> hmset_of_enat (arity_sym f)"
 
 abbreviation arity_var\<^sub>h :: "'v \<Rightarrow> hmultiset" where
   "arity_var\<^sub>h f \<equiv> hmset_of_enat (arity_var f)"
 
 abbreviation arity_hd\<^sub>h :: "('s, 'v) hd \<Rightarrow> hmultiset" where
   "arity_hd\<^sub>h f \<equiv> hmset_of_enat (arity_hd f)"
 
 abbreviation arity\<^sub>h :: "('s, 'v) tm \<Rightarrow> hmultiset" where
   "arity\<^sub>h s \<equiv> hmset_of_enat (arity s)"
 
 lemma arity\<^sub>h_conv: "arity\<^sub>h s = arity_hd\<^sub>h (head s) - of_nat (num_args s)"
   unfolding arity_def by simp
 
 lemma arity\<^sub>h_App[simp]: "arity\<^sub>h (App s t) = arity\<^sub>h s - 1"
   by (simp add: one_enat_def)
 
 lemmas wary_App\<^sub>h[intro] = wary_App[folded of_nat_lt_hmset_of_enat_iff]
 lemmas wary_AppE\<^sub>h = wary_AppE[folded of_nat_lt_hmset_of_enat_iff]
 lemmas wary_num_args_le_arity_head\<^sub>h =
   wary_num_args_le_arity_head[folded of_nat_le_hmset_of_enat_iff]
 lemmas wary_apps\<^sub>h = wary_apps[folded of_nat_le_hmset_of_enat_iff]
 lemmas wary_cases_apps\<^sub>h[consumes 1, case_names apps] =
   wary_cases_apps[folded of_nat_le_hmset_of_enat_iff]
 
 lemmas ground_heads_arity\<^sub>h = ground_heads_arity[folded hmset_of_enat_le]
 lemmas some_ground_head_arity\<^sub>h = some_ground_head_arity[folded hmset_of_enat_le]
 lemmas \<epsilon>\<^sub>h_gt_0 = \<epsilon>_gt_0[folded of_nat_less_hmset, unfolded of_nat_0]
 lemmas \<delta>\<^sub>h_le_\<epsilon>\<^sub>h = \<delta>_le_\<epsilon>[folded of_nat_le_hmset]
 lemmas arity_hd\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 = arity_hd_ne_infinity_if_\<delta>_gt_0
   [folded of_nat_less_hmset, unfolded of_nat_0, folded hmset_of_enat_lt_iff_ne_infinity]
 
 lemma wt_sym_ge\<^sub>h: "wt_sym f \<ge> \<epsilon>\<^sub>h - \<delta>\<^sub>h * arity_sym\<^sub>h f"
 proof -
   have "of_nat (the_enat (of_nat \<delta> * arity_sym f)) = \<delta>\<^sub>h * arity_sym\<^sub>h f"
   by (cases "arity_sym f", simp add: of_nat_eq_enat,
     metis arity_sym_ne_infinity_if_\<delta>_gt_0 gr_zeroI mult_eq_0_iff of_nat_0 the_enat_0)
   thus ?thesis
     using wt_sym_ge[unfolded of_nat_minus_hmset] by metis
 qed
 
 lemmas unary_wt_sym_0_gt\<^sub>h = unary_wt_sym_0_gt[folded hmset_of_enat_inject, unfolded hmset_of_enat_1]
 lemmas unary_wt_sym_0_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h = unary_wt_sym_0_imp_\<delta>_eq_\<epsilon>
   [folded of_nat_inject_hmset, unfolded of_nat_0]
 lemmas extf_ext_snoc_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h = extf_ext_snoc_if_\<delta>_eq_\<epsilon>[folded of_nat_inject_hmset]
 lemmas extf_snoc_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h = ext_snoc.snoc[OF extf_ext_snoc_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h]
 lemmas arity_sym\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 = arity_sym_ne_infinity_if_\<delta>_gt_0
   [folded of_nat_less_hmset hmset_of_enat_lt_iff_ne_infinity, unfolded of_nat_0]
 lemmas arity_var\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 = arity_var_ne_infinity_if_\<delta>_gt_0
   [folded of_nat_less_hmset hmset_of_enat_lt_iff_ne_infinity, unfolded of_nat_0]
 lemmas arity\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 = arity_ne_infinity_if_\<delta>_gt_0
   [folded of_nat_less_hmset hmset_of_enat_lt_iff_ne_infinity, unfolded of_nat_0]
 lemmas warywary_subst_subst\<^sub>h_conv = wary_subst_def[folded hmset_of_enat_le]
 lemmas extf_singleton_nil_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h = extf_singleton_nil_if_\<delta>_eq_\<epsilon>[folded of_nat_inject_hmset]
 
 lemma arity_sym\<^sub>h_if_\<delta>\<^sub>h_gt_0_E:
   assumes \<delta>_gt_0: "\<delta>\<^sub>h > 0"
   obtains n where "arity_sym\<^sub>h f = of_nat n"
   using arity_sym\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 assms lt_\<omega>_imp_ex_of_nat by blast
 
 lemma arity_var\<^sub>h_if_\<delta>\<^sub>h_gt_0_E:
   assumes \<delta>_gt_0: "\<delta>\<^sub>h > 0"
   obtains n where "arity_var\<^sub>h f = of_nat n"
   using arity_var\<^sub>h_lt_\<omega>_if_\<delta>\<^sub>h_gt_0 assms lt_\<omega>_imp_ex_of_nat by blast
 
 
 subsection \<open>Weights and Subterm Coefficients\<close>
 
 abbreviation zhmset_of_tpoly :: "('a, hmultiset) tpoly \<Rightarrow> ('a, zhmultiset) tpoly" where
   "zhmset_of_tpoly \<equiv> map_tpoly (\<lambda>x. x) zhmset_of"
 
 abbreviation eval_ztpoly :: "('a \<Rightarrow> zhmultiset) \<Rightarrow> ('a, hmultiset) tpoly \<Rightarrow> zhmultiset" where
   "eval_ztpoly A p \<equiv> eval_tpoly A (zhmset_of_tpoly p)"
 
 lemma eval_tpoly_eq_eval_ztpoly[simp]:
   "zhmset_of (eval_tpoly A p) = eval_ztpoly (\<lambda>v. zhmset_of (A v)) p"
   by (induct p, simp_all add: zhmset_of_sum_list zhmset_of_prod_list o_def,
     simp_all cong: map_cong)
 
 definition min_ground_head :: "('s, 'v) hd \<Rightarrow> 's" where
   "min_ground_head \<zeta> =
    (SOME f. f \<in> ground_heads \<zeta> \<and>
       (\<forall>g \<in> ground_heads \<zeta>. wt_sym g + \<delta>\<^sub>h * arity_sym\<^sub>h g \<ge> wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f))"
 
 datatype 'va pvar =
   PWt 'va
 | PCoef 'va nat
 
 primrec min_passign :: "'v pvar \<Rightarrow> hmultiset" where
   "min_passign (PWt x) = wt_sym (min_ground_head (Var x))"
 | "min_passign (PCoef _ _) = 1"
 
 abbreviation min_zpassign :: "'v pvar \<Rightarrow> zhmultiset" where
   "min_zpassign v \<equiv> zhmset_of (min_passign v)"
 
 lemma min_zpassign_simps[simp]:
   "min_zpassign (PWt x) = zhmset_of (wt_sym (min_ground_head (Var x)))"
   "min_zpassign (PCoef x i) = 1"
   by (simp_all add: zhmset_of_1)
 
 definition legal_passign :: "('v pvar \<Rightarrow> hmultiset) \<Rightarrow> bool" where
   "legal_passign A \<longleftrightarrow> (\<forall>x. A x \<ge> min_passign x)"
 
 definition legal_zpassign :: "('v pvar \<Rightarrow> zhmultiset) \<Rightarrow> bool" where
   "legal_zpassign A \<longleftrightarrow> (\<forall>x. A x \<ge> min_zpassign x)"
 
 lemma legal_min_passign: "legal_passign min_passign"
   unfolding legal_passign_def by simp
 
 lemma legal_min_zpassign: "legal_zpassign min_zpassign"
   unfolding legal_zpassign_def by simp
 
 lemma assign_ge_0[intro]: "legal_zpassign A \<Longrightarrow> A x \<ge> 0"
   unfolding legal_zpassign_def by (auto intro: dual_order.trans)
 
 definition
   eq_tpoly :: "('v pvar, hmultiset) tpoly \<Rightarrow> ('v pvar, hmultiset) tpoly \<Rightarrow> bool" (infix "=\<^sub>p" 50)
 where
   "q =\<^sub>p p \<longleftrightarrow> (\<forall>A. legal_zpassign A \<longrightarrow> eval_ztpoly A q = eval_ztpoly A p)"
 
 definition
   ge_tpoly :: "('v pvar, hmultiset) tpoly \<Rightarrow> ('v pvar, hmultiset) tpoly \<Rightarrow> bool" (infix "\<ge>\<^sub>p" 50)
 where
   "q \<ge>\<^sub>p p \<longleftrightarrow> (\<forall>A. legal_zpassign A \<longrightarrow> eval_ztpoly A q \<ge> eval_ztpoly A p)"
 
 definition
   gt_tpoly :: "('v pvar, hmultiset) tpoly \<Rightarrow> ('v pvar, hmultiset) tpoly \<Rightarrow> bool" (infix ">\<^sub>p" 50)
 where
   "q >\<^sub>p p \<longleftrightarrow> (\<forall>A. legal_zpassign A \<longrightarrow> eval_ztpoly A q > eval_ztpoly A p)"
 
 lemma gt_tpoly_imp_ge[intro]: "q >\<^sub>p p \<Longrightarrow> q \<ge>\<^sub>p p"
   unfolding ge_tpoly_def gt_tpoly_def by (simp add: le_less)
 
 lemma eq_tpoly_refl[simp]: "p =\<^sub>p p"
   unfolding eq_tpoly_def by simp
 
 lemma ge_tpoly_refl[simp]: "p \<ge>\<^sub>p p"
   unfolding ge_tpoly_def by simp
 
 lemma gt_tpoly_irrefl: "\<not> p >\<^sub>p p"
   unfolding gt_tpoly_def legal_zpassign_def by fast
 
 lemma
   eq_eq_tpoly_trans: "r =\<^sub>p q \<Longrightarrow> q =\<^sub>p p \<Longrightarrow> r =\<^sub>p p" and
   eq_ge_tpoly_trans: "r =\<^sub>p q \<Longrightarrow> q \<ge>\<^sub>p p \<Longrightarrow> r \<ge>\<^sub>p p" and
   eq_gt_tpoly_trans: "r =\<^sub>p q \<Longrightarrow> q >\<^sub>p p \<Longrightarrow> r >\<^sub>p p" and
   ge_eq_tpoly_trans: "r \<ge>\<^sub>p q \<Longrightarrow> q =\<^sub>p p \<Longrightarrow> r \<ge>\<^sub>p p" and
   ge_ge_tpoly_trans: "r \<ge>\<^sub>p q \<Longrightarrow> q \<ge>\<^sub>p p \<Longrightarrow> r \<ge>\<^sub>p p" and
   ge_gt_tpoly_trans: "r \<ge>\<^sub>p q \<Longrightarrow> q >\<^sub>p p \<Longrightarrow> r >\<^sub>p p" and
   gt_eq_tpoly_trans: "r >\<^sub>p q \<Longrightarrow> q =\<^sub>p p \<Longrightarrow> r >\<^sub>p p" and
   gt_ge_tpoly_trans: "r >\<^sub>p q \<Longrightarrow> q \<ge>\<^sub>p p \<Longrightarrow> r >\<^sub>p p" and
   gt_gt_tpoly_trans: "r >\<^sub>p q \<Longrightarrow> q >\<^sub>p p \<Longrightarrow> r >\<^sub>p p"
   unfolding eq_tpoly_def ge_tpoly_def gt_tpoly_def
   by (auto intro: order.trans less_trans less_le_trans le_less_trans)+
 
 primrec coef_hd :: "('s, 'v) hd \<Rightarrow> nat \<Rightarrow> ('v pvar, hmultiset) tpoly" where
   "coef_hd (Var x) i = PVar (PCoef x i)"
 | "coef_hd (Sym f) i = PNum (coef_sym f i)"
 
 lemma coef_hd_gt_0:
   assumes legal: "legal_zpassign A"
   shows "eval_ztpoly A (coef_hd \<zeta> i) > 0"
   unfolding legal_zpassign_def
 proof (cases \<zeta>)
   case (Var x1)
   thus ?thesis
     using legal[unfolded legal_zpassign_def, rule_format, of "PCoef x i" for x]
     by (auto simp: coef_sym_gt_0 zhmset_of_1 intro: dual_order.strict_trans1 zero_less_one)
 next
   case (Sym x2)
   thus ?thesis
     using legal[unfolded legal_zpassign_def, rule_format, of "PWt x" for x]
     by simp (metis coef_sym_gt_0 zhmset_of_0 zhmset_of_less)
 qed
 
 primrec coef :: "('s, 'v) tm \<Rightarrow> nat \<Rightarrow> ('v pvar, hmultiset) tpoly" where
   "coef (Hd \<zeta>) i = coef_hd \<zeta> i"
 | "coef (App s _) i = coef s (i + 1)"
 
 lemma coef_apps[simp]: "coef (apps s ss) i = coef s (i + length ss)"
   by (induct ss arbitrary: s i) auto
 
 lemma coef_gt_0: "legal_zpassign A \<Longrightarrow> eval_ztpoly A (coef s i) > 0"
    by (induct s arbitrary: i) (auto intro: coef_hd_gt_0)
 
 lemma exists_min_ground_head:
   "\<exists>f. f \<in> ground_heads \<zeta> \<and>
      (\<forall>g \<in> ground_heads \<zeta>. wt_sym g + \<delta>\<^sub>h * arity_sym\<^sub>h g \<ge> wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f)"
 proof -
   let ?R = "{(f, g). f \<in> ground_heads \<zeta> \<and> g \<in> ground_heads \<zeta> \<and>
     wt_sym g + \<delta>\<^sub>h * arity_sym\<^sub>h g > wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f}"
 
   have wf_R: "wf ?R"
     using wf_app[of "{(M, N). M < N}" "\<lambda>f. wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f", OF wf]
     by (auto intro: wf_subset)
   have "\<exists>f. f \<in> ground_heads \<zeta>"
     by (meson ground_heads_nonempty subsetI subset_empty)
   thus ?thesis
     using wf_eq_minimal[THEN iffD1, OF wf_R] by force
 qed
 
 lemma min_ground_head_Sym[simp]: "min_ground_head (Sym f) = f"
   unfolding min_ground_head_def by auto
 
 lemma min_ground_head_in_ground_heads: "min_ground_head \<zeta> \<in> ground_heads \<zeta>"
   unfolding min_ground_head_def using someI_ex[OF exists_min_ground_head] by blast
 
 lemma min_ground_head_min:
   "f \<in> ground_heads \<zeta> \<Longrightarrow>
    wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f \<ge> wt_sym (min_ground_head \<zeta>) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>)"
   unfolding min_ground_head_def using someI_ex[OF exists_min_ground_head] by blast
 
 lemma min_ground_head_antimono:
   "ground_heads \<zeta> \<subseteq> ground_heads \<xi> \<Longrightarrow>
    wt_sym (min_ground_head \<zeta>) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>)
    \<ge> wt_sym (min_ground_head \<xi>) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<xi>)"
   using min_ground_head_in_ground_heads min_ground_head_min by blast
 
 primrec wt0 :: "('s, 'v) hd \<Rightarrow> ('v pvar, hmultiset) tpoly" where
   "wt0 (Var x) = PVar (PWt x)"
 | "wt0 (Sym f) = PNum (wt_sym f)"
 
 lemma wt0_ge_min_ground_head:
   "legal_zpassign A \<Longrightarrow> eval_ztpoly A (wt0 \<zeta>) \<ge> zhmset_of (wt_sym (min_ground_head \<zeta>))"
   by (cases \<zeta>, simp_all, metis legal_zpassign_def min_zpassign_simps(1))
 
 lemma eval_ztpoly_nonneg: "legal_zpassign A \<Longrightarrow> eval_ztpoly A p \<ge> 0"
   by (induct p) (auto cong: map_cong intro!: sum_list_nonneg prod_list_nonneg)
 
 lemma in_zip_imp_size_lt_apps: "(s, y) \<in> set (zip ss ys) \<Longrightarrow> size s < size (apps (Hd \<zeta>) ss)"
   by (auto dest!: set_zip_leftD simp: size_in_args)
 
 function wt :: "('s, 'v) tm \<Rightarrow> ('v pvar, hmultiset) tpoly" where
   "wt (apps (Hd \<zeta>) ss) =
    PSum ([wt0 \<zeta>, PNum (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss)))] @
      map (\<lambda>(s, i). PMult [coef_hd \<zeta> i, wt s]) (zip ss [0..<length ss]))"
   by (erule tm_exhaust_apps) simp
 termination
   by (lexicographic_order simp: in_zip_imp_size_lt_apps)
 
 definition
   wt_args :: "nat \<Rightarrow> ('v pvar \<Rightarrow> zhmultiset) \<Rightarrow> ('s, 'v) hd \<Rightarrow> ('s, 'v) tm list \<Rightarrow> zhmultiset"
 where
   "wt_args i A \<zeta> ss = sum_list
      (map (eval_ztpoly A \<circ> (\<lambda>(s, i). PMult [coef_hd \<zeta> i, wt s])) (zip ss [i..<i + length ss]))"
 
 lemma wt_Hd[simp]: "wt (Hd \<zeta>) = PSum [wt0 \<zeta>, PNum (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))]"
   by (rule wt.simps[of _ "[]", simplified])
 
 lemma coef_hd_cong:
   "(\<forall>x \<in> vars_hd \<zeta>. \<forall>i. A (PCoef x i) = B (PCoef x i)) \<Longrightarrow>
    eval_ztpoly A (coef_hd \<zeta> i) = eval_ztpoly B (coef_hd \<zeta> i)"
   by (cases \<zeta>) auto
 
 lemma wt0_cong:
   assumes pwt_eq: "\<forall>x \<in> vars_hd \<zeta>. A (PWt x) = B (PWt x)"
   shows "eval_ztpoly A (wt0 \<zeta>) = eval_ztpoly B (wt0 \<zeta>)"
   using pwt_eq by (cases \<zeta>) auto
 
 lemma wt_cong:
   assumes
     "\<forall>x \<in> vars s. A (PWt x) = B (PWt x)" and
     "\<forall>x \<in> vars s. \<forall>i. A (PCoef x i) = B (PCoef x i)"
   shows "eval_ztpoly A (wt s) = eval_ztpoly B (wt s)"
   using assms
 proof (induct s rule: tm_induct_apps)
   case (apps \<zeta> ss)
   note ih = this(1) and pwt_eq = this(2) and pcoef_eq = this(3)
 
   have ih': "eval_ztpoly A (wt s) = eval_ztpoly B (wt s)" if s_in: "s \<in> set ss" for s
   proof (rule ih[OF s_in])
     show "\<forall>x \<in> vars s. A (PWt x) = B (PWt x)"
       using pwt_eq s_in by force
     show "\<forall>x \<in> vars s. \<forall>i. A (PCoef x i) = B (PCoef x i)"
       using pcoef_eq s_in by force
   qed
 
   have wt0_eq: "eval_ztpoly A (wt0 \<zeta>) = eval_ztpoly B (wt0 \<zeta>)"
     by (rule wt0_cong) (simp add: pwt_eq)
   have coef_\<zeta>_eq: "eval_ztpoly A (coef_hd \<zeta> i) = eval_ztpoly B (coef_hd \<zeta> i)" for i
     by (rule coef_hd_cong) (simp add: pcoef_eq)
 
   show ?case
     using ih' wt0_eq coef_\<zeta>_eq by (auto dest!: set_zip_leftD intro!: arg_cong[of _ _ sum_list])
 qed
 
 lemma ground_eval_ztpoly_wt_eq: "ground s \<Longrightarrow> eval_ztpoly A (wt s) = eval_ztpoly B (wt s)"
   by (rule wt_cong) auto
 
 lemma exists_wt_sym:
   assumes legal: "legal_zpassign A"
   shows "\<exists>f \<in> ground_heads \<zeta>. eval_ztpoly A (wt (Hd \<zeta>)) \<ge> zhmset_of (wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f)"
   unfolding eq_tpoly_def
 proof (cases \<zeta>)
   case Var
   thus ?thesis
     using legal[unfolded legal_zpassign_def]
     by simp (metis add_le_cancel_right ground_heads.simps(1) min_ground_head_in_ground_heads
       min_zpassign_simps(1) zhmset_of_plus)
 next
   case Sym
   thus ?thesis
     by (simp add: zhmset_of_plus)
 qed
 
 lemma wt_ge_\<epsilon>\<^sub>h:
   assumes legal: "legal_zpassign A"
   shows "eval_ztpoly A (wt s) \<ge> zhmset_of \<epsilon>\<^sub>h"
 proof (induct s rule: tm_induct_apps)
   case (apps \<zeta> ss)
   note ih = this(1)
 
   {
     assume ss_eq_nil: "ss = []"
 
     have "\<epsilon>\<^sub>h \<le> wt_sym (min_ground_head \<zeta>) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>)"
       using wt_sym_ge\<^sub>h[of "min_ground_head \<zeta>"]
       by (metis add_diff_cancel_left' leD leI le_imp_minus_plus_hmset le_minus_plus_same_hmset
         less_le_trans)
     hence "zhmset_of \<epsilon>\<^sub>h
       \<le> zhmset_of (wt_sym (min_ground_head \<zeta>)) + zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))"
       by (metis zhmset_of_le zhmset_of_plus)
     also have "\<dots>
       \<le> eval_tpoly A (map_tpoly (\<lambda>x. x) zhmset_of (wt0 \<zeta>))
         + zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))"
       using wt0_ge_min_ground_head[OF legal] by simp
     finally have ?case
       using ss_eq_nil by simp
   }
   moreover
   {
     let ?arg_wt =
       "eval_tpoly A \<circ> (map_tpoly (\<lambda>x. x) zhmset_of \<circ> (\<lambda>(s, i). PMult [coef_hd \<zeta> i, wt s]))"
 
     assume ss_ne_nil: "ss \<noteq> []"
     hence "zhmset_of \<epsilon>\<^sub>h
       \<le> eval_tpoly A (map_tpoly (\<lambda>x. x) zhmset_of (PMult [coef_hd \<zeta> 0, wt (hd ss)]))"
       by (simp add: ih coef_hd_gt_0[OF legal] nonneg_le_mult_right_mono_zhmset)
     also have "\<dots> = hd (map ?arg_wt (zip ss [0..<length ss]))"
       using ss_ne_nil by (simp add: hd_map zip_nth_conv hd_conv_nth)
     also have "\<dots> \<le> sum_list (map ?arg_wt (zip ss [0..<length ss]))"
       by (rule hd_le_sum_list,
         metis (no_types, lifting) length_greater_0_conv list.collapse list.simps(3) list.simps(9)
           ss_ne_nil upt_conv_Cons zip_Cons_Cons,
         simp add: eval_ztpoly_nonneg legal)
     also have "\<dots>
       \<le> eval_tpoly A (map_tpoly (\<lambda>x. x) zhmset_of (wt0 \<zeta>)) +
         (zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss))) +
          sum_list (map ?arg_wt (zip ss [0..<length ss])))"
     proof -
       have "0 \<le> eval_tpoly A (map_tpoly (\<lambda>p. p) zhmset_of (wt0 \<zeta>))"
         using legal eval_ztpoly_nonneg by blast
       then show ?thesis
         by (meson leD leI le_add_same_cancel2 less_le_trans zhmset_of_nonneg)
     qed
     finally have ?case
       by simp
   }
   ultimately show ?case
     by linarith
 qed
 
 lemma wt_args_ge_length_times_\<epsilon>\<^sub>h:
   assumes legal: "legal_zpassign A"
   shows "wt_args i A \<zeta> ss \<ge> of_nat (length ss) * zhmset_of \<epsilon>\<^sub>h"
   unfolding wt_args_def
   by (rule sum_list_ge_length_times[unfolded wt_args_def,
       of "map (eval_ztpoly A \<circ> (\<lambda>(s, i). PMult [coef_hd \<zeta> i, wt s])) (zip ss [i..<i + length ss])",
       simplified],
     auto intro!: mult_le_mono_hmset[of 1, simplified] nonneg_le_mult_right_mono_zhmset coef_hd_gt_0
       simp: legal zero_less_iff_1_le_hmset[symmetric] coef_hd_gt_0 wt_ge_\<epsilon>\<^sub>h)
 
 lemma wt_ge_\<delta>\<^sub>h: "legal_zpassign A \<Longrightarrow> eval_ztpoly A (wt s) \<ge> zhmset_of \<delta>\<^sub>h"
   using \<delta>\<^sub>h_le_\<epsilon>\<^sub>h[folded zhmset_of_le] order.trans wt_ge_\<epsilon>\<^sub>h zhmset_of_le by blast
 
 lemma wt_gt_0: "legal_zpassign A \<Longrightarrow> eval_ztpoly A (wt s) > 0"
   using \<epsilon>\<^sub>h_gt_0[folded zhmset_of_less, unfolded zhmset_of_0] wt_ge_\<epsilon>\<^sub>h by (blast intro: less_le_trans)
 
 lemma wt_gt_\<delta>\<^sub>h_if_superunary:
   assumes
     legal: "legal_zpassign A" and
     superunary: "arity_hd\<^sub>h (head s) > 1"
   shows "eval_ztpoly A (wt s) > zhmset_of \<delta>\<^sub>h"
 proof (cases "\<delta>\<^sub>h = \<epsilon>\<^sub>h")
   case \<delta>_ne_\<epsilon>: False
   show ?thesis
     using order.not_eq_order_implies_strict[OF \<delta>_ne_\<epsilon> \<delta>\<^sub>h_le_\<epsilon>\<^sub>h, folded zhmset_of_less]
       wt_ge_\<epsilon>\<^sub>h[OF legal] by (blast intro: less_le_trans)
 next
   case \<delta>_eq_\<epsilon>: True
   show ?thesis
     using superunary
   proof (induct s rule: tm_induct_apps)
     case (apps \<zeta> ss)
     have "arity_hd\<^sub>h \<zeta> > 1"
       using apps(2) by simp
     hence min_gr_ary: "arity_sym\<^sub>h (min_ground_head \<zeta>) > 1"
       using ground_heads_arity\<^sub>h less_le_trans min_ground_head_in_ground_heads by blast
 
     have "zhmset_of \<delta>\<^sub>h < eval_ztpoly A (wt0 \<zeta>) + zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))"
       unfolding \<delta>_eq_\<epsilon>
       by (rule add_strict_increasing2[OF eval_ztpoly_nonneg[OF legal]], unfold zhmset_of_less,
         rule gt_0_lt_mult_gt_1_hmset[OF \<epsilon>\<^sub>h_gt_0 min_gr_ary])
     also have "\<dots> \<le> eval_ztpoly A (wt0 \<zeta>)
       + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss)))
         + zhmset_of (of_nat (length ss) * \<epsilon>\<^sub>h)"
       by (auto simp: \<epsilon>\<^sub>h_gt_0 \<delta>_eq_\<epsilon> zmset_of_le zhmset_of_plus[symmetric] algebra_simps
             simp del: ring_distribs simp: ring_distribs[symmetric])
         (metis add.commute le_minus_plus_same_hmset)
     also have "\<dots> \<le> eval_ztpoly A (wt0 \<zeta>)
       + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss))) + wt_args 0 A \<zeta> ss"
       using wt_args_ge_length_times_\<epsilon>\<^sub>h[OF legal] by (simp add: zhmset_of_times of_nat_zhmset)
     finally show ?case
       by (simp add: wt_args_def add_ac(1) comp_def)
   qed
 qed
 
 lemma wt_App_plus_\<delta>\<^sub>h_ge:
   "eval_ztpoly A (wt (App s t)) + zhmset_of \<delta>\<^sub>h
    \<ge> eval_ztpoly A (wt s) + eval_ztpoly A (coef s 0) * eval_ztpoly A (wt t)"
 proof (cases s rule: tm_exhaust_apps)
   case s: (apps \<zeta> ss)
   show ?thesis
   proof (cases "arity_sym\<^sub>h (min_ground_head \<zeta>) = \<omega>")
     case ary_eq_\<omega>: True
     show ?thesis
       unfolding ary_eq_\<omega> s App_apps wt.simps
       by (auto simp: diff_diff_add_hmset[symmetric] add.assoc)
   next
     case False
     show ?thesis
       unfolding s App_apps wt.simps
       by (simp add: algebra_simps zhmset_of_plus[symmetric] zmset_of_le,
         simp del: diff_diff_add_hmset add: add.commute[of 1] le_minus_plus_same_hmset
           distrib_left[of _ "1 :: hmultiset", unfolded mult.right_neutral, symmetric]
           diff_diff_add_hmset[symmetric])
   qed
 qed
 
 lemma wt_App_fun_\<delta>\<^sub>h:
   assumes
     legal: "legal_zpassign A" and
     wt_st: "eval_ztpoly A (wt (App s t)) = eval_ztpoly A (wt t)"
   shows "eval_ztpoly A (wt s) = zhmset_of \<delta>\<^sub>h"
 proof -
   have "eval_ztpoly A (wt (App s t)) = eval_ztpoly A (wt t)"
     using wt_st by simp
   hence wt_s_t_le_\<delta>_t: "eval_ztpoly A (wt s) + eval_ztpoly A (coef s 0) * eval_ztpoly A (wt t)
      \<le> zhmset_of \<delta>\<^sub>h + eval_ztpoly A (wt t)"
     using wt_App_plus_\<delta>\<^sub>h_ge by (metis add.commute)
   also have "\<dots> \<le> eval_ztpoly A (wt s) + eval_ztpoly A (wt t)"
     using wt_ge_\<delta>\<^sub>h[OF legal] by simp
   finally have "eval_ztpoly A (coef s 0) * eval_ztpoly A (wt t) \<le> eval_ztpoly A (wt t)"
     by simp
   hence "eval_ztpoly A (coef s 0) = 1"
     using eval_ztpoly_nonneg[OF legal]
     by (metis (no_types, lifting) coef_gt_0 dual_order.order_iff_strict leD legal mult_cancel_right1
       nonneg_le_mult_right_mono_zhmset wt_gt_0)
   thus ?thesis
     using wt_s_t_le_\<delta>_t by (simp add: add.commute antisym wt_ge_\<delta>\<^sub>h[OF legal])
 qed
 
 lemma wt_App_arg_\<delta>\<^sub>h:
   assumes
     legal: "legal_zpassign A" and
     wt_st: "eval_ztpoly A (wt (App s t)) = eval_ztpoly A (wt s)"
   shows "eval_ztpoly A (wt t) = zhmset_of \<delta>\<^sub>h"
 proof -
   have "eval_ztpoly A (wt (App s t)) + zhmset_of \<delta>\<^sub>h = eval_ztpoly A (wt s) + zhmset_of \<delta>\<^sub>h"
     using wt_st by simp
   hence "eval_ztpoly A (coef s 0) * eval_ztpoly A (wt t) \<le> zhmset_of \<delta>\<^sub>h" (is "?k * ?w \<le> _")
     by (metis add_le_cancel_left wt_App_plus_\<delta>\<^sub>h_ge)
   hence "?k * ?w = zhmset_of \<delta>\<^sub>h"
     using wt_ge_\<delta>\<^sub>h[OF legal] coef_gt_0[OF legal, unfolded zero_less_iff_1_le_hmset]
     by (simp add: antisym nonneg_le_mult_right_mono_zhmset)
   hence "?w \<le> zhmset_of \<delta>\<^sub>h"
     by (metis coef_gt_0[OF legal] dual_order.order_iff_strict eval_ztpoly_nonneg[OF legal]
       nonneg_le_mult_right_mono_zhmset)
   thus ?thesis
     by (simp add: antisym wt_ge_\<delta>\<^sub>h[OF legal])
 qed
 
 lemma wt_App_ge_fun: "wt (App s t) \<ge>\<^sub>p wt s"
   unfolding ge_tpoly_def
 proof clarify
   fix A
   assume legal: "legal_zpassign A"
 
   have "zhmset_of \<delta>\<^sub>h \<le> eval_ztpoly A (coef s 0) * eval_ztpoly A (wt t)"
     by (simp add: coef_gt_0 legal nonneg_le_mult_right_mono_zhmset wt_ge_\<delta>\<^sub>h)
   hence "eval_ztpoly A (wt s) + zhmset_of \<delta>\<^sub>h \<le> eval_ztpoly A (wt (App s t)) + zhmset_of \<delta>\<^sub>h"
     by (metis add_le_cancel_right add_less_le_mono not_le wt_App_plus_\<delta>\<^sub>h_ge)
   thus "eval_ztpoly A (wt s) \<le> eval_ztpoly A (wt (App s t))"
     by simp
 qed
 
 lemma wt_App_ge_arg: "wt (App s t) \<ge>\<^sub>p wt t"
   unfolding ge_tpoly_def
   by (cases s rule: tm_exhaust_apps, simp, unfold App_apps wt.simps)
     (auto simp: comp_def coef_hd_gt_0 eval_ztpoly_nonneg nonneg_le_mult_right_mono_zhmset
        intro!: sum_list_nonneg eval_ztpoly_nonneg add_increasing)
 
 lemma wt_\<delta>\<^sub>h_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h:
   assumes
     legal: "legal_zpassign A" and
     wt_s_eq_\<delta>: "eval_ztpoly A (wt s) = zhmset_of \<delta>\<^sub>h"
   shows "\<delta>\<^sub>h = \<epsilon>\<^sub>h"
   using \<delta>\<^sub>h_le_\<epsilon>\<^sub>h wt_ge_\<epsilon>\<^sub>h[OF legal, of s, unfolded wt_s_eq_\<delta> zhmset_of_le] by (rule antisym)
 
 lemma wt_ge_vars: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> vars t \<supseteq> vars s"
 proof (induct s)
   case t: (Hd \<zeta>)
   note wt_ge_\<zeta> = this(1)
   show ?case
   proof (cases \<zeta>)
     case \<zeta>: (Var x)
 
     {
       assume z_ni_t: "x \<notin> vars t"
 
       let ?A = min_zpassign
       let ?B = "\<lambda>v. if v = PWt x then eval_ztpoly ?A (wt t) + ?A v + 1 else ?A v"
 
       have legal_B: "legal_zpassign ?B"
         unfolding legal_zpassign_def
         by (auto simp: legal_min_zpassign intro!: add_increasing eval_ztpoly_nonneg)
 
       have eval_B_eq_A: "eval_ztpoly ?B (wt t) = eval_ztpoly ?A (wt t)"
         by (rule wt_cong) (auto simp: z_ni_t)
       have "eval_ztpoly ?B (wt (Hd (Var x))) > eval_ztpoly ?B (wt t)"
         by (auto simp: eval_B_eq_A zero_less_iff_1_le_zhmset zhmset_of_plus[symmetric]
           algebra_simps)
       hence False
         using wt_ge_\<zeta> \<zeta> unfolding ge_tpoly_def
         by (blast dest: leD intro: legal_B legal_min_zpassign)
     }
     thus ?thesis
       by (auto simp: \<zeta>)
   qed simp
 next
   case (App s1 s2)
   note ih1 = this(1) and ih2 = this(2) and wt_t_ge_wt_s1s2 = this(3)
 
   have "vars s1 \<subseteq> vars t"
     using ih1 wt_t_ge_wt_s1s2 wt_App_ge_fun order_trans unfolding ge_tpoly_def by blast
   moreover have "vars s2 \<subseteq> vars t"
     using ih2 wt_t_ge_wt_s1s2 wt_App_ge_arg order_trans unfolding ge_tpoly_def by blast
   ultimately show ?case
     by simp
 qed
 
 lemma sum_coefs_ge_num_args_if_\<delta>\<^sub>h_eq_0:
   assumes
     legal: "legal_passign A" and
     \<delta>_eq_0: "\<delta>\<^sub>h = 0" and
     wary_s: "wary s"
   shows "sum_coefs (eval_tpoly A (wt s)) \<ge> num_args s"
 proof (cases s rule: tm_exhaust_apps)
   case s: (apps \<zeta> ss)
   show ?thesis
     unfolding s
   proof (induct ss rule: rev_induct)
     case (snoc sa ss)
     note ih = this
 
     let ?Az = "\<lambda>v. zhmset_of (A v)"
 
     have legalz: "legal_zpassign ?Az"
       using legal unfolding legal_passign_def legal_zpassign_def zhmset_of_le by assumption
 
     have "eval_ztpoly ?Az (coef_hd \<zeta> (length ss)) > 0"
       using legal coef_hd_gt_0 eval_tpoly_eq_eval_ztpoly
       by (simp add: coef_hd_gt_0[OF legalz])
     hence k: "eval_tpoly A (coef_hd \<zeta> (length ss)) > 0" (is "?k > _")
       unfolding eval_tpoly_eq_eval_ztpoly[symmetric] zhmset_of_less[symmetric] zhmset_of_0
       by assumption
 
     have "eval_ztpoly ?Az (wt sa) > 0" (is "?w > _")
       by (simp add: wt_gt_0[OF legalz])
     hence w: "eval_tpoly A (wt sa) > 0" (is "?w > _")
       unfolding eval_tpoly_eq_eval_ztpoly[symmetric] zhmset_of_less[symmetric] zhmset_of_0
       by assumption
 
     have "?k * ?w > 0"
       using k w by simp
     hence "sum_coefs (?k * ?w) > 0"
       by (rule sum_coefs_gt_0[THEN iffD2])
     thus ?case
       using ih by (simp del: apps_append add: s \<delta>_eq_0)
   qed simp
 qed
 
 
 subsection \<open>Inductive Definitions\<close>
 
 inductive gt :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix ">\<^sub>t" 50) where
   gt_wt: "wt t >\<^sub>p wt s \<Longrightarrow> t >\<^sub>t s"
 | gt_unary: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> \<not> head t \<le>\<ge>\<^sub>h\<^sub>d head s \<Longrightarrow> num_args t = 1 \<Longrightarrow>
     (\<exists>f \<in> ground_heads (head t). arity_sym f = 1 \<and> wt_sym f = 0) \<Longrightarrow> arg t >\<^sub>t s \<or> arg t = s \<Longrightarrow>
     t >\<^sub>t s"
 | gt_diff: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> head t >\<^sub>h\<^sub>d head s \<Longrightarrow> t >\<^sub>t s"
 | gt_same: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> head t = head s \<Longrightarrow>
     (\<forall>f \<in> ground_heads (head t). extf f (>\<^sub>t) (args t) (args s)) \<Longrightarrow> t >\<^sub>t s"
 
 abbreviation ge :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix "\<ge>\<^sub>t" 50) where
   "t \<ge>\<^sub>t s \<equiv> t >\<^sub>t s \<or> t = s"
 
 inductive gt_wt :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
   gt_wtI: "wt t >\<^sub>p wt s \<Longrightarrow> gt_wt t s"
 
 inductive gt_unary :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
   gt_unaryI: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> \<not> head t \<le>\<ge>\<^sub>h\<^sub>d head s \<Longrightarrow> num_args t = 1 \<Longrightarrow>
     (\<exists>f \<in> ground_heads (head t). arity_sym f = 1 \<and> wt_sym f = 0) \<Longrightarrow> arg t \<ge>\<^sub>t s \<Longrightarrow> gt_unary t s"
 
 inductive gt_diff :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
   gt_diffI: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> head t >\<^sub>h\<^sub>d head s \<Longrightarrow> gt_diff t s"
 
 inductive gt_same :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
   gt_sameI: "wt t \<ge>\<^sub>p wt s \<Longrightarrow> head t = head s \<Longrightarrow>
     (\<forall>f \<in> ground_heads (head t). extf f (>\<^sub>t) (args t) (args s)) \<Longrightarrow> gt_same t s"
 
 lemma gt_iff_wt_unary_diff_same: "t >\<^sub>t s \<longleftrightarrow> gt_wt t s \<or> gt_unary t s \<or> gt_diff t s \<or> gt_same t s"
   by (subst gt.simps) (auto simp: gt_wt.simps gt_unary.simps gt_diff.simps gt_same.simps)
 
 lemma gt_imp_wt: "t >\<^sub>t s \<Longrightarrow> wt t \<ge>\<^sub>p wt s"
   by (blast elim: gt.cases)
 
 lemma gt_imp_vars: "t >\<^sub>t s \<Longrightarrow> vars t \<supseteq> vars s"
   by (erule wt_ge_vars[OF gt_imp_wt])
 
 
 subsection \<open>Irreflexivity\<close>
 
 theorem gt_irrefl: "wary s \<Longrightarrow> \<not> s >\<^sub>t s"
 proof (induct "size s" arbitrary: s rule: less_induct)
   case less
   note ih = this(1) and wary_s = this(2)
 
   show ?case
   proof
     assume s_gt_s: "s >\<^sub>t s"
     show False
       using s_gt_s
     proof (cases rule: gt.cases)
       case gt_same
       then obtain f where f: "extf f (>\<^sub>t) (args s) (args s)"
         by fastforce
       thus False
         using wary_s ih by (metis wary_args extf_irrefl size_in_args)
     qed (auto simp: comp_hd_def gt_tpoly_irrefl gt_hd_irrefl)
   qed
 qed
 
 
 subsection \<open>Transitivity\<close>
 
 lemma not_extf_gt_nil_singleton_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h:
   assumes wary_s: "wary s" and \<delta>_eq_\<epsilon>: "\<delta>\<^sub>h = \<epsilon>\<^sub>h"
   shows "\<not> extf f (>\<^sub>t) [] [s]"
 proof
   assume nil_gt_s: "extf f (>\<^sub>t) [] [s]"
   note s_gt_nil = extf_singleton_nil_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h[OF \<delta>_eq_\<epsilon>, of f gt s]
   have "\<not> extf f (>\<^sub>t) [] []"
     by (rule extf_irrefl) simp
   moreover have "extf f (>\<^sub>t) [] []"
     using extf_trans_from_irrefl[of "{s}", OF _ _ _ _ _ _ nil_gt_s s_gt_nil] gt_irrefl[OF wary_s]
     by fastforce
   ultimately show False
     by sat
 qed
 
 lemma gt_sub_arg: "wary (App s t) \<Longrightarrow> App s t >\<^sub>t t"
 proof (induct t arbitrary: s rule: measure_induct_rule[of size])
   case (less t)
   note ih = this(1) and wary_st = this(2)
 
   {
     fix A
     assume
       legal: "legal_zpassign A" and
       wt_st: "eval_ztpoly A (wt (App s t)) = eval_ztpoly A (wt t)"
 
     have \<delta>_eq_\<epsilon>: "\<delta>\<^sub>h = \<epsilon>\<^sub>h"
       using wt_App_fun_\<delta>\<^sub>h[OF legal] wt_\<delta>\<^sub>h_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h[OF legal] wt_st by blast
     hence \<delta>_gt_0: "\<delta>\<^sub>h > 0"
       using \<epsilon>\<^sub>h_gt_0 by simp
 
     have wt_s: "eval_ztpoly A (wt s) = zhmset_of \<delta>\<^sub>h"
       by (rule wt_App_fun_\<delta>\<^sub>h[OF legal wt_st])
 
     have wary_t: "wary t"
       by (rule wary_AppE\<^sub>h[OF wary_st])
     have nargs_lt: "of_nat (num_args s) < arity_hd\<^sub>h (head s)"
       by (rule wary_AppE\<^sub>h[OF wary_st])
 
     have ary_hd_s: "arity_hd\<^sub>h (head s) = 1"
       by (metis gr_implies_not_zero_hmset legal lt_1_iff_eq_0_hmset nargs_lt neq_iff
         wt_gt_\<delta>\<^sub>h_if_superunary wt_s)
     hence nargs_s: "num_args s = 0"
       by (metis less_one nargs_lt of_nat_1 of_nat_less_hmset)
     hence s_eq_hd: "s = Hd (head s)"
       by (simp add: Hd_head_id)
     obtain f where
       f_in: "f \<in> ground_heads (head s)" and
       wt_f_etc: "wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f = \<delta>\<^sub>h"
     proof -
       assume a: "\<And>f. \<lbrakk>f \<in> local.ground_heads (head s); wt_sym f + \<delta>\<^sub>h * arity_sym\<^sub>h f = \<delta>\<^sub>h\<rbrakk> \<Longrightarrow> thesis"
       have "\<And>f. \<delta>\<^sub>h - \<delta>\<^sub>h * arity_sym\<^sub>h f \<le> wt_sym f"
         using wt_s by (metis legal wt_\<delta>\<^sub>h_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h wt_sym_ge\<^sub>h)
       hence "\<And>s. \<not> \<delta>\<^sub>h * arity_sym\<^sub>h s + wt_sym s < \<delta>\<^sub>h"
         by (metis add_diff_cancel_left' le_imp_minus_plus_hmset leD le_minus_plus_same_hmset
             less_le_trans)
       thus thesis
         using a wt_s s_eq_hd
         by (metis exists_wt_sym legal add.commute order.not_eq_order_implies_strict zhmset_of_le)
     qed
 
     have ary_f_1: "arity_sym f = 1"
       by (metis \<delta>_gt_0 add_diff_cancel_left' ary_hd_s diff_le_self_hmset dual_order.order_iff_strict
         f_in ground_heads_arity\<^sub>h gt_0_lt_mult_gt_1_hmset hmset_of_enat_1 hmset_of_enat_inject leD
         wt_f_etc)
     hence wt_f_0: "wt_sym f = 0"
       using wt_f_etc by simp
 
     {
       assume hd_s_ncmp_t: "\<not> head s \<le>\<ge>\<^sub>h\<^sub>d head t"
       have ?case
         by (rule gt_unary[OF wt_App_ge_arg])
           (auto simp: hd_s_ncmp_t nargs_s intro: f_in ary_f_1 wt_f_0)
     }
     moreover
     {
       assume hd_s_gt_t: "head s >\<^sub>h\<^sub>d head t"
       have ?case
         by (rule gt_diff[OF wt_App_ge_arg]) (simp add: hd_s_gt_t)
     }
     moreover
     {
       assume "head t >\<^sub>h\<^sub>d head s"
       hence False
         using ary_f_1 wt_f_0 f_in gt_hd_irrefl gt_sym_antisym unary_wt_sym_0_gt\<^sub>h hmset_of_enat_1
         unfolding gt_hd_def by metis
     }
     moreover
     {
       assume hd_t_eq_s: "head t = head s"
       hence nargs_t_le: "num_args t \<le> 1"
         using ary_hd_s wary_num_args_le_arity_head\<^sub>h[OF wary_t] of_nat_le_hmset by fastforce
 
       have extf: "extf f (>\<^sub>t) [t] (args t)" for f
       proof (cases "args t")
         case Nil
         thus ?thesis
           by (simp add: extf_singleton_nil_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h[OF \<delta>_eq_\<epsilon>])
       next
         case args_t: (Cons ta ts)
         hence ts: "ts = []"
           using ary_hd_s[folded hd_t_eq_s] wary_num_args_le_arity_head\<^sub>h[OF wary_t] of_nat_le_hmset
             nargs_t_le by simp
         have ta: "ta = arg t"
           by (metis apps.simps(1) apps.simps(2) args_t tm.sel(6) tm_collapse_apps ts)
         hence t: "t = App (fun t) ta"
           by (metis args.simps(1) args_t not_Cons_self2 tm.exhaust_sel ts)
         have "t >\<^sub>t ta"
           by (rule ih[of ta "fun t", folded t, OF _ wary_t]) (metis ta size_arg_lt t tm.disc(2))
         thus ?thesis
           unfolding args_t ts by (metis extf_singleton gt_irrefl wary_t)
       qed
       have ?case
         by (rule gt_same[OF wt_App_ge_arg])
           (simp_all add: hd_t_eq_s length_0_conv[THEN iffD1, OF nargs_s] extf)
     }
     ultimately have ?case
       unfolding comp_hd_def by metis
   }
   thus ?case
     using gt_wt by (metis ge_tpoly_def gt_tpoly_def wt_App_ge_arg order.not_eq_order_implies_strict)
 qed
 
 lemma gt_arg: "wary s \<Longrightarrow> is_App s \<Longrightarrow> s >\<^sub>t arg s"
   by (cases s) (auto intro: gt_sub_arg)
 
 theorem gt_trans: "wary u \<Longrightarrow> wary t \<Longrightarrow> wary s \<Longrightarrow> u >\<^sub>t t \<Longrightarrow> t >\<^sub>t s \<Longrightarrow> u >\<^sub>t s"
 proof (simp only: atomize_imp,
     rule measure_induct_rule[of "\<lambda>(u, t, s). {#size u, size t, size s#}"
         "\<lambda>(u, t, s). wary u \<longrightarrow> wary t \<longrightarrow> wary s \<longrightarrow> u >\<^sub>t t \<longrightarrow> t >\<^sub>t s \<longrightarrow> u >\<^sub>t s" "(u, t, s)",
       simplified prod.case],
     simp only: split_paired_all prod.case atomize_imp[symmetric])
   fix u t s
   assume
     ih: "\<And>ua ta sa. {#size ua, size ta, size sa#} < {#size u, size t, size s#} \<Longrightarrow>
       wary ua \<Longrightarrow> wary ta \<Longrightarrow> wary sa \<Longrightarrow> ua >\<^sub>t ta \<Longrightarrow> ta >\<^sub>t sa \<Longrightarrow> ua >\<^sub>t sa" and
     wary_u: "wary u" and wary_t: "wary t" and wary_s: "wary s" and
     u_gt_t: "u >\<^sub>t t" and t_gt_s: "t >\<^sub>t s"
 
   have wt_u_ge_t: "wt u \<ge>\<^sub>p wt t" and wt_t_ge_s: "wt t \<ge>\<^sub>p wt s"
     using gt_imp_wt u_gt_t t_gt_s by auto
   hence wt_u_ge_s: "wt u \<ge>\<^sub>p wt s"
     by (rule ge_ge_tpoly_trans)
 
   have wary_arg_u: "wary (arg u)"
     by (rule wary_arg[OF wary_u])
   have wary_arg_t: "wary (arg t)"
     by (rule wary_arg[OF wary_t])
   have wary_arg_s: "wary (arg s)"
     by (rule wary_arg[OF wary_s])
 
   show "u >\<^sub>t s"
     using t_gt_s
   proof cases
     case gt_wt_t_s: gt_wt
     hence "wt u >\<^sub>p wt s"
       using wt_u_ge_t ge_gt_tpoly_trans by blast
     thus ?thesis
       by (rule gt_wt)
   next
     case gt_unary_t_s: gt_unary
 
     have t_app: "is_App t"
       by (metis args_Nil_iff_is_Hd gt_unary_t_s(3) length_greater_0_conv less_numeral_extra(1))
     hence nargs_fun_t: "num_args (fun t) < arity_hd (head (fun t))"
       by (metis tm.collapse(2) wary_AppE wary_t)
 
     have \<delta>_eq_\<epsilon>: "\<delta>\<^sub>h = \<epsilon>\<^sub>h"
       using gt_unary_t_s(4) unary_wt_sym_0_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h by blast
 
     show ?thesis
       using u_gt_t
     proof cases
       case gt_wt_u_t: gt_wt
       hence "wt u >\<^sub>p wt s"
         using wt_t_ge_s gt_ge_tpoly_trans by blast
       thus ?thesis
         by (rule gt_wt)
     next
       case gt_unary_u_t: gt_unary
       have u_app: "is_App u"
         by (metis args_Nil_iff_is_Hd gt_unary_u_t(3) length_greater_0_conv less_numeral_extra(1))
       hence nargs_fun_u: "num_args (fun u) = 0"
         by (metis args.simps(1) gt_unary_u_t(3) list.size(3) one_arg_imp_Hd tm.collapse(2))
 
       have arg_u_gt_s: "arg u >\<^sub>t s"
         using ih[of "arg u" t s] u_app gt_unary_u_t(5) t_gt_s size_arg_lt wary_arg_u wary_s wary_t
         by force
       hence arg_u_ge_s: "arg u \<ge>\<^sub>t s"
         by sat
 
       {
         assume "size (arg u) < size t"
         hence "{#size u, size (arg u), size s#} < {#size u, size t, size s#}"
           by simp
         hence ?thesis
           using ih[of u "arg u" s] arg_u_gt_s gt_arg u_app wary_s wary_u by blast
       }
       moreover
       {
         assume "size (arg t) < size s"
         hence "u >\<^sub>t arg t"
           using ih[of u t "arg t"] args_Nil_iff_is_Hd gt_arg gt_unary_t_s(3) u_gt_t wary_t wary_u
           by force
         hence ?thesis
           using ih[of u "arg t" s] args_Nil_iff_is_Hd gt_unary_t_s(3,5) size_arg_lt wary_arg_t
             wary_s wary_u by force
       }
       moreover
       {
         assume sz_u_gt_t: "size u > size t" and sz_t_gt_s: "size t > size s"
 
         {
           assume hd_u_eq_s: "head u = head s"
           hence ary_hd_s: "arity_hd (head s) = 1"
             using ground_heads_arity gt_unary_u_t(3,4) hd_u_eq_s one_enat_def
               wary_num_args_le_arity_head wary_u by fastforce
 
           have extf: "extf f (>\<^sub>t) (args u) (args s)" for f
           proof (cases "args s")
             case Nil
             thus ?thesis
               by (metis \<delta>_eq_\<epsilon> args.elims args_Nil_iff_is_Hd extf_snoc_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h length_0_conv
                 nargs_fun_u tm.sel(4) u_app)
           next
             case args_s: (Cons sa ss)
             hence ss: "ss = []"
               by (cases s, simp, metis One_nat_def antisym_conv ary_hd_s diff_Suc_1
                 enat_ord_simps(1) le_add2 length_0_conv length_Cons list.size(4) one_enat_def
                 wary_num_args_le_arity_head wary_s)
             have sa: "sa = arg s"
               by (metis apps.simps(1) apps.simps(2) args_s tm.sel(6) tm_collapse_apps ss)
 
             have s_app: "is_App s"
               using args_Nil_iff_is_Hd args_s by force
             have args_u: "args u = [arg u]"
               by (metis append_Nil args.simps(2) args_Nil_iff_is_Hd gt_unary_u_t(3) length_0_conv
                 nargs_fun_u tm.collapse(2) zero_neq_one)
 
             have max_sz_arg_u_t_arg_t: "Max {size (arg t), size t, size (arg u)} < size u"
               using size_arg_lt sz_u_gt_t t_app u_app by fastforce
 
             have "{#size (arg u), size t, size (arg t)#} < {#size u, size t, size s#}"
               using max_sz_arg_u_t_arg_t by (auto intro!: Max_lt_imp_lt_mset)
             hence arg_u_gt_arg_t: "arg u >\<^sub>t arg t"
               using ih[OF _ wary_arg_u wary_t wary_arg_t] args_Nil_iff_is_Hd gt_arg
                 gt_unary_t_s(3) gt_unary_u_t(5) wary_t by force
 
             have max_sz_arg_s_s_arg_t: "Max {size (arg s), size s, size (arg t)} < size u"
               using s_app t_app size_arg_lt sz_t_gt_s sz_u_gt_t by force
 
             have "{#size (arg t), size s, size (arg s)#} < {#size u, size t, size s#}"
               using max_sz_arg_s_s_arg_t by (auto intro!: Max_lt_imp_lt_mset)
             hence arg_t_gt_arg_s: "arg t >\<^sub>t arg s"
               using ih[OF _ wary_arg_t wary_s wary_arg_s]
                 gt_unary_t_s(5) gt_arg args_Nil_iff_is_Hd args_s wary_s by force
 
             have "{#size (arg u), size (arg t), size (arg s)#} < {#size u, size t, size s#}"
               by (auto intro!: add_mset_lt_lt_lt simp: size_arg_lt u_app t_app s_app)
             hence "arg u >\<^sub>t arg s"
               using ih[of "arg u" "arg t" "arg s"] arg_u_gt_arg_t arg_t_gt_arg_s wary_arg_s
                 wary_arg_t wary_arg_u by blast
             thus ?thesis
               unfolding args_u args_s ss sa by (metis extf_singleton gt_irrefl wary_arg_u)
           qed
 
           have ?thesis
             by (rule gt_same[OF wt_u_ge_s hd_u_eq_s]) (simp add: extf)
         }
         moreover
         {
           assume "head u >\<^sub>h\<^sub>d head s"
           hence ?thesis
             by (rule gt_diff[OF wt_u_ge_s])
         }
         moreover
         {
           assume "head s >\<^sub>h\<^sub>d head u"
           hence False
             using gt_hd_def gt_hd_irrefl gt_sym_antisym gt_unary_u_t(4) unary_wt_sym_0_gt by blast
         }
         moreover
         {
           assume "\<not> head u \<le>\<ge>\<^sub>h\<^sub>d head s"
           hence ?thesis
             by (rule gt_unary[OF wt_u_ge_s _ gt_unary_u_t(3,4) arg_u_ge_s])
         }
         ultimately have ?thesis
           unfolding comp_hd_def by sat
       }
       ultimately show ?thesis
         by (meson less_le_trans linorder_not_le size_arg_lt t_app u_app)
     next
       case gt_diff_u_t: gt_diff
       have False
         using gt_diff_u_t(2) gt_hd_def gt_hd_irrefl gt_sym_antisym gt_unary_t_s(4) unary_wt_sym_0_gt
         by blast
       thus ?thesis
         by sat
     next
       case gt_same_u_t: gt_same
 
       have hd_u_ncomp_s: "\<not> head u \<le>\<ge>\<^sub>h\<^sub>d head s"
         by (rule gt_unary_t_s(2)[folded gt_same_u_t(2)])
 
       have "\<exists>f \<in> ground_heads (head u). arity_sym f = 1 \<and> wt_sym f = 0"
         by (rule gt_unary_t_s(4)[folded gt_same_u_t(2)])
       hence "arity_hd (head u) = 1"
         by (metis dual_order.order_iff_strict gr_implies_not_zero_hmset ground_heads_arity
           gt_same_u_t(2) head_fun hmset_of_enat_1 hmset_of_enat_less lt_1_iff_eq_0_hmset
           nargs_fun_t)
       hence "num_args u \<le> 1"
         using of_nat_le_hmset wary_num_args_le_arity_head\<^sub>h wary_u by fastforce
       hence nargs_u: "num_args u = 1"
         by (cases "args u",
           metis Hd_head_id \<delta>_eq_\<epsilon> append_Nil args.simps(2)
             ex_in_conv[THEN iffD2, OF ground_heads_nonempty] gt_same_u_t(2,3) gt_unary_t_s(3)
             head_fun list.size(3) not_extf_gt_nil_singleton_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h one_arg_imp_Hd
             tm.collapse(2)[OF t_app] wary_arg_t,
           simp)
       hence u_app: "is_App u"
         by (cases u) auto
 
       have "arg u >\<^sub>t arg t"
         by (metis extf_singleton[THEN iffD1] append_Nil args.simps args_Nil_iff_is_Hd comp_hd_def
           gt_hd_def gt_irrefl gt_same_u_t(2,3) gt_unary_t_s(2,3) head_fun length_0_conv nargs_u
           one_arg_imp_Hd t_app tm.collapse(2) u_gt_t wary_u)
       moreover have "{#size (arg u), size (arg t), size s#} < {#size u, size t, size s#}"
         by (auto intro!: add_mset_lt_lt_lt simp: size_arg_lt u_app t_app)
       ultimately have "arg u >\<^sub>t s"
         using ih[OF _ wary_arg_u wary_arg_t wary_s] gt_unary_t_s(5) by blast
       hence arg_u_ge_s: "arg u \<ge>\<^sub>t s"
         by sat
       show ?thesis
         by (rule gt_unary[OF wt_u_ge_s hd_u_ncomp_s nargs_u _ arg_u_ge_s])
           (simp add: gt_same_u_t(2) gt_unary_t_s(4))
     qed
   next
     case gt_diff_t_s: gt_diff
     show ?thesis
       using u_gt_t
     proof cases
       case gt_wt_u_t: gt_wt
       hence "wt u >\<^sub>p wt s"
         using wt_t_ge_s gt_ge_tpoly_trans by blast
       thus ?thesis
         by (rule gt_wt)
     next
       case gt_unary_u_t: gt_unary
       have u_app: "is_App u"
         by (metis args_Nil_iff_is_Hd gt_unary_u_t(3) length_greater_0_conv less_numeral_extra(1))
       hence "arg u >\<^sub>t s"
         using ih[of "arg u" t s] gt_unary_u_t(5) t_gt_s size_arg_lt wary_arg_u wary_s wary_t
         by force
       hence arg_u_ge_s: "arg u \<ge>\<^sub>t s"
         by sat
 
       {
         assume "head u = head s"
         hence False
           using gt_diff_t_s(2) gt_unary_u_t(2) unfolding comp_hd_def by force
       }
       moreover
       {
         assume "head s >\<^sub>h\<^sub>d head u"
         hence False
           using gt_hd_def gt_hd_irrefl gt_sym_antisym gt_unary_u_t(4) unary_wt_sym_0_gt by blast
       }
       moreover
       {
         assume "head u >\<^sub>h\<^sub>d head s"
         hence ?thesis
           by (rule gt_diff[OF wt_u_ge_s])
       }
       moreover
       {
         assume "\<not> head u \<le>\<ge>\<^sub>h\<^sub>d head s"
         hence ?thesis
           by (rule gt_unary[OF wt_u_ge_s _ gt_unary_u_t(3,4) arg_u_ge_s])
       }
       ultimately show ?thesis
         unfolding comp_hd_def by sat
     next
       case gt_diff_u_t: gt_diff
       have "head u >\<^sub>h\<^sub>d head s"
         using gt_diff_u_t(2) gt_diff_t_s(2) gt_hd_trans by blast
       thus ?thesis
         by (rule gt_diff[OF wt_u_ge_s])
     next
       case gt_same_u_t: gt_same
       have "head u >\<^sub>h\<^sub>d head s"
         using gt_diff_t_s(2) gt_same_u_t(2) by simp
       thus ?thesis
         by (rule gt_diff[OF wt_u_ge_s])
     qed
   next
     case gt_same_t_s: gt_same
     show ?thesis
       using u_gt_t
     proof cases
       case gt_wt_u_t: gt_wt
       hence "wt u >\<^sub>p wt s"
         using wt_t_ge_s gt_ge_tpoly_trans by blast
       thus ?thesis
         by (rule gt_wt)
     next
       case gt_unary_u_t: gt_unary
       have "is_App u"
         by (metis args_Nil_iff_is_Hd gt_unary_u_t(3) length_greater_0_conv less_numeral_extra(1))
       hence "arg u >\<^sub>t s"
         using ih[of "arg u" t s] gt_unary_u_t(5) t_gt_s size_arg_lt wary_arg_u wary_s wary_t
         by force
       hence arg_u_ge_s: "arg u \<ge>\<^sub>t s"
         by sat
 
       have "\<not> head u \<le>\<ge>\<^sub>h\<^sub>d head s"
         using gt_same_t_s(2) gt_unary_u_t(2) by simp
       thus ?thesis
         by (rule gt_unary[OF wt_u_ge_s _ gt_unary_u_t(3,4) arg_u_ge_s])
     next
       case gt_diff_u_t: gt_diff
       have "head u >\<^sub>h\<^sub>d head s"
         using gt_diff_u_t(2) gt_same_t_s(2) by simp
       thus ?thesis
         by (rule gt_diff[OF wt_u_ge_s])
     next
       case gt_same_u_t: gt_same
       have hd_u_s: "head u = head s"
         by (simp only: gt_same_t_s(2) gt_same_u_t(2))
 
       let ?S = "set (args u) \<union> set (args t) \<union> set (args s)"
 
       have gt_trans_args: "\<forall>ua \<in> ?S. \<forall>ta \<in> ?S. \<forall>sa \<in> ?S. ua >\<^sub>t ta \<longrightarrow> ta >\<^sub>t sa \<longrightarrow> ua >\<^sub>t sa"
       proof clarify
         fix sa ta ua
         assume
           ua_in: "ua \<in> ?S" and ta_in: "ta \<in> ?S" and sa_in: "sa \<in> ?S" and
           ua_gt_ta: "ua >\<^sub>t ta" and ta_gt_sa: "ta >\<^sub>t sa"
         have wary_sa: "wary sa" and wary_ta: "wary ta" and wary_ua: "wary ua"
           using wary_args ua_in ta_in sa_in wary_u wary_t wary_s by blast+
         show "ua >\<^sub>t sa"
           by (auto intro!: ih[OF Max_lt_imp_lt_mset wary_ua wary_ta wary_sa ua_gt_ta ta_gt_sa])
             (meson ua_in ta_in sa_in Un_iff max.strict_coboundedI1 max.strict_coboundedI2
                size_in_args)+
       qed
       have "\<forall>f \<in> ground_heads (head u). extf f (>\<^sub>t) (args u) (args s)"
         by (clarify, rule extf_trans_from_irrefl[of ?S _ "args t", OF _ _ _ _ _ gt_trans_args])
           (auto simp: gt_same_u_t(2,3) gt_same_t_s(3) wary_args wary_u wary_t wary_s gt_irrefl)
       thus ?thesis
         by (rule gt_same[OF wt_u_ge_s hd_u_s])
     qed
   qed
 qed
 
 lemma gt_antisym: "wary s \<Longrightarrow> wary t \<Longrightarrow> t >\<^sub>t s \<Longrightarrow> \<not> s >\<^sub>t t"
   using gt_irrefl gt_trans by blast
 
 
 subsection \<open>Subterm Property\<close>
 
 lemma gt_sub_fun: "App s t >\<^sub>t s"
 proof (cases "wt (App s t) >\<^sub>p wt s")
   case True
   thus ?thesis
     using gt_wt by simp
 next
   case False
   hence \<delta>_eq_\<epsilon>: "\<delta>\<^sub>h = \<epsilon>\<^sub>h"
     using wt_App_ge_fun dual_order.order_iff_strict wt_App_arg_\<delta>\<^sub>h wt_\<delta>\<^sub>h_imp_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h
     unfolding gt_tpoly_def ge_tpoly_def by fast
 
   have hd_st: "head (App s t) = head s"
     by auto
   have extf: "\<forall>f \<in> ground_heads (head (App s t)). extf f (>\<^sub>t) (args (App s t)) (args s)"
     by (simp add: \<delta>_eq_\<epsilon> extf_snoc_if_\<delta>\<^sub>h_eq_\<epsilon>\<^sub>h)
   show ?thesis
     by (rule gt_same[OF wt_App_ge_fun hd_st extf])
 qed
 
 theorem gt_proper_sub: "wary t \<Longrightarrow> proper_sub s t \<Longrightarrow> t >\<^sub>t s"
   by (induct t) (auto intro: gt_sub_fun gt_sub_arg gt_trans sub.intros wary_sub)
 
 
 subsection \<open>Compatibility with Functions\<close>
 
 lemma gt_compat_fun:
   assumes
     wary_t: "wary t" and
     t'_gt_t: "t' >\<^sub>t t"
   shows "App s t' >\<^sub>t App s t"
 proof (rule gt_same; clarify?)
   show "wt (App s t') \<ge>\<^sub>p wt (App s t)"
     using gt_imp_wt[OF t'_gt_t, unfolded ge_tpoly_def]
     by (cases s rule: tm_exhaust_apps,
       auto simp del: apps_append simp: ge_tpoly_def App_apps eval_ztpoly_nonneg
         intro: ordered_comm_semiring_class.comm_mult_left_mono)
 next
   fix f
   have "extf f (>\<^sub>t) (args s @ [t']) (args s @ [t])"
     using t'_gt_t by (metis extf_compat_list gt_irrefl[OF wary_t])
   thus "extf f (>\<^sub>t) (args (App s t')) (args (App s t))"
     by simp
 qed simp
 
 theorem gt_compat_fun_strong:
   assumes
     wary_t: "wary t" and
     t'_gt_t: "t' >\<^sub>t t"
   shows "apps s (t' # us) >\<^sub>t apps s (t # us)"
 proof (induct us rule: rev_induct)
   case Nil
   show ?case
     using t'_gt_t by (auto intro!: gt_compat_fun[OF wary_t])
 next
   case (snoc u us)
   note ih = snoc
 
   let ?v' = "apps s (t' # us @ [u])"
   let ?v = "apps s (t # us @ [u])"
 
   have "wt ?v' \<ge>\<^sub>p wt ?v"
     using gt_imp_wt[OF ih]
     by (cases s rule: tm_exhaust_apps,
       simp del: apps_append add: App_apps apps_append[symmetric] ge_tpoly_def,
       subst (1 2) zip_eq_butlast_last, simp+)
   moreover have "head ?v' = head ?v"
     by simp
   moreover have "\<forall>f \<in> ground_heads (head ?v'). extf f (>\<^sub>t) (args ?v') (args ?v)"
     by (metis args_apps extf_compat_list gt_irrefl[OF wary_t] t'_gt_t)
   ultimately show ?case
     by (rule gt_same)
 qed
 
 
 subsection \<open>Compatibility with Arguments\<close>
 
 theorem gt_compat_arg_weak:
   assumes
     wary_st: "wary (App s t)" and
     wary_s't: "wary (App s' t)" and
     coef_s'_0_ge_s: "coef s' 0 \<ge>\<^sub>p coef s 0" and
     s'_gt_s: "s' >\<^sub>t s"
   shows "App s' t >\<^sub>t App s t"
 proof -
   obtain \<zeta> ss where s: "s = apps (Hd \<zeta>) ss"
     by (metis tm_exhaust_apps)
   obtain \<zeta>' ss' where s': "s' = apps (Hd \<zeta>') ss'"
     by (metis tm_exhaust_apps)
 
   have len_ss_lt: "of_nat (length ss) < arity_sym\<^sub>h (min_ground_head \<zeta>)"
     using wary_st[unfolded s] ground_heads_arity\<^sub>h less_le_trans min_ground_head_in_ground_heads
     by (metis (no_types) tm_collapse_apps tm_inject_apps wary_AppE\<^sub>h)
 
   have \<delta>_etc:
     "\<delta>\<^sub>h + \<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss) - 1) =
      \<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss))"
     if wary: "wary (App (apps (Hd \<zeta>) ss) t)" for \<zeta> ss
   proof (cases "\<delta>\<^sub>h > 0")
     case True
     then obtain n where n: "of_nat n = arity_sym\<^sub>h (min_ground_head \<zeta>)"
       by (metis arity_sym\<^sub>h_if_\<delta>\<^sub>h_gt_0_E)
 
     have "of_nat (length ss) < arity_sym\<^sub>h (min_ground_head \<zeta>)"
       using wary
       by (metis (no_types) wary_AppE\<^sub>h ground_heads_arity\<^sub>h le_less_trans
         min_ground_head_in_ground_heads not_le tm_collapse_apps tm_inject_apps)
     thus ?thesis
       by (fold n, subst of_nat_1[symmetric], fold of_nat_minus_hmset, simp,
         metis Suc_diff_Suc mult_Suc_right of_nat_add of_nat_mult)
   qed simp
 
   have coef_\<zeta>'_ge_\<zeta>: "coef_hd \<zeta>' (length ss') \<ge>\<^sub>p coef_hd \<zeta> (length ss)"
     by (rule coef_s'_0_ge_s[unfolded s s', simplified])
 
   have wt_s'_ge_s: "wt s' \<ge>\<^sub>p wt s"
     by (rule gt_imp_wt[OF s'_gt_s])
 
   have \<zeta>_tms_len_ss_tms_wt_t_le:
     "eval_ztpoly A (coef_hd \<zeta> (length ss)) * eval_ztpoly A (wt t)
      \<le> eval_ztpoly A (coef_hd \<zeta>' (length ss')) * eval_ztpoly A (wt t)"
     if legal: "legal_zpassign A" for A
     using legal coef_\<zeta>'_ge_\<zeta>[unfolded ge_tpoly_def]
     by (simp add: eval_ztpoly_nonneg mult_right_mono)
 
   have wt_s't_ge_st: "wt (App s' t) \<ge>\<^sub>p wt (App s t)"
     unfolding s s'
     by (clarsimp simp del: apps_append simp: App_apps ge_tpoly_def add_ac(1)[symmetric]
           intro!: add_mono[OF _ \<zeta>_tms_len_ss_tms_wt_t_le],
       rule add_le_imp_le_left[of "zhmset_of \<delta>\<^sub>h"],
       unfold add_ac(1)[symmetric] add.commute[of 1] diff_diff_add[symmetric],
       subst (1 3) ac_simps(3)[unfolded add_ac(1)[symmetric]], subst (1 3) add_ac(1),
       simp only: zhmset_of_plus[symmetric] \<delta>_etc[OF wary_st[unfolded s]]
         \<delta>_etc[OF wary_s't[unfolded s']] add_ac(1)
         wt_s'_ge_s[unfolded s s', unfolded ge_tpoly_def add_ac(1)[symmetric], simplified])
   show ?thesis
     using s'_gt_s
   proof cases
     case gt_wt_s'_s: gt_wt
 
     have "wt (App s' t) >\<^sub>p wt (App s t)"
       unfolding s s'
       by (clarsimp simp del: apps_append simp: App_apps gt_tpoly_def add_ac(1)[symmetric]
             intro!: add_less_le_mono[OF _ \<zeta>_tms_len_ss_tms_wt_t_le],
         rule add_less_imp_less_left[of "zhmset_of \<delta>\<^sub>h"],
         unfold add_ac(1)[symmetric] add.commute[of 1] diff_diff_add[symmetric],
         subst (1 3) ac_simps(3)[unfolded add_ac(1)[symmetric]],
         subst (1 3) add_ac(1),
         simp only: zhmset_of_plus[symmetric] \<delta>_etc[OF wary_st[unfolded s]]
           \<delta>_etc[OF wary_s't[unfolded s']] add_ac(1)
           gt_wt_s'_s[unfolded s s', unfolded gt_tpoly_def add_ac(1)[symmetric], simplified])
     thus ?thesis
       by (rule gt_wt)
   next
     case gt_unary_s'_s: gt_unary
     have False
       by (metis ground_heads_arity\<^sub>h gt_unary_s'_s(3) gt_unary_s'_s(4) hmset_of_enat_1 leD of_nat_1
         wary_AppE\<^sub>h wary_s't)
     thus ?thesis
       by sat
   next
     case gt_diff_s'_s: gt_diff
     show ?thesis
       by (rule gt_diff[OF wt_s't_ge_st]) (simp add: gt_diff_s'_s(2))
   next
     case gt_same_s'_s: gt_same
     have hd_s't: "head (App s' t) = head (App s t)"
       by (simp add: gt_same_s'_s(2))
     have "\<forall>f \<in> ground_heads (head (App s' t)). extf f (>\<^sub>t) (args (App s' t)) (args (App s t))"
       using gt_same_s'_s(3) by (auto intro: extf_compat_append_right)
     thus ?thesis
       by (rule gt_same[OF wt_s't_ge_st hd_s't])
   qed
 qed
 
 
 subsection \<open>Stability under Substitution\<close>
 
 primrec
   subst_zpassign :: "('v \<Rightarrow> ('s, 'v) tm) \<Rightarrow> ('v pvar \<Rightarrow> zhmultiset) \<Rightarrow> 'v pvar \<Rightarrow> zhmultiset"
 where
   "subst_zpassign \<rho> A (PWt x) =
    eval_ztpoly A (wt (\<rho> x)) - zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head (Var x)))"
 | "subst_zpassign \<rho> A (PCoef x i) = eval_ztpoly A (coef (\<rho> x) i)"
 
 lemma legal_subst_zpassign:
   assumes
     legal: "legal_zpassign A" and
     wary_\<rho>: "wary_subst \<rho>"
   shows "legal_zpassign (subst_zpassign \<rho> A)"
   unfolding legal_zpassign_def
 proof
   fix v
   show "subst_zpassign \<rho> A v \<ge> min_zpassign v"
   proof (cases v)
     case v: (PWt x)
     obtain \<zeta> ss where \<rho>x: "\<rho> x = apps (Hd \<zeta>) ss"
       by (rule tm_exhaust_apps)
 
     have ghd_\<zeta>: "ground_heads \<zeta> \<subseteq> ground_heads_var x"
       using wary_\<rho>[unfolded wary_subst_def, rule_format, of x, unfolded \<rho>x] by simp
 
     have "zhmset_of (wt_sym (min_ground_head (Var x)) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head (Var x)))
       \<le> eval_ztpoly A (wt0 \<zeta>) + zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))"
     proof -
       have mgh_x_min:
         "zhmset_of (wt_sym (min_ground_head (Var x)) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head (Var x)))
          \<le> zhmset_of (wt_sym (min_ground_head \<zeta>) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))"
         by (simp add: zmset_of_le zhmset_of_le ghd_\<zeta> min_ground_head_antimono)
       have wt_mgh_le_wt0: "zhmset_of (wt_sym (min_ground_head \<zeta>)) \<le> eval_ztpoly A (wt0 \<zeta>)"
         using wt0_ge_min_ground_head[OF legal] by blast
       show ?thesis
         by (rule order_trans[OF mgh_x_min]) (simp add: zhmset_of_plus wt_mgh_le_wt0)
     qed
     also have "\<dots> \<le> eval_ztpoly A (wt0 \<zeta>)
       + zhmset_of ((\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss)))
         + of_nat (length ss) * \<delta>\<^sub>h)"
     proof -
       have "zhmset_of (\<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head \<zeta>))
         \<le> zhmset_of (\<delta>\<^sub>h * (of_nat (length ss)
           + (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss))))"
         by (metis add.commute le_minus_plus_same_hmset mult_le_mono2_hmset zhmset_of_le)
       thus ?thesis
         by (simp add: add.commute add.left_commute distrib_left mult.commute)
     qed
     also have "\<dots> \<le> eval_ztpoly A (wt0 \<zeta>)
       + zhmset_of ((\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss)))
         + of_nat (length ss) * \<epsilon>\<^sub>h)"
       using \<delta>\<^sub>h_le_\<epsilon>\<^sub>h zhmset_of_le by auto
     also have "\<dots> \<le> eval_ztpoly A (wt0 \<zeta>)
       + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss))) + wt_args 0 A \<zeta> ss"
       using wt_args_ge_length_times_\<epsilon>\<^sub>h[OF legal]
       by (simp add: algebra_simps zhmset_of_plus zhmset_of_times of_nat_zhmset)
     finally have wt_x_le_\<zeta>ssts:
       "zhmset_of (wt_sym (min_ground_head (Var x)) + \<delta>\<^sub>h * arity_sym\<^sub>h (min_ground_head (Var x)))
        \<le> eval_ztpoly A (wt0 \<zeta>)
          + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<zeta>) - of_nat (length ss)))
          + wt_args 0 A \<zeta> ss"
       by assumption
 
     show ?thesis
       using wt_x_le_\<zeta>ssts[unfolded wt_args_def]
       by (simp add: v \<rho>x comp_def le_diff_eq add.assoc[symmetric] ZHMSet_plus[symmetric]
         zmset_of_plus[symmetric] hmsetmset_plus[symmetric] zmset_of_le)
   next
     case (PCoef x i)
     thus ?thesis
       using coef_gt_0[OF legal, unfolded zero_less_iff_1_le_hmset]
       by (simp add: zhmset_of_1 zero_less_iff_1_le_zhmset)
   qed
 qed
 
 lemma wt_subst:
   assumes
     legal: "legal_zpassign A" and
     wary_\<rho>: "wary_subst \<rho>"
   shows "wary s \<Longrightarrow> eval_ztpoly A (wt (subst \<rho> s)) = eval_ztpoly (subst_zpassign \<rho> A) (wt s)"
 proof (induct s rule: tm_induct_apps)
   case (apps \<zeta> ss)
   note ih = this(1) and wary_\<zeta>ss = this(2)
 
   have wary_nth_ss: "\<And>i. i < length ss \<Longrightarrow> wary (ss ! i)"
     using wary_args[OF _ wary_\<zeta>ss] by force
 
   show ?case
   proof (cases \<zeta>)
     case \<zeta>: (Var x)
     show ?thesis
     proof (cases "\<rho> x" rule: tm_exhaust_apps)
       case \<rho>x: (apps \<xi> ts)
 
       have wary_\<rho>x: "wary (\<rho> x)"
         using wary_\<rho> wary_subst_def by blast
 
       have coef_subst: "\<And>i. eval_tpoly A (zhmset_of_tpoly (coef_hd \<xi> (i + length ts))) =
         eval_tpoly (subst_zpassign \<rho> A) (zhmset_of_tpoly (coef_hd (Var x) i))"
         by (simp add: \<rho>x)
 
       have tedious_ary_arith:
         "arity_sym\<^sub>h (min_ground_head (Var x))
          + (arity_sym\<^sub>h (min_ground_head \<xi>) - (of_nat (length ss) + of_nat (length ts))) =
          arity_sym\<^sub>h (min_ground_head \<xi>) - of_nat (length ts)
          + (arity_sym\<^sub>h (min_ground_head (Var x)) - of_nat (length ss))"
         if \<delta>_gt_0: "\<delta>\<^sub>h > 0"
       proof -
         obtain m where m: "of_nat m = arity_sym\<^sub>h (min_ground_head (Var x))"
           by (metis arity_sym\<^sub>h_if_\<delta>\<^sub>h_gt_0_E[OF \<delta>_gt_0])
         obtain n where n: "of_nat n = arity_sym\<^sub>h (min_ground_head \<xi>)"
           by (metis arity_sym\<^sub>h_if_\<delta>\<^sub>h_gt_0_E[OF \<delta>_gt_0])
 
         have "m \<ge> length ss"
           unfolding of_nat_le_hmset[symmetric] m using wary_\<zeta>ss[unfolded \<zeta>]
           by (cases rule: wary_cases_apps\<^sub>h, clarsimp,
             metis arity_hd.simps(1) enat_ile enat_ord_simps(1) ground_heads_arity
               hmset_of_enat_inject hmset_of_enat_of_nat le_trans m min_ground_head_in_ground_heads
               of_nat_eq_enat of_nat_le_hmset_of_enat_iff)
         moreover have n_ge_len_ss_ts: "n \<ge> length ss + length ts"
         proof -
           have "of_nat (length ss) + of_nat (length ts) \<le> arity_hd\<^sub>h \<zeta> + of_nat (length ts)"
             using wary_\<zeta>ss wary_cases_apps\<^sub>h by fastforce
           also have "\<dots> = arity_var\<^sub>h x + of_nat (length ts)"
             by (simp add: \<zeta>)
           also have "\<dots> \<le> arity\<^sub>h (\<rho> x) + of_nat (length ts)"
             using wary_\<rho> wary_subst_def by auto
           also have "\<dots> = arity\<^sub>h (apps (Hd \<xi>) ts) + of_nat (length ts)"
             by (simp add: \<rho>x)
           also have "\<dots> = arity_hd\<^sub>h \<xi>"
             using wary_\<rho>x[unfolded \<rho>x]
             by (cases rule: wary_cases_apps\<^sub>h, cases "arity_hd \<xi>",
               simp add: of_nat_add[symmetric] of_nat_minus_hmset[symmetric],
               metis \<delta>_gt_0 arity_hd_ne_infinity_if_\<delta>_gt_0 of_nat_0 of_nat_less_hmset)
           also have "\<dots> \<le> arity_sym\<^sub>h (min_ground_head \<xi>)"
             using ground_heads_arity\<^sub>h min_ground_head_in_ground_heads by blast
           finally show ?thesis
             unfolding of_nat_le_hmset[symmetric] n by simp
         qed
         moreover have "n \<ge> length ts"
           using n_ge_len_ss_ts by simp
         ultimately show ?thesis
           by (fold m n of_nat_add of_nat_minus_hmset, unfold of_nat_inject_hmset, fastforce)
       qed
 
       have "eval_tpoly A (zhmset_of_tpoly (wt (subst \<rho> (apps (Hd (Var x)) ss)))) =
         eval_tpoly A (zhmset_of_tpoly (wt0 \<xi>))
         + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<xi>)
           - (of_nat (length ts) + of_nat (length ss))))
         + wt_args 0 A \<xi> (ts @ map (subst \<rho>) ss)"
         by (simp del: apps_append add: apps_append[symmetric] \<rho>x wt_args_def comp_def)
       also have "\<dots> = eval_tpoly A (zhmset_of_tpoly (wt0 \<xi>))
         + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<xi>)
           - (of_nat (length ts) + of_nat (length ss))))
         + wt_args 0 A \<xi> ts + wt_args (length ts) A \<xi> (map (subst \<rho>) ss)"
         by (simp add: wt_args_def zip_append_0_upt[of ts "map (subst \<rho>) ss", simplified])
       also have "\<dots> = eval_tpoly A (zhmset_of_tpoly (wt0 \<xi>))
         + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head \<xi>)
           - (of_nat (length ts) + of_nat (length ss))))
         + wt_args 0 A \<xi> ts + wt_args 0 (subst_zpassign \<rho> A) (Var x) ss"
         by (auto intro!: arg_cong[of _ _ sum_list] nth_map_conv
           simp: wt_args_def coef_subst add.commute zhmset_of_times ih[OF nth_mem wary_nth_ss])
       also have "\<dots> = eval_tpoly (subst_zpassign \<rho> A) (zhmset_of_tpoly (wt0 (Var x)))
         + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h (min_ground_head (Var x)) - of_nat (length ss)))
         + wt_args 0 (subst_zpassign \<rho> A) (Var x) ss"
         by (simp add: \<rho>x wt_args_def comp_def algebra_simps ring_distribs(1)[symmetric]
               zhmset_of_times zhmset_of_plus[symmetric] zhmset_of_0[symmetric])
           (use tedious_ary_arith in fastforce)
       also have "\<dots> = eval_tpoly (subst_zpassign \<rho> A) (zhmset_of_tpoly (wt (apps (Hd (Var x)) ss)))"
         by (simp add: wt_args_def comp_def)
       finally show ?thesis
         unfolding \<zeta> by assumption
     qed
   next
     case \<zeta>: (Sym f)
 
     have "eval_tpoly A (zhmset_of_tpoly (wt (subst \<rho> (apps (Hd (Sym f)) ss)))) =
       zhmset_of (wt_sym f) + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h f - of_nat (length ss)))
       + wt_args 0 A (Sym f) (map (subst \<rho>) ss)"
       by (simp add: wt_args_def comp_def)
     also have "\<dots> = zhmset_of (wt_sym f) + zhmset_of (\<delta>\<^sub>h * (arity_sym\<^sub>h f - of_nat (length ss)))
       + wt_args 0 (subst_zpassign \<rho> A) (Sym f) ss"
       by (auto simp: wt_args_def ih[OF _ wary_nth_ss] intro!: arg_cong[of _ _ sum_list]
         nth_map_conv)
     also have "\<dots> = eval_tpoly (subst_zpassign \<rho> A) (zhmset_of_tpoly (wt (apps (Hd (Sym f)) ss)))"
       by (simp add: wt_args_def comp_def)
     finally show ?thesis
       unfolding \<zeta> by assumption
   qed
 qed
 
 theorem gt_subst:
   assumes wary_\<rho>: "wary_subst \<rho>"
   shows "wary t \<Longrightarrow> wary s \<Longrightarrow> t >\<^sub>t s \<Longrightarrow> subst \<rho> t >\<^sub>t subst \<rho> s"
 proof (simp only: atomize_imp,
     rule measure_induct_rule[of "\<lambda>(t, s). {#size t, size s#}"
         "\<lambda>(t, s). wary t \<longrightarrow> wary s \<longrightarrow> t >\<^sub>t s \<longrightarrow> subst \<rho> t >\<^sub>t subst \<rho> s" "(t, s)",
       simplified prod.case],
     simp only: split_paired_all prod.case atomize_imp[symmetric])
   fix t s
   assume
     ih: "\<And>ta sa. {#size ta, size sa#} < {#size t, size s#} \<Longrightarrow> wary ta \<Longrightarrow> wary sa \<Longrightarrow> ta >\<^sub>t sa \<Longrightarrow>
       subst \<rho> ta >\<^sub>t subst \<rho> sa" and
     wary_t: "wary t" and wary_s: "wary s" and t_gt_s: "t >\<^sub>t s"
 
   show "subst \<rho> t >\<^sub>t subst \<rho> s"
     using t_gt_s
   proof cases
     case gt_wt_t_s: gt_wt
 
     have "wt (subst \<rho> t) >\<^sub>p wt (subst \<rho> s)"
       by (auto simp: gt_tpoly_def wary_s wary_t wt_subst[OF _ wary_\<rho>]
         intro: gt_wt_t_s[unfolded gt_tpoly_def, rule_format]
         elim: legal_subst_zpassign[OF _ wary_\<rho>])
     thus ?thesis
       by (rule gt_wt)
   next
     assume wt_t_ge_s: "wt t \<ge>\<^sub>p wt s"
 
     have wt_\<rho>t_ge_\<rho>s: "wt (subst \<rho> t) \<ge>\<^sub>p wt (subst \<rho> s)"
       by (auto simp: ge_tpoly_def wary_s wary_t wt_subst[OF _ wary_\<rho>]
         intro: wt_t_ge_s[unfolded ge_tpoly_def, rule_format]
         elim: legal_subst_zpassign[OF _ wary_\<rho>])
 
     {
       case gt_unary
 
       have wary_\<rho>t: "wary (subst \<rho> t)"
         by (simp add: wary_subst_wary wary_t wary_\<rho>)
 
       show ?thesis
       proof (cases t)
         case Hd
         hence False
           using gt_unary(3) by simp
         thus ?thesis
           by sat
       next
         case t: (App t1 t2)
         hence t2: "t2 = arg t"
           by simp
         hence wary_t2: "wary t2"
           using wary_t by blast
 
         show ?thesis
         proof (cases "t2 = s")
           case True
           moreover have "subst \<rho> t >\<^sub>t subst \<rho> t2"
             using gt_sub_arg wary_\<rho>t unfolding t by simp
           ultimately show ?thesis
             by simp
         next
           case t2_ne_s: False
           hence t2_gt_s: "t2 >\<^sub>t s"
             using gt_unary(5) t2 by blast
 
           have "subst \<rho> t2 >\<^sub>t subst \<rho> s"
             by (rule ih[OF _ wary_t2 wary_s t2_gt_s]) (simp add: t)
           thus ?thesis
             by (metis gt_sub_arg gt_trans subst.simps(2) t wary_\<rho> wary_\<rho>t wary_s wary_subst_wary
               wary_t2)
         qed
       qed
     }
     {
       case _: gt_diff
       note hd_t_gt_hd_s = this(2)
 
       have "head (subst \<rho> t) >\<^sub>h\<^sub>d head (subst \<rho> s)"
         by (meson hd_t_gt_hd_s wary_subst_ground_heads gt_hd_def rev_subsetD wary_\<rho>)
       thus ?thesis
         by (rule gt_diff[OF wt_\<rho>t_ge_\<rho>s])
     }
     {
       case _: gt_same
       note hd_s_eq_hd_t = this(2) and extf = this(3)
 
       have hd_\<rho>t: "head (subst \<rho> t) = head (subst \<rho> s)"
         by (simp add: hd_s_eq_hd_t)
 
       {
         fix f
         assume f_in_grs: "f \<in> ground_heads (head (subst \<rho> t))"
 
         let ?S = "set (args t) \<union> set (args s)"
 
         have extf_args_s_t: "extf f (>\<^sub>t) (args t) (args s)"
           using extf f_in_grs wary_subst_ground_heads wary_\<rho> by blast
         have "extf f (>\<^sub>t) (map (subst \<rho>) (args t)) (map (subst \<rho>) (args s))"
         proof (rule extf_map[of ?S, OF _ _ _ _ _ _ extf_args_s_t])
           show "\<forall>x \<in> ?S. \<not> subst \<rho> x >\<^sub>t subst \<rho> x"
             using gt_irrefl wary_t wary_s wary_args wary_\<rho> wary_subst_wary by fastforce
         next
           show "\<forall>z \<in> ?S. \<forall>y \<in> ?S. \<forall>x \<in> ?S. subst \<rho> z >\<^sub>t subst \<rho> y \<longrightarrow> subst \<rho> y >\<^sub>t subst \<rho> x \<longrightarrow>
             subst \<rho> z >\<^sub>t subst \<rho> x"
             using gt_trans wary_t wary_s wary_args wary_\<rho> wary_subst_wary by (metis Un_iff)
         next
           have sz_a: "\<forall>ta \<in> ?S. \<forall>sa \<in> ?S. {#size ta, size sa#} < {#size t, size s#}"
             by (fastforce intro: Max_lt_imp_lt_mset dest: size_in_args)
           show "\<forall>y \<in> ?S. \<forall>x \<in> ?S. y >\<^sub>t x \<longrightarrow> subst \<rho> y >\<^sub>t subst \<rho> x"
             using ih sz_a size_in_args wary_t wary_s wary_args wary_\<rho> wary_subst_wary by fastforce
         qed auto
         hence "extf f (>\<^sub>t) (args (subst \<rho> t)) (args (subst \<rho> s))"
           by (auto simp: hd_s_eq_hd_t intro: extf_compat_append_left)
       }
       hence "\<forall>f \<in> ground_heads (head (subst \<rho> t)).
         extf f (>\<^sub>t) (args (subst \<rho> t)) (args (subst \<rho> s))"
         by blast
       thus ?thesis
         by (rule gt_same[OF wt_\<rho>t_ge_\<rho>s hd_\<rho>t])
     }
   qed
 qed
 
 
 subsection \<open>Totality on Ground Terms\<close>
 
 lemma wt_total_ground:
   assumes
     gr_t: "ground t" and
     gr_s: "ground s"
   shows "wt t >\<^sub>p wt s \<or> wt s >\<^sub>p wt t \<or> wt t =\<^sub>p wt s"
   unfolding gt_tpoly_def eq_tpoly_def
   by (subst (1 2 3) ground_eval_ztpoly_wt_eq[OF gr_t, of _ undefined],
     subst (1 2 3) ground_eval_ztpoly_wt_eq[OF gr_s, of _ undefined], auto)
 
 
 theorem gt_total_ground:
   assumes extf_total: "\<And>f. ext_total (extf f)"
   shows "ground t \<Longrightarrow> ground s \<Longrightarrow> t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s"
 proof (simp only: atomize_imp,
     rule measure_induct_rule[of "\<lambda>(t, s). {# size t, size s #}"
       "\<lambda>(t, s). ground t \<longrightarrow> ground s \<longrightarrow> t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s" "(t, s)", simplified prod.case],
     simp only: split_paired_all prod.case atomize_imp[symmetric])
   fix t s :: "('s, 'v) tm"
   assume
     ih: "\<And>ta sa. {# size ta, size sa #} < {# size t, size s #} \<Longrightarrow> ground ta \<Longrightarrow> ground sa \<Longrightarrow>
       ta >\<^sub>t sa \<or> sa >\<^sub>t ta \<or> ta = sa" and
     gr_t: "ground t" and gr_s: "ground s"
 
   let ?case = "t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s"
 
   {
     assume "wt t >\<^sub>p wt s"
     hence "t >\<^sub>t s"
       by (rule gt_wt)
   }
   moreover
   {
     assume "wt s >\<^sub>p wt t"
     hence "s >\<^sub>t t"
       by (rule gt_wt)
   }
   moreover
   {
     assume "wt t =\<^sub>p wt s"
     hence wt_t_ge_s: "wt t \<ge>\<^sub>p wt s" and wt_s_ge_t: "wt s \<ge>\<^sub>p wt t"
       by (simp add: eq_tpoly_def ge_tpoly_def)+
 
     obtain g where \<xi>: "head t = Sym g"
       by (metis ground_head[OF gr_t] hd.collapse(2))
     obtain f where \<zeta>: "head s = Sym f"
       by (metis ground_head[OF gr_s] hd.collapse(2))
 
     {
       assume g_gt_f: "g >\<^sub>s f"
       have "t >\<^sub>t s"
         by (rule gt_diff[OF wt_t_ge_s]) (simp add: \<xi> \<zeta> g_gt_f gt_hd_def)
     }
     moreover
     {
       assume f_gt_g: "f >\<^sub>s g"
       have "s >\<^sub>t t"
         by (rule gt_diff[OF wt_s_ge_t]) (simp add: \<xi> \<zeta> f_gt_g gt_hd_def)
     }
     moreover
     {
       assume g_eq_f: "g = f"
       hence hd_t: "head t = head s"
         using \<xi> \<zeta> by force
       note hd_s = hd_t[symmetric]
 
       let ?ts = "args t"
       let ?ss = "args s"
 
       have gr_ts: "\<forall>t \<in> set ?ts. ground t"
         using gr_t ground_args by auto
       have gr_ss: "\<forall>s \<in> set ?ss. ground s"
         using gr_s ground_args by auto
 
       have ?case
       proof (cases "?ts = ?ss")
         case ts_eq_ss: True
         show ?thesis
           using \<xi> \<zeta> g_eq_f ts_eq_ss by (simp add: tm_expand_apps)
       next
         case False
         hence "extf g (>\<^sub>t) ?ts ?ss \<or> extf g (>\<^sub>t) ?ss ?ts"
           using ih gr_ss gr_ts less_multiset_doubletons
             ext_total.total[OF extf_total, rule_format, of "set ?ts \<union> set ?ss" "(>\<^sub>t)" ?ts ?ss g]
           by (metis Un_commute Un_iff in_lists_iff_set size_in_args sup_ge2)
         moreover
         {
           assume extf: "extf g (>\<^sub>t) ?ts ?ss"
           have "t >\<^sub>t s"
             by (rule gt_same[OF wt_t_ge_s hd_t]) (simp add: extf \<xi>)
         }
         moreover
         {
           assume extf: "extf g (>\<^sub>t) ?ss ?ts"
           have "s >\<^sub>t t"
             by (rule gt_same[OF wt_s_ge_t hd_s]) (simp add: extf[unfolded g_eq_f] \<zeta>)
         }
         ultimately show ?thesis
           by sat
       qed
     }
     ultimately have ?case
       using gt_sym_total by blast
   }
   ultimately show ?case
     using wt_total_ground[OF gr_t gr_s] by fast
 qed
 
 
 subsection \<open>Well-foundedness\<close>
 
 abbreviation gtw :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix ">\<^sub>t\<^sub>w" 50) where
   "(>\<^sub>t\<^sub>w) \<equiv> \<lambda>t s. wary t \<and> wary s \<and> t >\<^sub>t s"
 
 abbreviation gtwg :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix ">\<^sub>t\<^sub>w\<^sub>g" 50) where
   "(>\<^sub>t\<^sub>w\<^sub>g) \<equiv> \<lambda>t s. ground t \<and> t >\<^sub>t\<^sub>w s"
 
 lemma ground_gt_unary:
   assumes gr_t: "ground t"
   shows "\<not> gt_unary t s"
 proof
   assume gt_unary_t_s: "gt_unary t s"
   hence "t >\<^sub>t s"
     using gt_iff_wt_unary_diff_same by blast
   hence gr_s: "ground s"
     using gr_t gt_imp_vars by blast
 
   have ngr_t_or_s: "\<not> ground t \<or> \<not> ground s"
     using gt_unary_t_s by cases (blast dest: ground_head not_comp_hd_imp_Var)
 
   show False
     using gr_t gr_s ngr_t_or_s by sat
 qed
 
 theorem gt_wf: "wfP (\<lambda>s t. t >\<^sub>t\<^sub>w s)"
 proof -
   have ground_wfP: "wfP (\<lambda>s t. t >\<^sub>t\<^sub>w\<^sub>g s)"
     unfolding wfP_iff_no_inf_chain
   proof
     assume "\<exists>f. inf_chain (>\<^sub>t\<^sub>w\<^sub>g) f"
     then obtain t where t_bad: "bad (>\<^sub>t\<^sub>w\<^sub>g) t"
       unfolding inf_chain_def bad_def by blast
 
     let ?ff = "worst_chain (>\<^sub>t\<^sub>w\<^sub>g) (\<lambda>t s. size t > size s)"
     let ?A = min_passign
 
     note wf_sz = wf_app[OF wellorder_class.wf, of size, simplified]
 
     have ffi_ground: "\<And>i. ground (?ff i)" and ffi_wary: "\<And>i. wary (?ff i)"
       using worst_chain_bad[OF wf_sz t_bad, unfolded inf_chain_def] by fast+
 
     have "inf_chain (>\<^sub>t\<^sub>w\<^sub>g) ?ff"
       by (rule worst_chain_bad[OF wf_sz t_bad])
     hence bad_wt_diff_same:
       "inf_chain (\<lambda>t s. ground t \<and> (gt_wt t s \<or> gt_diff t s \<or> gt_same t s)) ?ff"
       unfolding inf_chain_def using gt_iff_wt_unary_diff_same ground_gt_unary by blast
 
     have wf_wt: "wf {(s, t). ground t \<and> gt_wt t s}"
       by (rule wf_subset[OF wf_app[of _ "eval_tpoly ?A \<circ> wt", OF wf_less_hmultiset]],
         simp add: gt_wt.simps gt_tpoly_def, fold zhmset_of_less,
         auto simp: legal_min_zpassign gt_wt.simps gt_tpoly_def)
 
     have wt_O_diff_same: "{(s, t). ground t \<and> gt_wt t s}
         O {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and>  (gt_diff t s \<or> gt_same t s)}
       \<subseteq> {(s, t). ground t \<and> gt_wt t s}"
       unfolding gt_wt.simps gt_diff.simps gt_same.simps by (auto intro: ge_gt_tpoly_trans)
 
     have wt_diff_same_as_union:
       "{(s, t). ground t \<and> (gt_wt t s \<or> gt_diff t s \<or> gt_same t s)} =
        {(s, t). ground t \<and> gt_wt t s}
        \<union> {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> (gt_diff t s \<or> gt_same t s)}"
       using gt_ge_tpoly_trans gt_tpoly_irrefl wt_ge_vars wt_total_ground
       by (fastforce simp: gt_wt.simps gt_diff.simps gt_same.simps)
 
     obtain k1 where bad_diff_same:
       "inf_chain (\<lambda>t s. ground t \<and> wt t =\<^sub>p wt s \<and> (gt_diff t s \<or> gt_same t s)) (\<lambda>i. ?ff (i + k1))"
       using wf_infinite_down_chain_compatible[OF wf_wt _ wt_O_diff_same, of ?ff] bad_wt_diff_same
       unfolding inf_chain_def wt_diff_same_as_union[symmetric] by auto
 
     have "wf {(s, t). ground s \<and> ground t \<and> wt t =\<^sub>p wt s \<and> sym (head t) >\<^sub>s sym (head s)}"
       using gt_sym_wf unfolding wfP_def wf_iff_no_infinite_down_chain by fast
     moreover have "{(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_diff t s}
       \<subseteq> {(s, t). ground s \<and> ground t \<and> wt t =\<^sub>p wt s \<and> sym (head t) >\<^sub>s sym (head s)}"
     proof (clarsimp, intro conjI)
       fix s t
       assume gr_t: "ground t" and gt_diff_t_s: "gt_diff t s"
       thus gr_s: "ground s"
         using gt_iff_wt_unary_diff_same gt_imp_vars by fastforce
       show "sym (head t) >\<^sub>s sym (head s)"
         using gt_diff_t_s by cases (simp add: gt_hd_def gr_s gr_t ground_hd_in_ground_heads)
     qed
     ultimately have wf_diff: "wf {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_diff t s}"
       by (rule wf_subset)
 
     have diff_O_same:
       "{(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_diff t s}
          O {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_same t s}
        \<subseteq> {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_diff t s}"
       unfolding gt_diff.simps gt_same.simps by (auto intro: ge_ge_tpoly_trans simp: eq_tpoly_def)
 
     have diff_same_as_union:
       "{(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> (gt_diff t s \<or> gt_same t s)} =
        {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_diff t s}
        \<union> {(s, t). ground t \<and> wt t =\<^sub>p wt s \<and> gt_same t s}"
       by auto
 
     obtain k2 where
       bad_same: "inf_chain (\<lambda>t s. ground t \<and> wt t =\<^sub>p wt s \<and> gt_same t s) (\<lambda>i. ?ff (i + k2))"
       using wf_infinite_down_chain_compatible[OF wf_diff _ diff_O_same, of "\<lambda>i. ?ff (i + k1)"]
         bad_diff_same
       unfolding inf_chain_def diff_same_as_union[symmetric] by (auto simp: add.assoc)
     hence hd_sym: "\<And>i. is_Sym (head (?ff (i + k2)))"
       unfolding inf_chain_def by (simp add: ground_head)
 
     define f where "f = sym (head (?ff k2))"
     define w where "w = eval_tpoly ?A (wt (?ff k2))"
 
     have "head (?ff (i + k2)) = Sym f \<and> eval_tpoly ?A (wt (?ff (i + k2))) = w" for i
     proof (induct i)
       case 0
       thus ?case
         by (auto simp: f_def w_def hd.collapse(2)[OF hd_sym, of 0, simplified])
     next
       case (Suc ia)
       thus ?case
         using bad_same unfolding inf_chain_def gt_same.simps zhmset_of_inject[symmetric]
         by (simp add: eq_tpoly_def legal_min_zpassign)
     qed
     note hd_eq_f = this[THEN conjunct1] and wt_eq_w = this[THEN conjunct2]
 
     define max_args where
       "max_args = (if \<delta>\<^sub>h = 0 then sum_coefs w else the_enat (arity_sym f))"
 
     have nargs_le_max_args: "num_args (?ff (i + k2)) \<le> max_args" for i
     proof (cases "\<delta>\<^sub>h = 0")
       case \<delta>_ne_0: False
       hence ary_f_ne_inf: "arity_sym f \<noteq> \<infinity>"
         using arity_sym_ne_infinity_if_\<delta>_gt_0 of_nat_0 by blast
       have "enat (num_args (worst_chain (\<lambda>t s. ground t \<and> t >\<^sub>t\<^sub>w s) (\<lambda>t s. size s < size t) (i + k2))) \<le> arity_sym f"
         using wary_num_args_le_arity_head[OF ffi_wary[of "i + k2"]] by (simp add: hd_eq_f)
       with \<delta>_ne_0 show ?thesis
         by (simp del: enat_ord_simps add: max_args_def  enat_ord_simps(1)[symmetric] enat_the_enat_iden[OF ary_f_ne_inf])
     next
       case \<delta>_eq_0: True
       show ?thesis
         using sum_coefs_ge_num_args_if_\<delta>\<^sub>h_eq_0[OF legal_min_passign \<delta>_eq_0 ffi_wary[of "i + k2"]]
         by (simp add: max_args_def \<delta>_eq_0 wt_eq_w)
     qed
 
     let ?U_of = "\<lambda>i. set (args (?ff (i + k2)))"
 
     define U where "U = (\<Union>i. ?U_of i)"
 
     have gr_u: "\<And>u. u \<in> U \<Longrightarrow> ground u"
       unfolding U_def by (blast dest: ground_args[OF _ ffi_ground])
     have wary_u: "\<And>u. u \<in> U \<Longrightarrow> wary u"
       unfolding U_def by (blast dest: wary_args[OF _ ffi_wary])
 
     have "\<not> bad (>\<^sub>t\<^sub>w\<^sub>g) u" if u_in: "u \<in> ?U_of i" for u i
     proof
       assume u_bad: "bad (>\<^sub>t\<^sub>w\<^sub>g) u"
       have sz_u: "size u < size (?ff (i + k2))"
         by (rule size_in_args[OF u_in])
 
       show False
       proof (cases "i + k2")
         case 0
         thus False
           using sz_u min_worst_chain_0[OF wf_sz u_bad] by simp
       next
         case Suc
         hence gt: "?ff (i + k2 - 1) >\<^sub>t\<^sub>w ?ff (i + k2)"
           using worst_chain_pred[OF wf_sz t_bad] by auto
         moreover have "?ff (i + k2) >\<^sub>t\<^sub>w u"
           using gt gt_proper_sub sub_args sz_u u_in wary_args by auto
         ultimately have "?ff (i + k2 - 1) >\<^sub>t\<^sub>w u"
           using gt_trans by blast
         thus False
           using Suc sz_u min_worst_chain_Suc[OF wf_sz u_bad] ffi_ground by fastforce
       qed
     qed
     hence u_good: "\<And>u. u \<in> U \<Longrightarrow> \<not> bad (>\<^sub>t\<^sub>w\<^sub>g) u"
       unfolding U_def by blast
 
     let ?gtwu = "\<lambda>t s. t \<in> U \<and> t >\<^sub>t\<^sub>w s"
 
     have gtwu_irrefl: "\<And>x. \<not> ?gtwu x x"
       using gt_irrefl by auto
 
     have "\<And>i j. \<forall>t \<in> set (args (?ff (i + k2))). \<forall>s \<in> set (args (?ff (j + k2))). t >\<^sub>t s \<longrightarrow>
       t \<in> U \<and> t >\<^sub>t\<^sub>w s"
       using wary_u unfolding U_def by blast
     moreover have "\<And>i. extf f (>\<^sub>t) (args (?ff (i + k2))) (args (?ff (Suc i + k2)))"
       using bad_same hd_eq_f unfolding inf_chain_def gt_same.simps by auto
     ultimately have "\<And>i. extf f ?gtwu (args (?ff (i + k2))) (args (?ff (Suc i + k2)))"
       by (rule extf_mono_strong)
     hence "inf_chain (extf f ?gtwu) (\<lambda>i. args (?ff (i + k2)))"
       unfolding inf_chain_def by blast
     hence nwf_ext:
       "\<not> wfP (\<lambda>xs ys. length ys \<le> max_args \<and> length xs \<le> max_args \<and> extf f ?gtwu ys xs)"
       unfolding inf_chain_def wfP_def wf_iff_no_infinite_down_chain using nargs_le_max_args by fast
 
     have gtwu_le_gtwg: "?gtwu \<le> (>\<^sub>t\<^sub>w\<^sub>g)"
       by (auto intro!: gr_u)
 
     have "wfP (\<lambda>s t. ?gtwu t s)"
       unfolding wfP_iff_no_inf_chain
     proof (intro notI, elim exE)
       fix f
       assume bad_f: "inf_chain ?gtwu f"
       hence bad_f0: "bad ?gtwu (f 0)"
         by (rule inf_chain_bad)
       hence "f 0 \<in> U"
         using bad_f unfolding inf_chain_def by blast
       hence "\<not> bad (>\<^sub>t\<^sub>w\<^sub>g) (f 0)"
         using u_good by blast
       hence "\<not> bad ?gtwu (f 0)"
         using bad_f inf_chain_bad inf_chain_subset[OF _ gtwu_le_gtwg] by blast
       thus False
         using bad_f0 by sat
     qed
     hence wf_ext: "wfP (\<lambda>xs ys. length ys \<le> max_args \<and> length xs \<le> max_args \<and> extf f ?gtwu ys xs)"
       using extf_wf_bounded[of ?gtwu] gtwu_irrefl by blast
 
     show False
       using nwf_ext wf_ext by blast
   qed
 
   let ?subst = "subst grounding_\<rho>"
 
   have "wfP (\<lambda>s t. ?subst t >\<^sub>t\<^sub>w\<^sub>g ?subst s)"
     by (rule wfP_app[OF ground_wfP])
   hence "wfP (\<lambda>s t. ?subst t >\<^sub>t\<^sub>w ?subst s)"
     by (simp add: ground_grounding_\<rho>)
   thus ?thesis
     by (auto intro: wfP_subset wary_subst_wary[OF wary_grounding_\<rho>] gt_subst[OF wary_grounding_\<rho>])
 qed
 
 end
 
 end
diff --git a/thys/Lambda_Free_RPOs/Lambda_Free_Util.thy b/thys/Lambda_Free_RPOs/Lambda_Free_Util.thy
--- a/thys/Lambda_Free_RPOs/Lambda_Free_Util.thy
+++ b/thys/Lambda_Free_RPOs/Lambda_Free_Util.thy
@@ -1,629 +1,626 @@
 (*  Title:       Utilities for Lambda-Free Orders
     Author:      Jasmin Blanchette <jasmin.blanchette at inria.fr>, 2016
     Maintainer:  Jasmin Blanchette <jasmin.blanchette at inria.fr>
 *)
 
 section \<open>Utilities for Lambda-Free Orders\<close>
 
 theory Lambda_Free_Util
 imports "HOL-Library.Extended_Nat" "HOL-Library.Multiset_Order"
 begin
 
 text \<open>
 This theory gathers various lemmas that likely belong elsewhere in Isabelle or
 the \emph{Archive of Formal Proofs}. Most (but certainly not all) of them are
 used to formalize orders on \<open>\<lambda>\<close>-free higher-order terms.
 \<close>
 
-hide_const (open) Complex.arg
-
-
 subsection \<open>Finite Sets\<close>
 
 lemma finite_set_fold_singleton[simp]: "Finite_Set.fold f z {x} = f x z"
 proof -
   have "fold_graph f z {x} (f x z)"
     by (auto intro: fold_graph.intros)
   moreover
   {
     fix X y
     have "fold_graph f z X y \<Longrightarrow> (X = {} \<longrightarrow> y = z) \<and> (X = {x} \<longrightarrow> y = f x z)"
       by (induct rule: fold_graph.induct) auto
   }
   ultimately have "(THE y. fold_graph f z {x} y) = f x z"
     by blast
   thus ?thesis
     by (simp add: Finite_Set.fold_def)
 qed
 
 
 subsection \<open>Function Power\<close>
 
 lemma funpow_lesseq_iter:
   fixes f :: "('a::order) \<Rightarrow> 'a"
   assumes mono: "\<And>k. k \<le> f k" and m_le_n: "m \<le> n"
   shows "(f ^^ m) k \<le> (f ^^ n) k"
   using m_le_n by (induct n) (fastforce simp: le_Suc_eq intro: mono order_trans)+
 
 lemma funpow_less_iter:
   fixes f :: "('a::order) \<Rightarrow> 'a"
   assumes mono: "\<And>k. k < f k" and m_lt_n: "m < n"
   shows "(f ^^ m) k < (f ^^ n) k"
   using m_lt_n by (induct n) (auto, blast intro: mono less_trans dest: less_antisym)
 
 
 subsection \<open>Least Operator\<close>
 
 lemma Least_eq[simp]: "(LEAST y. y = x) = x" and "(LEAST y. x = y) = x" for x :: "'a::order"
   by (blast intro: Least_equality)+
 
 lemma Least_in_nonempty_set_imp_ex:
   fixes f :: "'b \<Rightarrow> ('a::wellorder)"
   assumes
     A_nemp: "A \<noteq> {}" and
     P_least: "P (LEAST y. \<exists>x \<in> A. y = f x)"
   shows "\<exists>x \<in> A. P (f x)"
 proof -
   obtain a where a: "a \<in> A"
     using A_nemp by fast
   have "\<exists>x. x \<in> A \<and> (LEAST y. \<exists>x. x \<in> A \<and> y = f x) = f x"
     by (rule LeastI[of _ "f a"]) (fast intro: a)
   thus ?thesis
     by (metis P_least)
 qed
 
 lemma Least_eq_0_enat: "P 0 \<Longrightarrow> (LEAST x :: enat. P x) = 0"
   by (simp add: Least_equality)
 
 
 subsection \<open>Antisymmetric Relations\<close>
 
 lemma irrefl_trans_imp_antisym: "irrefl r \<Longrightarrow> trans r \<Longrightarrow> antisym r"
   unfolding irrefl_def trans_def antisym_def by fast
 
 lemma irreflp_transp_imp_antisymP: "irreflp p \<Longrightarrow> transp p \<Longrightarrow> antisymp p"
   by (fact irrefl_trans_imp_antisym [to_pred])
 
 
 subsection \<open>Acyclic Relations\<close>
 
 lemma finite_nonempty_ex_succ_imp_cyclic:
   assumes
     fin: "finite A" and
     nemp: "A \<noteq> {}" and
     ex_y: "\<forall>x \<in> A. \<exists>y \<in> A. (y, x) \<in> r"
   shows "\<not> acyclic r"
 proof -
   let ?R = "{(x, y). x \<in> A \<and> y \<in> A \<and> (x, y) \<in> r}"
 
   have R_sub_r: "?R \<subseteq> r"
     by auto
 
   have "?R \<subseteq> A \<times> A"
     by auto
   hence fin_R: "finite ?R"
     by (auto intro: fin dest!: infinite_super)
 
   have "\<not> acyclic ?R"
     by (rule notI, drule finite_acyclic_wf[OF fin_R], unfold wf_eq_minimal, drule spec[of _ A],
       use ex_y nemp in blast)
   thus ?thesis
     using R_sub_r acyclic_subset by auto
 qed
 
 
 subsection \<open>Reflexive, Transitive Closure\<close>
 
 lemma relcomp_subset_left_imp_relcomp_trancl_subset_left:
   assumes sub: "R O S \<subseteq> R"
   shows "R O S\<^sup>* \<subseteq> R"
 proof
   fix x
   assume "x \<in> R O S\<^sup>*"
   then obtain n where "x \<in> R O S ^^ n"
     using rtrancl_imp_relpow by fastforce
   thus "x \<in> R"
   proof (induct n)
     case (Suc m)
     thus ?case
       by (metis (no_types) O_assoc inf_sup_ord(3) le_iff_sup relcomp_distrib2 relpow.simps(2)
         relpow_commute sub subsetCE)
   qed auto
 qed
 
 lemma f_chain_in_rtrancl:
   assumes m_le_n: "m \<le> n" and f_chain: "\<forall>i \<in> {m..<n}. (f i, f (Suc i)) \<in> R"
   shows "(f m, f n) \<in> R\<^sup>*"
 proof (rule relpow_imp_rtrancl, rule relpow_fun_conv[THEN iffD2], intro exI conjI)
   let ?g = "\<lambda>i. f (m + i)"
   let ?k = "n - m"
 
   show "?g 0 = f m"
     by simp
   show "?g ?k = f n"
     using m_le_n by force
   show "(\<forall>i < ?k. (?g i, ?g (Suc i)) \<in> R)"
     by (simp add: f_chain)
 qed
 
 lemma f_rev_chain_in_rtrancl:
   assumes m_le_n: "m \<le> n" and f_chain: "\<forall>i \<in> {m..<n}. (f (Suc i), f i) \<in> R"
   shows "(f n, f m) \<in> R\<^sup>*"
   by (rule f_chain_in_rtrancl[OF m_le_n, of "\<lambda>i. f (n + m - i)", simplified])
     (metis f_chain le_add_diff Suc_diff_Suc Suc_leI atLeastLessThan_iff diff_Suc_diff_eq1 diff_less
       le_add1 less_le_trans zero_less_Suc)
 
 
 subsection \<open>Well-Founded Relations\<close>
 
 lemma wf_app: "wf r \<Longrightarrow> wf {(x, y). (f x, f y) \<in> r}"
   unfolding wf_eq_minimal by (intro allI, drule spec[of _ "f ` Q" for Q]) fast
 
 lemma wfP_app: "wfP p \<Longrightarrow> wfP (\<lambda>x y. p (f x) (f y))"
   unfolding wfP_def by (rule wf_app[of "{(x, y). p x y}" f, simplified])
 
 lemma wf_exists_minimal:
   assumes wf: "wf r" and Q: "Q x"
   shows "\<exists>x. Q x \<and> (\<forall>y. (f y, f x) \<in> r \<longrightarrow> \<not> Q y)"
   using wf_eq_minimal[THEN iffD1, OF wf_app[OF wf], rule_format, of _ "{x. Q x}", simplified, OF Q]
   by blast
 
 lemma wfP_exists_minimal:
   assumes wf: "wfP p" and Q: "Q x"
   shows "\<exists>x. Q x \<and> (\<forall>y. p (f y) (f x) \<longrightarrow> \<not> Q y)"
   by (rule wf_exists_minimal[of "{(x, y). p x y}" Q x, OF wf[unfolded wfP_def] Q, simplified])
 
 lemma finite_irrefl_trans_imp_wf: "finite r \<Longrightarrow> irrefl r \<Longrightarrow> trans r \<Longrightarrow> wf r"
   by (erule finite_acyclic_wf) (simp add: acyclic_irrefl)
 
 lemma finite_irreflp_transp_imp_wfp:
   "finite {(x, y). p x y} \<Longrightarrow> irreflp p \<Longrightarrow> transp p \<Longrightarrow> wfP p"
   using finite_irrefl_trans_imp_wf[of "{(x, y). p x y}"]
   unfolding wfP_def transp_def irreflp_def trans_def irrefl_def mem_Collect_eq prod.case
   by assumption
 
 lemma wf_infinite_down_chain_compatible:
   assumes
     wf_R: "wf R" and
     inf_chain_RS: "\<forall>i. (f (Suc i), f i) \<in> R \<union> S" and
     O_subset: "R O S \<subseteq> R"
   shows "\<exists>k. \<forall>i. (f (Suc (i + k)), f (i + k)) \<in> S"
 proof (rule ccontr)
   assume "\<nexists>k. \<forall>i. (f (Suc (i + k)), f (i + k)) \<in> S"
   hence "\<forall>k. \<exists>i. (f (Suc (i + k)), f (i + k)) \<notin> S"
     by blast
   hence "\<forall>k. \<exists>i > k. (f (Suc i), f i) \<notin> S"
     by (metis add.commute add_Suc less_add_Suc1)
   hence "\<forall>k. \<exists>i > k. (f (Suc i), f i) \<in> R"
     using inf_chain_RS by blast
   hence "\<exists>i > k. (f (Suc i), f i) \<in> R \<and> (\<forall>j > k. (f (Suc j), f j) \<in> R \<longrightarrow> j \<ge> i)" for k
     using wf_eq_minimal[THEN iffD1, OF wf_less, rule_format,
       of _ "{i. i > k \<and> (f (Suc i), f i) \<in> R}", simplified]
     by (meson not_less)
   then obtain j_of where
     j_of_gt: "\<And>k. j_of k > k" and
     j_of_in_R: "\<And>k. (f (Suc (j_of k)), f (j_of k)) \<in> R" and
     j_of_min: "\<And>k. \<forall>j > k. (f (Suc j), f j) \<in> R \<longrightarrow> j \<ge> j_of k"
     by moura
 
   have j_of_min_s: "\<And>k j. j > k \<Longrightarrow> j < j_of k \<Longrightarrow> (f (Suc j), f j) \<in> S"
     using j_of_min inf_chain_RS by fastforce
 
   define g :: "nat \<Rightarrow> 'a" where "\<And>k. g k = f (Suc ((j_of ^^ k) 0))"
 
   have between_g[simplified]: "(f ((j_of ^^ (Suc i)) 0), f (Suc ((j_of ^^ i) 0))) \<in> S\<^sup>*" for i
   proof (rule f_rev_chain_in_rtrancl; clarify?)
     show "Suc ((j_of ^^ i) 0) \<le> (j_of ^^ Suc i) 0"
       using j_of_gt by (simp add: Suc_leI)
   next
     fix ia
     assume ia: "ia \<in> {Suc ((j_of ^^ i) 0)..<(j_of ^^ Suc i) 0}"
     have ia_gt: "ia > (j_of ^^ i) 0"
       using ia by auto
     have ia_lt: "ia < j_of ((j_of ^^ i) 0)"
       using ia by auto
     show "(f (Suc ia), f ia) \<in> S"
       by (rule j_of_min_s[OF ia_gt ia_lt])
   qed
 
   have "\<And>i. (g (Suc i), g i) \<in> R"
     unfolding g_def funpow.simps comp_def
     by (rule subsetD[OF relcomp_subset_left_imp_relcomp_trancl_subset_left[OF O_subset]])
       (rule relcompI[OF j_of_in_R between_g])
   moreover have "\<forall>f. \<exists>i. (f (Suc i), f i) \<notin> R"
     using wf_R[unfolded wf_iff_no_infinite_down_chain] by blast
   ultimately show False
     by blast
 qed
 
 
 subsection \<open>Wellorders\<close>
 
 lemma (in wellorder) exists_minimal:
   fixes x :: 'a
   assumes "P x"
   shows "\<exists>x. P x \<and> (\<forall>y. P y \<longrightarrow> y \<ge> x)"
   using assms by (auto intro: LeastI Least_le)
 
 
 subsection \<open>Lists\<close>
 
 lemma rev_induct2[consumes 1, case_names Nil snoc]:
   "length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow>
    (\<And>x xs y ys. length xs = length ys \<Longrightarrow> P xs ys \<Longrightarrow> P (xs @ [x]) (ys @ [y])) \<Longrightarrow> P xs ys"
 proof (induct xs arbitrary: ys rule: rev_induct)
   case (snoc x xs ys)
   thus ?case
     by (induct ys rule: rev_induct) simp_all
 qed auto
 
 lemma hd_in_set: "length xs \<noteq> 0 \<Longrightarrow> hd xs \<in> set xs"
   by (cases xs) auto
 
 lemma in_lists_iff_set: "xs \<in> lists A \<longleftrightarrow> set xs \<subseteq> A"
   by fast
 
 lemma butlast_append_Cons[simp]: "butlast (xs @ y # ys) = xs @ butlast (y # ys)"
   using butlast_append[of xs "y # ys", simplified] by simp
 
 lemma rev_in_lists[simp]: "rev xs \<in> lists A \<longleftrightarrow> xs \<in> lists A"
   by auto
 
 lemma hd_le_sum_list:
   fixes xs :: "'a::ordered_ab_semigroup_monoid_add_imp_le list"
   assumes "xs \<noteq> []" and "\<forall>i < length xs. xs ! i \<ge> 0"
   shows "hd xs \<le> sum_list xs"
   using assms
   by (induct xs rule: rev_induct, simp_all,
     metis add_cancel_right_left add_increasing2 hd_append2 lessI less_SucI list.sel(1) nth_append
       nth_append_length order_refl self_append_conv2 sum_list.Nil)
 
 lemma sum_list_ge_length_times:
   fixes a :: "'a::{ordered_ab_semigroup_add,semiring_1}"
   assumes "\<forall>i < length xs. xs ! i \<ge> a"
   shows "sum_list xs \<ge> of_nat (length xs) * a"
   using assms
 proof (induct xs)
   case (Cons x xs)
   note ih = this(1) and xxs_i_ge_a = this(2)
 
   have xs_i_ge_a: "\<forall>i < length xs. xs ! i \<ge> a"
     using xxs_i_ge_a by auto
 
   have "x \<ge> a"
     using xxs_i_ge_a by auto
   thus ?case
     using ih[OF xs_i_ge_a] by (simp add: ring_distribs ordered_ab_semigroup_add_class.add_mono)
 qed auto
 
 lemma prod_list_nonneg:
   fixes xs :: "('a :: {ordered_semiring_0,linordered_nonzero_semiring}) list"
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> x \<ge> 0"
   shows "prod_list xs \<ge> 0"
   using assms by (induct xs) auto
 
 lemma zip_append_0_upt:
   "zip (xs @ ys) [0..<length xs + length ys] =
    zip xs [0..<length xs] @ zip ys [length xs..<length xs + length ys]"
 proof (induct ys arbitrary: xs)
   case (Cons y ys)
   note ih = this
   show ?case
     using ih[of "xs @ [y]"] by (simp, cases ys, simp, simp add: upt_rec)
 qed auto
 
 lemma zip_eq_butlast_last:
   assumes len_gt0: "length xs > 0" and len_eq: "length xs = length ys"
   shows "zip xs ys = zip (butlast xs) (butlast ys) @ [(last xs, last ys)]"
   using len_eq len_gt0 by (induct rule: list_induct2) auto
 
 
 subsection \<open>Extended Natural Numbers\<close>
 
 lemma the_enat_0[simp]: "the_enat 0 = 0"
   by (simp add: zero_enat_def)
 
 lemma the_enat_1[simp]: "the_enat 1 = 1"
   by (simp add: one_enat_def)
 
 lemma enat_le_minus_1_imp_lt: "m \<le> n - 1 \<Longrightarrow> n \<noteq> \<infinity> \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> m < n" for m n :: enat
   by (cases m; cases n; simp add: zero_enat_def one_enat_def)
 
 lemma enat_diff_diff_eq: "k - m - n = k - (m + n)" for k m n :: enat
   by (cases k; cases m; cases n) auto
 
 lemma enat_sub_add_same[intro]: "n \<le> m \<Longrightarrow> m = m - n + n" for m n :: enat
   by (cases m; cases n) auto
 
 lemma enat_the_enat_iden[simp]: "n \<noteq> \<infinity> \<Longrightarrow> enat (the_enat n) = n"
   by auto
 
 lemma the_enat_minus_nat: "m \<noteq> \<infinity> \<Longrightarrow> the_enat (m - enat n) = the_enat m - n"
   by auto
 
 lemma enat_the_enat_le: "enat (the_enat x) \<le> x"
   by (cases x; simp)
 
 lemma enat_the_enat_minus_le: "enat (the_enat (x - y)) \<le> x"
   by (cases x; cases y; simp)
 
 lemma enat_le_imp_minus_le: "k \<le> m \<Longrightarrow> k - n \<le> m" for k m n :: enat
   by (metis Groups.add_ac(2) enat_diff_diff_eq enat_ord_simps(3) enat_sub_add_same
     enat_the_enat_iden enat_the_enat_minus_le idiff_0_right idiff_infinity idiff_infinity_right
     order_trans_rules(23) plus_enat_simps(3))
 
 lemma add_diff_assoc2_enat: "m \<ge> n \<Longrightarrow> m - n + p = m + p - n" for m n p :: enat
   by (cases m; cases n; cases p; auto)
 
 lemma enat_mult_minus_distrib: "enat x * (y - z) = enat x * y - enat x * z"
   by (cases y; cases z; auto simp: enat_0 right_diff_distrib')
 
 
 subsection \<open>Multisets\<close>
 
 lemma add_mset_lt_left_lt: "a < b \<Longrightarrow> add_mset a A < add_mset b A"
   unfolding less_multiset\<^sub>H\<^sub>O by auto
 
 lemma add_mset_le_left_le: "a \<le> b \<Longrightarrow> add_mset a A \<le> add_mset b A" for a :: "'a :: linorder"
   unfolding less_multiset\<^sub>H\<^sub>O by auto
 
 lemma add_mset_lt_right_lt: "A < B \<Longrightarrow> add_mset a A < add_mset a B"
   unfolding less_multiset\<^sub>H\<^sub>O by auto
 
 lemma add_mset_le_right_le: "A \<le> B \<Longrightarrow> add_mset a A \<le> add_mset a B"
   unfolding less_multiset\<^sub>H\<^sub>O by auto
 
 lemma add_mset_lt_lt_lt:
   assumes a_lt_b: "a < b" and A_le_B: "A < B"
   shows "add_mset a A < add_mset b B"
   by (rule less_trans[OF add_mset_lt_left_lt[OF a_lt_b] add_mset_lt_right_lt[OF A_le_B]])
 
 lemma add_mset_lt_lt_le: "a < b \<Longrightarrow> A \<le> B \<Longrightarrow> add_mset a A < add_mset b B"
   using add_mset_lt_lt_lt le_neq_trans by fastforce
 
 lemma add_mset_lt_le_lt: "a \<le> b \<Longrightarrow> A < B \<Longrightarrow> add_mset a A < add_mset b B" for a :: "'a :: linorder"
   using add_mset_lt_lt_lt by (metis add_mset_lt_right_lt le_less)
 
 lemma add_mset_le_le_le:
   fixes a :: "'a :: linorder"
   assumes a_le_b: "a \<le> b" and A_le_B: "A \<le> B"
   shows "add_mset a A \<le> add_mset b B"
   by (rule order.trans[OF add_mset_le_left_le[OF a_le_b] add_mset_le_right_le[OF A_le_B]])
 
 declare filter_eq_replicate_mset [simp] image_mset_subseteq_mono [intro]
 
 lemma nonempty_subseteq_mset_eq_singleton: "M \<noteq> {#} \<Longrightarrow> M \<subseteq># {#x#} \<Longrightarrow> M = {#x#}"
   by (cases M) (auto dest: subset_mset.diff_add)
 
 lemma nonempty_subseteq_mset_iff_singleton: "(M \<noteq> {#} \<and> M \<subseteq># {#x#} \<and> P) \<longleftrightarrow> M = {#x#} \<and> P"
   by (cases M) (auto dest: subset_mset.diff_add)
 
 lemma count_gt_imp_in_mset[intro]: "count M x > n \<Longrightarrow> x \<in># M"
   using count_greater_zero_iff by fastforce
 
 lemma size_lt_imp_ex_count_lt: "size M < size N \<Longrightarrow> \<exists>x \<in># N. count M x < count N x"
   by (metis count_eq_zero_iff leD not_le_imp_less not_less_zero size_mset_mono subseteq_mset_def)
 
 lemma filter_filter_mset[simp]: "{#x \<in># {#x \<in># M. Q x#}. P x#} = {#x \<in># M. P x \<and> Q x#}"
   by (induct M) auto
 
 lemma size_filter_unsat_elem:
   assumes "x \<in># M" and "\<not> P x"
   shows "size {#x \<in># M. P x#} < size M"
 proof -
   have "size (filter_mset P M) \<noteq> size M"
     using assms by (metis add.right_neutral add_diff_cancel_left' count_filter_mset mem_Collect_eq
       multiset_partition nonempty_has_size set_mset_def size_union)
   then show ?thesis
     by (meson leD nat_neq_iff size_filter_mset_lesseq)
 qed
 
 lemma size_filter_ne_elem: "x \<in># M \<Longrightarrow> size {#y \<in># M. y \<noteq> x#} < size M"
   by (simp add: size_filter_unsat_elem[of x M "\<lambda>y. y \<noteq> x"])
 
 lemma size_eq_ex_count_lt:
   assumes
     sz_m_eq_n: "size M = size N" and
     m_eq_n: "M \<noteq> N"
   shows "\<exists>x. count M x < count N x"
 proof -
   obtain x where "count M x \<noteq> count N x"
     using m_eq_n by (meson multiset_eqI)
   moreover
   {
     assume "count M x < count N x"
     hence ?thesis
       by blast
   }
   moreover
   {
     assume cnt_x: "count M x > count N x"
 
     have "size {#y \<in># M. y = x#} + size {#y \<in># M. y \<noteq> x#} =
       size {#y \<in># N. y = x#} + size {#y \<in># N. y \<noteq> x#}"
       using sz_m_eq_n multiset_partition by (metis size_union)
     hence sz_m_minus_x: "size {#y \<in># M. y \<noteq> x#} < size {#y \<in># N. y \<noteq> x#}"
       using cnt_x by simp
     then obtain y where "count {#y \<in># M. y \<noteq> x#} y < count {#y \<in># N. y \<noteq> x#} y"
       using size_lt_imp_ex_count_lt[OF sz_m_minus_x] by blast
     hence "count M y < count N y"
       by (metis count_filter_mset less_asym)
     hence ?thesis
       by blast
   }
   ultimately show ?thesis
     by fastforce
 qed
 
 lemma count_image_mset_lt_imp_lt_raw:
   assumes
     "finite A" and
     "A = set_mset M \<union> set_mset N" and
     "count (image_mset f M) b < count (image_mset f N) b"
   shows "\<exists>x. f x = b \<and> count M x < count N x"
   using assms
 proof (induct A arbitrary: M N b rule: finite_induct)
   case (insert x F)
   note fin = this(1) and x_ni_f = this(2) and ih = this(3) and x_f_eq_m_n = this(4) and
     cnt_b = this(5)
 
   let ?Ma = "{#y \<in># M. y \<noteq> x#}"
   let ?Mb = "{#y \<in># M. y = x#}"
   let ?Na = "{#y \<in># N. y \<noteq> x#}"
   let ?Nb = "{#y \<in># N. y = x#}"
 
   have m_part: "M = ?Mb + ?Ma" and n_part: "N = ?Nb + ?Na"
     using multiset_partition by blast+
 
   have f_eq_ma_na: "F = set_mset ?Ma \<union> set_mset ?Na"
     using x_f_eq_m_n x_ni_f by auto
 
   show ?case
   proof (cases "count (image_mset f ?Ma) b < count (image_mset f ?Na) b")
     case cnt_ba: True
     obtain xa where "f xa = b" and "count ?Ma xa < count ?Na xa"
       using ih[OF f_eq_ma_na cnt_ba] by blast
     thus ?thesis
       by (metis count_filter_mset not_less0)
   next
     case cnt_ba: False
     have fx_eq_b: "f x = b"
       using cnt_b cnt_ba by (subst (asm) m_part, subst (asm) n_part, auto, presburger)
     moreover have "count M x < count N x"
       using cnt_b cnt_ba by (subst (asm) m_part, subst (asm) n_part, auto simp: fx_eq_b)
     ultimately show ?thesis
       by blast
   qed
 qed auto
 
 lemma count_image_mset_lt_imp_lt:
   assumes cnt_b: "count (image_mset f M) b < count (image_mset f N) b"
   shows "\<exists>x. f x = b \<and> count M x < count N x"
   by (rule count_image_mset_lt_imp_lt_raw[of "set_mset M \<union> set_mset N", OF _ refl cnt_b]) auto
 
 lemma count_image_mset_le_imp_lt_raw:
   assumes
     "finite A" and
     "A = set_mset M \<union> set_mset N" and
     "count (image_mset f M) (f a) + count N a < count (image_mset f N) (f a) + count M a"
   shows "\<exists>b. f b = f a \<and> count M b < count N b"
   using assms
 proof (induct A arbitrary: M N rule: finite_induct)
   case (insert x F)
   note fin = this(1) and x_ni_f = this(2) and ih = this(3) and x_f_eq_m_n = this(4) and
     cnt_lt = this(5)
 
   let ?Ma = "{#y \<in># M. y \<noteq> x#}"
   let ?Mb = "{#y \<in># M. y = x#}"
   let ?Na = "{#y \<in># N. y \<noteq> x#}"
   let ?Nb = "{#y \<in># N. y = x#}"
 
   have m_part: "M = ?Mb + ?Ma" and n_part: "N = ?Nb + ?Na"
     using multiset_partition by blast+
 
   have f_eq_ma_na: "F = set_mset ?Ma \<union> set_mset ?Na"
     using x_f_eq_m_n x_ni_f by auto
 
   show ?case
   proof (cases "f x = f a")
     case fx_ne_fa: False
 
     have cnt_fma_fa: "count (image_mset f ?Ma) (f a) = count (image_mset f M) (f a)"
       using fx_ne_fa by (subst (2) m_part) auto
     have cnt_fna_fa: "count (image_mset f ?Na) (f a) = count (image_mset f N) (f a)"
       using fx_ne_fa by (subst (2) n_part) auto
     have cnt_ma_a: "count ?Ma a = count M a"
       using fx_ne_fa by (subst (2) m_part) auto
     have cnt_na_a: "count ?Na a = count N a"
       using fx_ne_fa by (subst (2) n_part) auto
 
     obtain b where fb_eq_fa: "f b = f a" and cnt_b: "count ?Ma b < count ?Na b"
       using ih[OF f_eq_ma_na] cnt_lt unfolding cnt_fma_fa cnt_fna_fa cnt_ma_a cnt_na_a by blast
     have fx_ne_fb: "f x \<noteq> f b"
       using fb_eq_fa fx_ne_fa by simp
 
     have cnt_ma_b: "count ?Ma b = count M b"
       using fx_ne_fb by (subst (2) m_part) auto
     have cnt_na_b: "count ?Na b = count N b"
       using fx_ne_fb by (subst (2) n_part) auto
 
     show ?thesis
       using fb_eq_fa cnt_b unfolding cnt_ma_b cnt_na_b by blast
   next
     case fx_eq_fa: True
     show ?thesis
     proof (cases "x = a")
       case x_eq_a: True
       have "count (image_mset f ?Ma) (f a) + count ?Na a
         < count (image_mset f ?Na) (f a) + count ?Ma a"
         using cnt_lt x_eq_a by (subst (asm) (1 2) m_part, subst (asm) (1 2) n_part, auto)
       thus ?thesis
         using ih[OF f_eq_ma_na] by (metis count_filter_mset nat_neq_iff)
     next
       case x_ne_a: False
       show ?thesis
       proof (cases "count M x < count N x")
         case True
         thus ?thesis
           using fx_eq_fa by blast
      next
         case False
         hence cnt_x: "count M x \<ge> count N x"
           by fastforce
         have "count M x + count (image_mset f ?Ma) (f a) + count ?Na a
           < count N x + count (image_mset f ?Na) (f a) + count ?Ma a"
           using cnt_lt x_ne_a fx_eq_fa by (subst (asm) (1 2) m_part, subst (asm) (1 2) n_part, auto)
         hence "count (image_mset f ?Ma) (f a) + count ?Na a
           < count (image_mset f ?Na) (f a) + count ?Ma a"
           using cnt_x by linarith
         thus ?thesis
           using ih[OF f_eq_ma_na] by (metis count_filter_mset nat_neq_iff)
       qed
     qed
   qed
 qed auto
 
 lemma count_image_mset_le_imp_lt:
   assumes
     "count (image_mset f M) (f a) \<le> count (image_mset f N) (f a)" and
     "count M a > count N a"
   shows "\<exists>b. f b = f a \<and> count M b < count N b"
   using assms by (auto intro: count_image_mset_le_imp_lt_raw[of "set_mset M \<union> set_mset N"])
 
 lemma Max_in_mset: "M \<noteq> {#} \<Longrightarrow> Max_mset M \<in># M"
   by simp
 
 lemma Max_lt_imp_lt_mset:
   assumes n_nemp: "N \<noteq> {#}" and max: "Max_mset M < Max_mset N" (is "?max_M < ?max_N")
   shows "M < N"
 proof (cases "M = {#}")
   case m_nemp: False
 
   have max_n_in_n: "?max_N \<in># N"
     using n_nemp by simp
   have max_n_nin_m: "?max_N \<notin># M"
     using max Max_ge leD by auto
 
   have "M \<noteq> N"
     using max by auto
   moreover
   {
     fix y
     assume "count N y < count M y"
     hence "y \<in># M"
       by blast
     hence "?max_M \<ge> y"
       by simp
     hence "?max_N > y"
       using max by auto
     hence "\<exists>x > y. count M x < count N x"
       using max_n_nin_m max_n_in_n by fastforce
   }
   ultimately show ?thesis
     unfolding less_multiset\<^sub>H\<^sub>O by blast
 qed (auto simp: n_nemp)
 
 lemma fold_mset_singleton[simp]: "fold_mset f z {#x#} = f x z"
   by (simp add: fold_mset_def)
 
 end
diff --git a/thys/Perron_Frobenius/Perron_Frobenius_Irreducible.thy b/thys/Perron_Frobenius/Perron_Frobenius_Irreducible.thy
--- a/thys/Perron_Frobenius/Perron_Frobenius_Irreducible.thy
+++ b/thys/Perron_Frobenius/Perron_Frobenius_Irreducible.thy
@@ -1,1378 +1,1378 @@
 (* Author: Thiemann *)
 subsection \<open>The Perron Frobenius Theorem for Irreducible Matrices\<close>
 
 theory Perron_Frobenius_Irreducible
 imports
   Perron_Frobenius
   Roots_Unity
   Rank_Nullity_Theorem.Miscellaneous (* for scalar-matrix-multiplication, 
     this import is incompatible with field_simps, ac_simps *)
 begin 
 
 lifting_forget vec.lifting
 lifting_forget mat.lifting
 lifting_forget poly.lifting
 
 lemma charpoly_of_real: "charpoly (map_matrix complex_of_real A) = map_poly of_real (charpoly A)" 
   by (transfer_hma rule: of_real_hom.char_poly_hom)
 
 context includes lifting_syntax
 begin
 lemma HMA_M_smult[transfer_rule]: "((=) ===> HMA_M ===> HMA_M) (\<cdot>\<^sub>m) ((*k))" 
   unfolding smult_mat_def 
   unfolding rel_fun_def HMA_M_def from_hma\<^sub>m_def
   by (auto simp: matrix_scalar_mult_def)
 end
 
 lemma order_charpoly_smult: fixes A :: "complex ^ 'n ^ 'n" 
   assumes k: "k \<noteq> 0" 
   shows "order x (charpoly (k *k A)) = order (x / k) (charpoly A)" 
   by (transfer fixing: k, rule order_char_poly_smult[OF _ k])
 
 (* use field, since the *k-lemmas have been stated for fields *)
 lemma smult_eigen_vector: fixes a :: "'a :: field"  
   assumes "eigen_vector A v x" 
   shows "eigen_vector (a *k A) v (a * x)" 
 proof -
   from assms[unfolded eigen_vector_def] have v: "v \<noteq> 0" and id: "A *v v = x *s v" by auto
   from arg_cong[OF id, of "(*s) a"] have id: "(a *k A) *v v = (a * x) *s v" 
     unfolding scalar_matrix_vector_assoc by simp
   thus "eigen_vector (a *k A) v (a * x)" using v unfolding eigen_vector_def by auto
 qed
 
 lemma smult_eigen_value: fixes a :: "'a :: field"  
   assumes "eigen_value A x" 
   shows "eigen_value (a *k A) (a * x)" 
   using assms smult_eigen_vector[of A _ x a] unfolding eigen_value_def by blast
 
 locale fixed_mat = fixes A :: "'a :: zero ^ 'n ^ 'n"
 begin
 definition G :: "'n rel" where
   "G = { (i,j). A $ i $ j \<noteq> 0}" 
 
 definition irreducible :: bool where
   "irreducible = (UNIV \<subseteq> G^+)" 
 end
 
 lemma G_transpose: 
   "fixed_mat.G (transpose A) = ((fixed_mat.G A))^-1"
   unfolding fixed_mat.G_def by (force simp: transpose_def)
 
 lemma G_transpose_trancl: 
   "(fixed_mat.G (transpose A))^+ = ((fixed_mat.G A)^+)^-1"
   unfolding G_transpose trancl_converse by auto 
 
 locale pf_nonneg_mat = fixed_mat A for 
   A :: "'a :: linordered_idom ^ 'n ^ 'n" + 
   assumes non_neg_mat: "non_neg_mat A"  
 begin 
 lemma nonneg: "A $ i $ j \<ge> 0" 
   using non_neg_mat unfolding non_neg_mat_def elements_mat_h_def by auto
 
 lemma nonneg_matpow: "matpow A n $ i $ j \<ge> 0" 
   by (induct n arbitrary: i j, insert nonneg, 
     auto intro!: sum_nonneg simp: matrix_matrix_mult_def mat_def)
 
 lemma G_relpow_matpow_pos: "(i,j) \<in> G ^^ n \<Longrightarrow> matpow A n $ i $ j > 0" 
 proof (induct n arbitrary: i j)
   case (0 i)
   thus ?case by (auto simp: mat_def)
 next
   case (Suc n i j)
   from Suc(2) have "(i,j) \<in> G ^^ n O G"
     by (simp add: relpow_commute) 
   then obtain k where
     ik: "A $ k $ j \<noteq> 0" and kj: "(i, k) \<in> G ^^ n" by (auto simp: G_def)
   from ik nonneg[of k j] have ik: "A $ k $ j > 0" by auto
   from Suc(1)[OF kj] have IH: "matpow A n $h i $h k > 0" .
   thus ?case using ik by (auto simp: nonneg_matpow nonneg matrix_matrix_mult_def 
     intro!: sum_pos2[of _ k] mult_nonneg_nonneg)
 qed
 
 lemma matpow_mono: assumes B: "\<And> i j. B $ i $ j \<ge> A $ i $ j"
   shows "matpow B n $ i $ j \<ge> matpow A n $ i $ j" 
 proof (induct n arbitrary: i j)
   case (Suc n i j)
   thus ?case using B nonneg_matpow[of n] nonneg 
     by (auto simp: matrix_matrix_mult_def intro!: sum_mono mult_mono')
 qed simp
 
 lemma matpow_sum_one_mono: "matpow (A + mat 1) (n + k) $ i $ j \<ge> matpow (A + mat 1) n $ i $ j" 
 proof (induct k)
   case (Suc k)
   have "(matpow (A + mat 1) (n + k) ** A) $h i $h j \<ge> 0" unfolding matrix_matrix_mult_def
     using order.trans[OF nonneg_matpow matpow_mono[of "A + mat 1" "n + k"]]
     by (auto intro!: sum_nonneg mult_nonneg_nonneg nonneg simp: mat_def)
   thus ?case using Suc by (simp add: matrix_add_ldistrib matrix_mul_rid)
 qed simp
 
 lemma G_relpow_matpow_pos_ge: 
   assumes "(i,j) \<in> G ^^ m" "n \<ge> m"
   shows "matpow (A + mat 1) n $ i $ j > 0" 
 proof -
   from assms(2) obtain k where n: "n = m + k" using le_Suc_ex by blast  
   have "0 < matpow A m $ i $ j" by (rule G_relpow_matpow_pos[OF assms(1)])
   also have "\<dots> \<le> matpow (A + mat 1) m $ i $ j" 
     by (rule matpow_mono, auto simp: mat_def)
   also have "\<dots> \<le> matpow (A + mat 1) n $ i $ j" unfolding n using matpow_sum_one_mono .
   finally show ?thesis .
 qed
 end
 
 locale perron_frobenius = pf_nonneg_mat A 
   for A :: "real ^ 'n ^ 'n" +
   assumes irr: irreducible
 begin
 
 definition N where "N = (SOME N. \<forall> ij. \<exists> n \<le> N. ij \<in> G ^^ n)" 
 
 lemma N: "\<exists> n \<le> N. ij \<in> G ^^ n" 
 proof -
   {
     fix ij
     have "ij \<in> G^+" using irr[unfolded irreducible_def] by auto
     from this[unfolded trancl_power] have "\<exists> n. ij \<in> G ^^ n" by blast
   }
   hence "\<forall> ij. \<exists> n. ij \<in> G ^^ n" by auto
   from choice[OF this] obtain f where f: "\<And> ij. ij \<in> G ^^ (f ij)" by auto
   define N where N: "N = Max (range f)" 
   {
     fix ij
     from f[of ij] have "ij \<in> G ^^ f ij" .
     moreover have "f ij \<le> N" unfolding N
       by (rule Max_ge, auto) 
     ultimately have "\<exists> n \<le> N. ij \<in> G ^^ n" by blast
   } note main = this
   let ?P = "\<lambda> N. \<forall> ij. \<exists> n \<le> N. ij \<in> G ^^ n" 
   from main have "?P N" by blast
   from someI[of ?P, OF this, folded N_def]
   show ?thesis by blast
 qed
 
 lemma irreducible_matpow_pos: assumes irreducible 
   shows "matpow (A + mat 1) N $ i $ j > 0"
 proof -
   from N obtain n where n: "n \<le> N" and reach: "(i,j) \<in> G ^^ n" by auto
   show ?thesis by (rule G_relpow_matpow_pos_ge[OF reach n])
 qed
 
 lemma pf_transpose: "perron_frobenius (transpose A)" 
 proof
   show "fixed_mat.irreducible (transpose A)" 
     unfolding fixed_mat.irreducible_def G_transpose_trancl using irr[unfolded irreducible_def] 
     by auto
 qed (insert nonneg, auto simp: transpose_def non_neg_mat_def elements_mat_h_def)
 
 abbreviation le_vec :: "real ^ 'n \<Rightarrow> real ^ 'n \<Rightarrow> bool" where
   "le_vec x y \<equiv> (\<forall> i. x $ i \<le> y $ i)" 
 
 abbreviation lt_vec :: "real ^ 'n \<Rightarrow> real ^ 'n \<Rightarrow> bool" where
   "lt_vec x y \<equiv> (\<forall> i. x $ i < y $ i)" 
 
 definition "A1n = matpow (A + mat 1) N" 
 
 lemmas A1n_pos = irreducible_matpow_pos[OF irr, folded A1n_def]
 
 definition r :: "real ^ 'n \<Rightarrow> real" where
   "r x = Min { (A *v x) $ j / x $ j | j. x $ j \<noteq> 0 }" 
 
 definition X :: "(real ^ 'n )set" where
   "X = { x . le_vec 0 x \<and> x \<noteq> 0 }" 
 
 lemma nonneg_Ax: "x \<in> X \<Longrightarrow> le_vec 0 (A *v x)" 
   unfolding X_def using nonneg
   by (auto simp: matrix_vector_mult_def intro!: sum_nonneg)
 
 lemma A_nonzero_fixed_i: "\<exists> j. A $ i $ j \<noteq> 0" 
 proof -
   from irr[unfolded irreducible_def] have "(i,i) \<in> G^+" by auto
   then obtain j where "(i,j) \<in> G" by (metis converse_tranclE)
   hence Aij: "A $ i $ j \<noteq> 0" unfolding G_def by auto
   thus ?thesis ..
 qed
 
 lemma A_nonzero_fixed_j: "\<exists> i. A $ i $ j \<noteq> 0" 
 proof -
   from irr[unfolded irreducible_def] have "(j,j) \<in> G^+" by auto
   then obtain i where "(i,j) \<in> G" by (cases, auto)
   hence Aij: "A $ i $ j \<noteq> 0" unfolding G_def by auto
   thus ?thesis ..
 qed
 
 lemma Ax_pos: assumes x: "lt_vec 0 x" 
   shows "lt_vec 0 (A *v x)" 
 proof 
   fix i
   from A_nonzero_fixed_i[of i] obtain j where "A $ i $ j \<noteq> 0" by auto
   with nonneg[of i j] have A: "A $ i $ j > 0" by simp
   from x have "x $ j \<ge> 0" for j by (auto simp: order.strict_iff_order)
   note nonneg = mult_nonneg_nonneg[OF nonneg[of i] this]
   have "(A *v x) $ i = (\<Sum>j\<in>UNIV. A $ i $ j * x $ j)" 
     unfolding matrix_vector_mult_def by simp
   also have "\<dots> = A $ i $ j * x $ j + (\<Sum>j\<in>UNIV - {j}. A $ i $ j * x $ j)" 
     by (subst sum.remove, auto)
   also have "\<dots> > 0 + 0" 
     by (rule add_less_le_mono, insert A x[rule_format] nonneg,
     auto intro!: sum_nonneg mult_pos_pos)
   finally show "0 $ i < (A *v x) $ i" by simp
 qed
   
 
 lemma nonzero_Ax: assumes x: "x \<in> X"
   shows "A *v x \<noteq> 0" 
 proof 
   assume 0: "A *v x = 0" 
   from x[unfolded X_def] have x: "le_vec 0 x" "x \<noteq> 0" by auto
   from x(2) obtain j where xj: "x $ j \<noteq> 0"
     by (metis vec_eq_iff zero_index)
   from A_nonzero_fixed_j[of j]  obtain i where Aij: "A $ i $ j \<noteq> 0" by auto
   from arg_cong[OF 0, of "\<lambda> v. v $ i", unfolded matrix_vector_mult_def]
   have "0 = (\<Sum> k \<in> UNIV. A $h i $h k * x $h k)" by auto
   also have "\<dots> = A $h i $h j * x $h j + (\<Sum> k \<in> UNIV - {j}. A $h i $h k * x $h k)" 
     by (subst sum.remove[of _ j], auto)
   also have "\<dots> > 0 + 0" 
     by (rule add_less_le_mono, insert nonneg[of i] Aij x(1) xj, 
     auto intro!: sum_nonneg mult_pos_pos simp: dual_order.not_eq_order_implies_strict) 
   finally show False by simp
 qed
 
 lemma r_witness: assumes x: "x \<in> X" 
   shows "\<exists> j. x $ j > 0 \<and> r x = (A *v x) $ j / x $ j"
 proof -
   from x[unfolded X_def] have x: "le_vec 0 x" "x \<noteq> 0" by auto
   let ?A = "{ (A *v x) $ j / x $ j | j. x $ j \<noteq> 0 }" 
   from x(2) obtain j where "x $ j \<noteq> 0"
     by (metis vec_eq_iff zero_index)
   hence empty: "?A \<noteq> {}" by auto
   from Min_in[OF _ this, folded r_def]
   obtain j where "x $ j \<noteq> 0" and rx: "r x = (A *v x) $ j / x $ j" by auto
   with x have "x $ j > 0" by (auto simp: dual_order.not_eq_order_implies_strict)
   with rx show ?thesis by auto
 qed
 
 lemma rx_nonneg: assumes x: "x \<in> X"
   shows "r x \<ge> 0"
 proof -
   from x[unfolded X_def] have x: "le_vec 0 x" "x \<noteq> 0" by auto
   let ?A = "{ (A *v x) $ j / x $ j | j. x $ j \<noteq> 0 }" 
   from r_witness[OF \<open>x \<in> X\<close>]
   have empty: "?A \<noteq> {}" by force
   show ?thesis unfolding r_def X_def
   proof (subst Min_ge_iff, force, use empty in force, intro ballI) 
     fix y
     assume "y \<in> ?A" 
     then obtain j where "y = (A *v x) $ j / x $ j" and "x $ j \<noteq> 0" by auto
     from nonneg_Ax[OF \<open>x \<in> X\<close>] this x
     show "0 \<le> y" by simp
   qed
 qed
 
 lemma rx_pos: assumes x: "lt_vec 0 x"
   shows "r x > 0"
 proof -
   from Ax_pos[OF x] have lt: "lt_vec 0 (A *v x)" .
   from x have x': "x \<in> X" unfolding X_def order.strict_iff_order by auto
   let ?A = "{ (A *v x) $ j / x $ j | j. x $ j \<noteq> 0 }" 
   from r_witness[OF \<open>x \<in> X\<close>]
   have empty: "?A \<noteq> {}" by force
   show ?thesis unfolding r_def X_def
   proof (subst Min_gr_iff, force, use empty in force, intro ballI) 
     fix y
     assume "y \<in> ?A" 
     then obtain j where "y = (A *v x) $ j / x $ j" and "x $ j \<noteq> 0" by auto
     from lt this x show "0 < y" by simp
   qed
 qed
 
 lemma rx_le_Ax: assumes x: "x \<in> X" 
   shows "le_vec (r x *s x) (A *v x)" 
 proof (intro allI)
   fix i
   show "(r x *s x) $h i \<le> (A *v x) $h i" 
   proof (cases "x $ i = 0")
     case True
     with nonneg_Ax[OF x] show ?thesis by auto
   next
     case False
     with x[unfolded X_def] have pos: "x $ i > 0" 
       by (auto simp: dual_order.not_eq_order_implies_strict)
     from False have "(A *v x) $h i / x $ i \<in> { (A *v x) $ j / x $ j | j. x $ j \<noteq> 0 }" by auto
     hence "(A *v x) $h i / x $ i \<ge> r x" unfolding r_def by simp
     hence "x $ i * r x \<le> x $ i * ((A *v x) $h i / x $ i)" unfolding mult_le_cancel_left_pos[OF pos] .
     also have "\<dots> = (A *v x) $h i" using pos by simp
     finally show ?thesis by (simp add: ac_simps)
   qed
 qed
 
 lemma rho_le_x_Ax_imp_rho_le_rx: assumes x: "x \<in> X"
   and \<rho>: "le_vec (\<rho> *s x) (A *v x)"
 shows "\<rho> \<le> r x" 
 proof -
   from r_witness[OF x] obtain j where 
     rx: "r x = (A *v x) $ j / x $ j" and xj: "x $ j > 0" "x $ j \<ge> 0" by auto
   from divide_right_mono[OF \<rho>[rule_format, of j] xj(2)]
   show ?thesis unfolding rx using xj by simp 
 qed
 
 lemma rx_Max: assumes x: "x \<in> X"
   shows "r x = Sup { \<rho> . le_vec (\<rho> *s x) (A *v x) }" (is "_ = Sup ?S")
 proof -
   have "r x \<in> ?S" using rx_le_Ax[OF x] by auto
   moreover {
     fix y
     assume "y \<in> ?S"
     hence y: "le_vec (y *s x) (A *v x)" by auto
     from rho_le_x_Ax_imp_rho_le_rx[OF x this]
     have "y \<le> r x" . 
   }
   ultimately show ?thesis by (metis (mono_tags, lifting) cSup_eq_maximum)
 qed
 
 lemma r_smult: assumes x: "x \<in> X" 
   and a: "a > 0" 
 shows "r (a *s x) = r x" 
   unfolding r_def
   by (rule arg_cong[of _ _ Min], unfold vector_smult_distrib, insert a, simp)
 
 definition "X1 = (X \<inter> {x. norm x = 1})" 
 
 lemma bounded_X1: "bounded X1" unfolding bounded_iff X1_def by auto
 
 lemma closed_X1: "closed X1"
 proof -
   have X1: "X1 = {x. le_vec 0 x \<and> norm x = 1}" 
     unfolding X1_def X_def by auto
   show ?thesis unfolding X1
     by (intro closed_Collect_conj closed_Collect_all  closed_Collect_le closed_Collect_eq,
       auto intro: continuous_intros)
 qed
 
 lemma compact_X1: "compact X1" using bounded_X1 closed_X1
   by (simp add: compact_eq_bounded_closed)
 
 definition "pow_A_1 x = A1n *v x" 
 
 
 
 lemma continuous_pow_A_1: "continuous_on R pow_A_1"
   unfolding pow_A_1_def continuous_on
   by (auto intro: tendsto_intros)
 
 definition "Y = pow_A_1 ` X1" 
 
 lemma compact_Y: "compact Y" 
   unfolding Y_def using compact_X1 continuous_pow_A_1[of X1] 
   by (metis compact_continuous_image)
 
 lemma Y_pos_main: assumes y: "y \<in> pow_A_1 ` X" 
   shows "y $ i > 0" 
 proof -
   from y obtain x where x: "x \<in> X" and y: "y = pow_A_1 x" unfolding Y_def X1_def by auto
   from r_witness[OF x] obtain j where xj: "x $ j > 0" by auto
   from x[unfolded X_def] have xi: "x $ i \<ge> 0" for i by auto
   have nonneg: "0 \<le> A1n $ i $ k * x $ k" for k using A1n_pos[of i k] xi[of k] by auto 
   have "y $ i = (\<Sum>j\<in>UNIV. A1n $ i $ j * x $ j)" 
     unfolding y pow_A_1_def matrix_vector_mult_def by simp
   also have "\<dots> = A1n $ i $ j * x $ j + (\<Sum>j\<in>UNIV - {j}. A1n $ i $ j * x $ j)" 
     by (subst sum.remove, auto)
   also have "\<dots> > 0 + 0" 
     by (rule add_less_le_mono, insert xj A1n_pos nonneg, 
     auto intro!: sum_nonneg mult_pos_pos simp: dual_order.not_eq_order_implies_strict)
   finally show ?thesis by simp
 qed
 
 lemma Y_pos: assumes y: "y \<in> Y" 
   shows "y $ i > 0" 
   using Y_pos_main[of y i] y unfolding Y_def X1_def by auto
 
 lemma Y_nonzero: assumes y: "y \<in> Y" 
   shows "y $ i \<noteq> 0" 
   using Y_pos[OF y, of i] by auto
 
 definition r' :: "real ^ 'n \<Rightarrow> real" where
   "r' x = Min (range (\<lambda> j. (A *v x) $ j / x $ j))" 
 
 lemma r'_r: assumes x: "x \<in> Y" shows "r' x = r x" 
   unfolding r'_def r_def
 proof (rule arg_cong[of _ _ Min])
   have "range (\<lambda>j. (A *v x) $ j / x $ j) \<subseteq> {(A *v x) $ j / x $ j |j. x $ j \<noteq> 0}" (is "?L \<subseteq> ?R")
   proof 
     fix y
     assume "y \<in> ?L" 
     then obtain j where "y = (A *v x) $ j / x $ j" by auto
     with Y_pos[OF x, of j] show "y \<in> ?R" by auto
   qed
   moreover have "?L \<supseteq> ?R" by auto
   ultimately show "?L = ?R" by blast
 qed  
 
 lemma continuous_Y_r: "continuous_on Y r"
 proof -
   have *: "(\<forall> y \<in> Y. P y (r y)) = (\<forall> y \<in> Y. P y (r' y))" for P using r'_r by auto
   have "continuous_on Y r = continuous_on Y r'" 
     by (rule continuous_on_cong[OF refl r'_r[symmetric]])
   also have \<dots>
     unfolding continuous_on r'_def using Y_nonzero
     by (auto intro!: tendsto_Min tendsto_intros)
   finally show ?thesis .
 qed
  
 lemma X1_nonempty: "X1 \<noteq> {}" 
 proof -
   define x where "x = ((\<chi> i. if i = undefined then 1 else 0) :: real ^ 'n)" 
   {
     assume "x = 0" 
     from arg_cong[OF this, of "\<lambda> x. x $ undefined"] have False unfolding x_def by auto
   }
   hence x: "x \<noteq> 0" by auto
   moreover have "le_vec 0 x" unfolding x_def by auto
   moreover have "norm x = 1" unfolding norm_vec_def L2_set_def
     by (auto, subst sum.remove[of _ undefined], auto simp: x_def)
   ultimately show ?thesis unfolding X1_def X_def by auto
 qed
 
 lemma Y_nonempty: "Y \<noteq> {}" 
   unfolding Y_def using X1_nonempty by auto
 
 definition z where "z = (SOME z. z \<in> Y \<and> (\<forall> y \<in> Y. r y \<le> r z))" 
 
 abbreviation "sr \<equiv> r z"
 
 lemma z: "z \<in> Y" and sr_max_Y: "\<And> y. y \<in> Y \<Longrightarrow> r y \<le> sr" 
 proof -
   let ?P = "\<lambda> z. z \<in> Y \<and> (\<forall> y \<in> Y. r y \<le> r z)" 
   from continuous_attains_sup[OF compact_Y Y_nonempty continuous_Y_r]
   obtain y where "?P y" by blast
   from someI[of ?P, OF this, folded z_def]
   show "z \<in> Y" "\<And> y. y \<in> Y \<Longrightarrow> r y \<le> r z" by blast+
 qed
 
 lemma Y_subset_X: "Y \<subseteq> X" 
 proof
   fix y
   assume "y \<in> Y" 
   from Y_pos[OF this] show "y \<in> X" unfolding X_def 
     by (auto simp: order.strict_iff_order) 
 qed
 
 lemma zX: "z \<in> X" 
   using z(1) Y_subset_X by auto
 
 lemma le_vec_mono_left: assumes B: "\<And> i j. B $ i $ j \<ge> 0" 
   and "le_vec x y" 
 shows "le_vec (B *v x) (B *v y)" 
 proof (intro allI)
   fix i
   show "(B *v x) $ i \<le> (B *v y) $ i" unfolding matrix_vector_mult_def using B[of i] assms(2)
     by (auto intro!: sum_mono mult_left_mono)
 qed  
 
 
 lemma matpow_1_commute: "matpow (A + mat 1) n ** A = A ** matpow (A + mat 1) n" 
   by (induct n, auto simp: matrix_add_rdistrib matrix_add_ldistrib matrix_mul_rid matrix_mul_lid
   matrix_mul_assoc[symmetric])
 
 lemma A1n_commute: "A1n ** A = A ** A1n" 
   unfolding A1n_def by (rule matpow_1_commute)
 
 lemma le_vec_pow_A_1: assumes le: "le_vec (rho *s x) (A *v x)" 
   shows "le_vec (rho *s pow_A_1 x) (A *v pow_A_1 x)" 
 proof -
   have "A1n $ i $ j \<ge> 0" for i j using A1n_pos[of i j] by auto
   from le_vec_mono_left[OF this le]
   have "le_vec (A1n *v (rho *s x)) (A1n *v (A *v x))" .
   also have "A1n *v (A *v x) = (A1n ** A) *v x" by (simp add: matrix_vector_mul_assoc)
   also have "\<dots> = A *v (A1n *v x)" unfolding A1n_commute by (simp add: matrix_vector_mul_assoc)
   also have "\<dots> = A *v (pow_A_1 x)" unfolding pow_A_1_def ..
   also have "A1n *v (rho *s x) = rho *s (A1n *v x)" unfolding vector_smult_distrib ..
   also have "\<dots> = rho *s pow_A_1 x" unfolding pow_A_1_def ..
   finally show "le_vec (rho *s pow_A_1 x) (A *v pow_A_1 x)" .
 qed
 
 lemma r_pow_A_1: assumes x: "x \<in> X"
   shows "r x \<le> r (pow_A_1 x)" 
 proof -
   let ?y = "pow_A_1 x" 
   have "?y \<in> pow_A_1 ` X" using x by auto
   from Y_pos_main[OF this] 
   have y: "?y \<in> X" unfolding X_def by (auto simp: order.strict_iff_order) 
   let ?A = "{\<rho>. le_vec (\<rho> *s x) (A *v x)}" 
   let ?B = "{\<rho>. le_vec (\<rho> *s pow_A_1 x) (A *v pow_A_1 x)}" 
   show ?thesis unfolding rx_Max[OF x] rx_Max[OF y]
   proof (rule cSup_mono)
     show "bdd_above ?B" using rho_le_x_Ax_imp_rho_le_rx[OF y] by fast
     show "?A \<noteq> {}" using rx_le_Ax[OF x] by auto 
     fix rho
     assume "rho \<in> ?A"
     hence "le_vec (rho *s x) (A *v x)" by auto
     from le_vec_pow_A_1[OF this] have "rho \<in> ?B" by auto
     thus "\<exists> rho' \<in> ?B. rho \<le> rho'" by auto
   qed
 qed
 
 lemma sr_max: assumes x: "x \<in> X" 
   shows "r x \<le> sr" 
 proof -
   let ?n = "norm x" 
   define x' where "x' = inverse ?n *s x" 
   from x[unfolded X_def] have x0: "x \<noteq> 0" by auto
   hence n: "?n > 0" by auto
   have x': "x' \<in> X1" "x' \<in> X" using x n unfolding X1_def X_def x'_def by (auto simp: norm_smult)
   have id: "r x = r x'" unfolding x'_def 
     by (rule sym, rule r_smult[OF x], insert n, auto)
   define y where "y = pow_A_1 x'" 
   from x' have y: "y \<in> Y" unfolding Y_def y_def by auto
   note id
   also have "r x' \<le> r y" using r_pow_A_1[OF x'(2)] unfolding y_def .
   also have "\<dots> \<le> r z" using sr_max_Y[OF y] .
   finally show "r x \<le> r z" .
 qed
 
 lemma z_pos: "z $ i > 0" 
   using Y_pos[OF z(1)] by auto
 
 lemma sr_pos: "sr > 0"
   by (rule rx_pos, insert z_pos, auto)
 
 context fixes u
   assumes u: "u \<in> X" and ru: "r u = sr" 
 begin
 
 lemma sr_imp_eigen_vector_main: "sr *s u = A *v u" 
 proof (rule ccontr)
   assume *: "sr *s u \<noteq> A *v u" 
   let ?x = "A *v u - sr *s u" 
   from * have 0: "?x \<noteq> 0" by auto
   let ?y = "pow_A_1 u" 
   have "le_vec (sr *s u) (A *v u)" using rx_le_Ax[OF u] unfolding ru .
   hence le: "le_vec 0 ?x" by auto
   from 0 le have x: "?x \<in> X" unfolding X_def by auto
   have y_pos: "lt_vec 0 ?y" using Y_pos_main[of ?y] u by auto
   hence y: "?y \<in> X" unfolding X_def by (auto simp: order.strict_iff_order)  
   from Y_pos_main[of "pow_A_1 ?x"] x 
   have "lt_vec 0 (pow_A_1 ?x)" by auto
   hence lt: "lt_vec (sr *s ?y) (A *v ?y)" unfolding pow_A_1_def matrix_vector_right_distrib_diff
     matrix_vector_mul_assoc A1n_commute vector_smult_distrib by simp
   let ?f = "(\<lambda> i. (A *v ?y - sr *s ?y) $ i / ?y $ i)" 
   let ?U = "UNIV :: 'n set"
   define eps where "eps = Min (?f ` ?U)" 
   have U: "finite (?f ` ?U)" "?f ` ?U \<noteq> {}" by auto
   have eps: "eps > 0" unfolding eps_def Min_gr_iff[OF U]
     using lt sr_pos y_pos by auto
   have le: "le_vec ((sr + eps) *s ?y) (A *v ?y)"
   proof 
     fix i
     have "((sr + eps) *s ?y) $ i = sr * ?y $ i + eps * ?y $ i"
       by (simp add: comm_semiring_class.distrib)
     also have "\<dots> \<le> sr * ?y $ i + ?f i * ?y $ i" 
     proof (rule add_left_mono[OF mult_right_mono])
       show "0 \<le> ?y $ i" using y_pos[rule_format, of i] by auto
       show "eps \<le> ?f i" unfolding eps_def by (rule Min_le, auto) 
     qed
     also have "\<dots> = (A *v ?y) $ i" using sr_pos y_pos[rule_format, of i] 
       by simp
     finally  
     show "((sr + eps) *s ?y) $ i \<le> (A *v ?y) $ i" .
   qed
   from rho_le_x_Ax_imp_rho_le_rx[OF y le]
   have "r ?y \<ge> sr + eps" .
   with sr_max[OF y] eps show False by auto
 qed
 
 lemma sr_imp_eigen_vector: "eigen_vector A u sr" 
   unfolding eigen_vector_def sr_imp_eigen_vector_main using u unfolding X_def by auto
 
 lemma sr_u_pos: "lt_vec 0 u" 
 proof -
   let ?y = "pow_A_1 u" 
   define n where "n = N" 
   define c where "c = (sr + 1)^N" 
   have c: "c > 0" using sr_pos unfolding c_def by auto
   have "lt_vec 0 ?y" using Y_pos_main[of ?y] u by auto
   also have "?y = A1n *v u" unfolding pow_A_1_def ..
   also have "\<dots> = c *s u" unfolding c_def A1n_def n_def[symmetric]
   proof (induct n)
     case (Suc n)
     then show ?case
       by (simp add: matrix_vector_mul_assoc[symmetric] algebra_simps vec.scale
           sr_imp_eigen_vector_main[symmetric])
   qed auto
   finally have lt: "lt_vec 0 (c *s u)" .
   have "0 < u $ i" for i using lt[rule_format, of i] c by simp (metis zero_less_mult_pos)
   thus "lt_vec 0 u" by simp
 qed
 end
 
 lemma eigen_vector_z_sr: "eigen_vector A z sr" 
   using sr_imp_eigen_vector[OF zX refl] by auto
 
 lemma eigen_value_sr: "eigen_value A sr" 
   using eigen_vector_z_sr unfolding eigen_value_def by auto
 
 abbreviation "c \<equiv> complex_of_real" 
 abbreviation "cA \<equiv> map_matrix c A" 
 abbreviation "norm_v \<equiv> map_vector (norm :: complex \<Rightarrow> real)" 
 
 lemma norm_v_ge_0: "le_vec 0 (norm_v v)" by (auto simp: map_vector_def)
 lemma norm_v_eq_0: "norm_v v = 0 \<longleftrightarrow> v = 0" by (auto simp: map_vector_def vec_eq_iff)
 
 lemma cA_index: "cA $ i $ j = c (A $ i $ j)" 
   unfolding map_matrix_def map_vector_def by simp
 
 lemma norm_cA[simp]: "norm (cA $ i $ j) = A $ i $ j" 
   using nonneg[of i j] by (simp add: cA_index)
 
 context fixes \<alpha> v
   assumes ev: "eigen_vector cA v \<alpha>" 
 begin
 
 lemma evD: "\<alpha> *s v = cA *v v" "v \<noteq> 0" 
   using ev[unfolded eigen_vector_def] by auto
 
 lemma ev_alpha_norm_v: "norm_v (\<alpha> *s v) = (norm \<alpha> *s norm_v v)" 
   by (auto simp: map_vector_def norm_mult vec_eq_iff)
 
 lemma ev_A_norm_v: "norm_v (cA *v v) $ j \<le> (A *v norm_v v) $ j" 
 proof -
   have "norm_v (cA *v v) $ j = norm (\<Sum>i\<in>UNIV. cA $ j $ i * v $ i)" 
     unfolding map_vector_def by (simp add: matrix_vector_mult_def)
   also have "\<dots> \<le> (\<Sum>i\<in>UNIV. norm (cA $ j $ i * v $ i))" by (rule norm_sum)
   also have "\<dots> = (\<Sum>i\<in>UNIV. A $ j $ i * norm_v v $ i)" 
     by (rule sum.cong[OF refl], auto simp: norm_mult map_vector_def)
   also have "\<dots> = (A *v norm_v v) $ j" by (simp add: matrix_vector_mult_def)
   finally show ?thesis .
 qed
 
 lemma ev_le_vec: "le_vec (norm \<alpha> *s norm_v v) (A *v norm_v v)" 
   using arg_cong[OF evD(1), of norm_v, unfolded ev_alpha_norm_v] ev_A_norm_v by auto
 
 lemma norm_v_X: "norm_v v \<in> X" 
   using norm_v_ge_0[of v] evD(2) norm_v_eq_0[of v] unfolding X_def by auto
 
 lemma ev_inequalities: "norm \<alpha> \<le> r (norm_v v)" "r (norm_v v) \<le> sr"
 proof -
   have v: "norm_v v \<in> X" by (rule norm_v_X)
   from rho_le_x_Ax_imp_rho_le_rx[OF v ev_le_vec] 
   show "norm \<alpha> \<le> r (norm_v v)" .
   from sr_max[OF v]
   show "r (norm_v v) \<le> sr" .
 qed
 
 lemma eigen_vector_norm_sr: "norm \<alpha> \<le> sr" using ev_inequalities by auto
 end
 
 lemma eigen_value_norm_sr: assumes "eigen_value cA \<alpha>" 
   shows "norm \<alpha> \<le> sr" 
   using eigen_vector_norm_sr[of _ \<alpha>] assms unfolding eigen_value_def by auto
 
 
 lemma le_vec_trans: "le_vec x y \<Longrightarrow> le_vec y u \<Longrightarrow> le_vec x u" 
   using order.trans[of "x $ i" "y $ i" "u $ i" for i] by auto
 
 lemma eigen_vector_z_sr_c: "eigen_vector cA (map_vector c z) (c sr)" 
   unfolding of_real_hom.eigen_vector_hom by (rule eigen_vector_z_sr)
 
 lemma eigen_value_sr_c: "eigen_value cA (c sr)" 
   using eigen_vector_z_sr_c unfolding eigen_value_def by auto
 
 definition "w = perron_frobenius.z (transpose A)" 
 
 lemma w: "transpose A *v w = sr *s w" "lt_vec 0 w" "perron_frobenius.sr (transpose A) = sr"
 proof -
   interpret t: perron_frobenius "transpose A" 
     by (rule pf_transpose)
   from eigen_vector_z_sr_c t.eigen_vector_z_sr_c 
   have ev: "eigen_value cA (c sr)" "eigen_value t.cA (c t.sr)" 
     unfolding eigen_value_def by auto
   {
     fix x
     have "eigen_value (t.cA) x = eigen_value (transpose cA) x" 
       unfolding map_matrix_def map_vector_def transpose_def 
       by (auto simp: vec_eq_iff)
     also have "\<dots> = eigen_value cA x" by (rule eigen_value_transpose)
     finally have "eigen_value (t.cA) x = eigen_value cA x" .
   } note ev_id = this
   with ev have ev: "eigen_value t.cA (c sr)" "eigen_value cA (c t.sr)" by auto
   from eigen_value_norm_sr[OF ev(2)] t.eigen_value_norm_sr[OF ev(1)] 
   show id: "t.sr = sr" by auto
   from t.eigen_vector_z_sr[unfolded id, folded w_def] show "transpose A *v w = sr *s w" 
     unfolding eigen_vector_def by auto
   from t.z_pos[folded w_def] show "lt_vec 0 w" by auto
 qed
 
 lemma c_cmod_id: "a \<in> \<real> \<Longrightarrow> Re a \<ge> 0 \<Longrightarrow> c (cmod a) = a" by (auto simp: Reals_def)
 
 lemma pos_rowvector_mult_0: assumes lt: "lt_vec 0 x" 
   and 0: "(rowvector x :: real ^ 'n ^ 'n) *v y = 0" (is "?x *v _ = 0") and le: "le_vec 0 y" 
 shows "y = 0" 
 proof -
   {
     fix i
     assume "y $ i \<noteq> 0" 
     with le have yi: "y $ i > 0" by (auto simp: order.strict_iff_order)
     have "0 = (?x *v y) $ i" unfolding 0 by simp
     also have "\<dots> = (\<Sum>j\<in>UNIV. x $ j * y $ j)" 
       unfolding rowvector_def matrix_vector_mult_def by simp
     also have "\<dots> > 0" 
       by (rule sum_pos2[of _ i], insert yi lt le, auto intro!: mult_nonneg_nonneg 
         simp: order.strict_iff_order)
     finally have False by simp
   }
   thus ?thesis by (auto simp: vec_eq_iff)
 qed
 
 lemma pos_matrix_mult_0: assumes le: "\<And> i j. B $ i $ j \<ge> 0" 
   and lt: "lt_vec 0 x" 
   and 0: "B *v x = 0" 
 shows "B = 0" 
 proof -
   {
     fix i j
     assume "B $ i $ j \<noteq> 0" 
     with le have gt: "B $ i $ j > 0" by (auto simp: order.strict_iff_order)
     have "0 = (B *v x) $ i" unfolding 0 by simp
     also have "\<dots> = (\<Sum>j\<in>UNIV. B $ i $ j * x $ j)" 
       unfolding matrix_vector_mult_def by simp
     also have "\<dots> > 0" 
       by (rule sum_pos2[of _ j], insert gt lt le, auto intro!: mult_nonneg_nonneg 
         simp: order.strict_iff_order)
     finally have False by simp
   }
   thus "B = 0" unfolding vec_eq_iff by auto
 qed
 
 lemma eigen_value_smaller_matrix: assumes B: "\<And> i j. 0 \<le> B $ i $ j \<and> B $ i $ j \<le> A $ i $ j"
   and AB: "A \<noteq> B" 
   and ev: "eigen_value (map_matrix c B) sigma"
 shows "cmod sigma < sr" 
 proof -  
   let ?B = "map_matrix c B" 
   let ?sr = "spectral_radius ?B" 
   define \<sigma> where "\<sigma> = ?sr" 
   have "real_non_neg_mat ?B" unfolding real_non_neg_mat_def elements_mat_h_def
     by (auto simp: map_matrix_def map_vector_def B)
   from perron_frobenius[OF this, folded \<sigma>_def] obtain x where ev_sr: "eigen_vector ?B x (c \<sigma>)" 
     and rnn: "real_non_neg_vec x" by auto  
   define y where "y = norm_v x" 
   from rnn have xy: "x = map_vector c y" 
     unfolding real_non_neg_vec_def vec_elements_h_def y_def
     by (auto simp: map_vector_def vec_eq_iff c_cmod_id)
   from spectral_radius_max[OF ev, folded \<sigma>_def] have sigma_sigma: "cmod sigma \<le> \<sigma>" .
   from ev_sr[unfolded xy of_real_hom.eigen_vector_hom] 
   have ev_B: "eigen_vector B y \<sigma>" .
   from ev_B[unfolded eigen_vector_def] have ev_B': "B *v y = \<sigma> *s y" by auto
   have ypos: "y $ i \<ge> 0" for i unfolding y_def by (auto simp: map_vector_def)
   from ev_B this have y: "y \<in> X" unfolding eigen_vector_def X_def by auto
   
   have BA: "(B *v y) $ i \<le> (A *v y) $ i" for i
     unfolding matrix_vector_mult_def vec_lambda_beta
     by (rule sum_mono, rule mult_right_mono, insert B ypos, auto)  
   hence le_vec: "le_vec (\<sigma> *s y) (A *v y)" unfolding ev_B' by auto
   from rho_le_x_Ax_imp_rho_le_rx[OF y le_vec] 
   have "\<sigma> \<le> r y" by auto
   also have "\<dots> \<le> sr" using y by (rule sr_max)
   finally have sig_le_sr: "\<sigma> \<le> sr" .
   {
     assume "\<sigma> = sr" 
     hence r_sr: "r y = sr" and sr_sig: "sr = \<sigma>" using \<open>\<sigma> \<le> r y\<close> \<open>r y \<le> sr\<close> by auto
     from sr_u_pos[OF y r_sr] have pos: "lt_vec 0 y" .
     from sr_imp_eigen_vector[OF y r_sr] have ev': "eigen_vector A y sr" .
     have "(A - B) *v y = A *v y - B *v y" unfolding matrix_vector_mult_def
       by (auto simp: vec_eq_iff field_simps sum_subtractf) 
     also have "A *v y = sr *s y" using ev'[unfolded eigen_vector_def] by auto
     also have "B *v y = sr *s y" unfolding ev_B' sr_sig ..
     finally have id: "(A - B) *v y = 0" by simp
     from pos_matrix_mult_0[OF _ pos id] assms(1-2) have False by auto
   }
   with sig_le_sr sigma_sigma show ?thesis by argo
 qed
 
 lemma charpoly_erase_mat_sr: "0 < poly (charpoly (erase_mat A i i)) sr" 
 proof -
   let ?A = "erase_mat A i i" 
   let ?pos = "poly (charpoly ?A) sr" 
   {
     from A_nonzero_fixed_j[of i] obtain k where "A $ k $ i \<noteq> 0" by auto
     assume "A = ?A" 
     hence "A $ k $ i = ?A $ k $ i" by simp
     also have "?A $ k $ i = 0" by (auto simp: erase_mat_def)
     also have "A $ k $ i \<noteq> 0" by fact
     finally have False by simp
   }
   hence AA: "A \<noteq> ?A" by auto
   have le: "0 \<le> ?A $ i $ j \<and> ?A $ i $ j \<le> A $ i $ j" for i j
     by (auto simp: erase_mat_def nonneg)
   note ev_small = eigen_value_smaller_matrix[OF le AA]  
   {
     fix rho :: real
     assume "eigen_value ?A rho" 
     hence ev: "eigen_value (map_matrix c ?A) (c rho)" 
       unfolding eigen_value_def using of_real_hom.eigen_vector_hom[of ?A _ rho] by auto
     from ev_small[OF this] have "abs rho < sr" by auto
   } note ev_small_real = this
   have pos0: "?pos \<noteq> 0" 
     using ev_small_real[of sr] by (auto simp: eigen_value_root_charpoly)
   {
     define p where "p = charpoly ?A"
     assume pos: "?pos < 0" 
     hence neg: "poly p sr < 0" unfolding p_def by auto
     from degree_monic_charpoly[of ?A] have mon: "monic p" and deg: "degree p \<noteq> 0" unfolding p_def by auto
     let ?f = "poly p" 
     have cont: "continuous_on {a..b} ?f" for a b by (auto intro: continuous_intros)
     from pos have le: "?f sr \<le> 0" by (auto simp: p_def)
     from mon have lc: "lead_coeff p > 0" by auto
     from poly_pinfty_ge[OF this deg, of 0] obtain z where lez: "\<And> x. z \<le> x \<Longrightarrow> 0 \<le> ?f x" by auto
     define y where "y = max z sr" 
     have yr: "y \<ge> sr" and "y \<ge> z" unfolding y_def by auto
     from lez[OF this(2)] have y0: "?f y \<ge> 0" .
     from IVT'[of ?f, OF le y0 yr cont] obtain x where ge: "x \<ge> sr" and rt: "?f x = 0" 
       unfolding p_def by auto
     hence "eigen_value ?A x" unfolding p_def by (simp add: eigen_value_root_charpoly)
     from ev_small_real[OF this] ge have False by auto
   }
   with pos0 show ?thesis by argo
 qed
 
 lemma multiplicity_sr_1: "order sr (charpoly A) = 1" 
 proof -
   {
     assume "poly (pderiv (charpoly A)) sr = 0" 
     hence "0 = poly (monom 1 1 * pderiv (charpoly A)) sr" by simp
     also have "\<dots> = sum (\<lambda> i. poly (charpoly (erase_mat A i i)) sr) UNIV" 
       unfolding pderiv_char_poly_erase_mat poly_sum ..
     also have "\<dots> > 0" 
       by (rule sum_pos, (force simp: charpoly_erase_mat_sr)+)
     finally have False by simp
   } 
   hence nZ: "poly (pderiv (charpoly A)) sr \<noteq> 0" and nZ': "pderiv (charpoly A) \<noteq> 0" by auto
   from eigen_vector_z_sr have "eigen_value A sr" unfolding eigen_value_def ..
   from this[unfolded eigen_value_root_charpoly]
   have "poly (charpoly A) sr = 0" .
   hence "order sr (charpoly A) \<noteq> 0" unfolding order_root using nZ' by auto
   from order_pderiv[OF nZ' this] order_0I[OF nZ]
   show ?thesis by simp
 qed
 
 lemma sr_spectral_radius: "sr = spectral_radius cA" 
 proof -
   from eigen_vector_z_sr_c have "eigen_value cA (c sr)" 
     unfolding eigen_value_def by auto
   from spectral_radius_max[OF this] 
   have sr: "sr \<le> spectral_radius cA" by auto
   with spectral_radius_ev[of cA] eigen_vector_norm_sr
   show ?thesis by force
 qed
 
 lemma le_vec_A_mu: assumes y: "y \<in> X" and le: "le_vec (A *v y) (mu *s y)" 
   shows "sr \<le> mu" "lt_vec 0 y" 
   "mu = sr \<or> A *v y = mu *s y \<Longrightarrow> mu = sr \<and> A *v y = mu *s y" 
 proof -
   let ?w = "rowvector w" 
   let ?w' = "columnvector w" 
   have "?w ** A = transpose (transpose (?w ** A))" 
     unfolding transpose_transpose by simp
   also have "transpose (?w ** A) = transpose A ** transpose ?w" 
     by (rule matrix_transpose_mul)
   also have "transpose ?w = columnvector w" by (rule transpose_rowvector)
   also have "transpose A ** \<dots> = columnvector (transpose A *v w)" 
     unfolding dot_rowvector_columnvector[symmetric] ..
   also have "transpose A *v w = sr *s w" unfolding w by simp
   also have "transpose (columnvector \<dots>) = rowvector (sr *s w)"
     unfolding transpose_def columnvector_def rowvector_def vector_scalar_mult_def by auto
   finally have 1: "?w ** A = rowvector (sr *s w)" .
   have "sr *s (?w *v y) = ?w ** A *v y" unfolding 1
     by (auto simp: rowvector_def vector_scalar_mult_def matrix_vector_mult_def vec_eq_iff
        sum_distrib_left mult.assoc)
   also have "\<dots> = ?w *v (A *v y)" by (simp add: matrix_vector_mul_assoc)
   finally have eq1: "sr *s (rowvector w *v y) = rowvector w *v (A *v y)" .
   have "le_vec (rowvector w *v (A *v y)) (?w *v (mu *s y))" 
     by (rule le_vec_mono_left[OF _ le], insert w(2), auto simp: rowvector_def order.strict_iff_order)
   also have "?w *v (mu *s y) = mu *s (?w *v y)" by (simp add: algebra_simps vec.scale)
   finally have le1: "le_vec (rowvector w *v (A *v y)) (mu *s (?w *v y))" .
   from le1[unfolded eq1[symmetric]] 
   have 2: "le_vec (sr *s (?w *v y)) (mu *s (?w *v y))" .
   {
     from y obtain i where yi: "y $ i > 0" and y: "\<And> j. y $ j \<ge> 0" unfolding X_def
       by (auto simp: order.strict_iff_order vec_eq_iff)
     from w(2) have wi: "w $ i > 0" and w: "\<And> j. w $ j \<ge> 0"
       by (auto simp: order.strict_iff_order)
     have "(?w *v y) $ i > 0" using yi y wi w
       by (auto simp: matrix_vector_mult_def rowvector_def 
         intro!: sum_pos2[of _ i] mult_nonneg_nonneg)
     moreover from 2[rule_format, of i] have "sr * (?w *v y) $ i \<le> mu * (?w *v y) $ i" by simp
     ultimately have "sr \<le> mu" by simp
   } 
   thus *: "sr \<le> mu" .
   define cc where "cc = (mu + 1)^ N" 
   define n where "n = N" 
   from * sr_pos have mu: "mu \<ge> 0" "mu > 0" by auto
   hence cc: "cc > 0" unfolding cc_def by simp  
   from y have "pow_A_1 y \<in> pow_A_1 ` X" by auto
   from Y_pos_main[OF this] have lt: "0 < (A1n *v y) $ i" for i by (simp add: pow_A_1_def)
   have le: "le_vec (A1n *v y) (cc *s y)" unfolding cc_def A1n_def n_def[symmetric]
   proof (induct n)
     case (Suc n)
     let ?An = "matpow (A + mat 1) n" 
     let ?mu = "(mu + 1)" 
     have id': "matpow (A + mat 1) (Suc n) *v y = A *v (?An *v y) + ?An *v y" (is "?a = ?b + ?c")
       by (simp add: matrix_add_ldistrib matrix_mul_rid matrix_add_vect_distrib matpow_1_commute
        matrix_vector_mul_assoc[symmetric])
     have "le_vec ?b (?mu^n *s (A *v y))" 
       using le_vec_mono_left[OF nonneg Suc] by (simp add: algebra_simps vec.scale)
     moreover have "le_vec (?mu^n *s (A *v y)) (?mu^n *s (mu *s y))" 
       using le mu by auto
     moreover have id: "?mu^n *s (mu *s y) = (?mu^n * mu) *s y" by simp
     from le_vec_trans[OF calculation[unfolded id]] 
     have le1: "le_vec ?b ((?mu^n * mu) *s y)" . 
     from Suc have le2: "le_vec ?c ((mu + 1) ^ n *s y)" .
     have le: "le_vec ?a ((?mu^n * mu) *s y + ?mu^n *s y)" 
       unfolding id' using add_mono[OF le1[rule_format] le2[rule_format]] by auto
     have id'': "(?mu^n * mu) *s y + ?mu^n *s y = ?mu^Suc n *s y" by (simp add: algebra_simps)
     show ?case using le unfolding id'' .
   qed (simp add: matrix_vector_mul_lid)
   have lt: "0 < cc * y $ i" for i using lt[of i] le[rule_format, of i] by auto
   have "y $ i > 0" for i using lt[of i] cc by (rule zero_less_mult_pos)
   thus "lt_vec 0 y" by auto
   assume **: "mu = sr \<or> A *v y = mu *s y" 
   {
     assume "A *v y = mu *s y" 
     with y have "eigen_vector A y mu" unfolding X_def eigen_vector_def by auto
     hence "eigen_vector cA (map_vector c y) (c mu)" unfolding of_real_hom.eigen_vector_hom .
     from eigen_vector_norm_sr[OF this] * have "mu = sr" by auto
   }
   with ** have mu_sr: "mu = sr" by auto
   from eq1[folded vector_smult_distrib]
   have 0: "?w *v (sr *s y - A *v y) = 0"
     unfolding matrix_vector_right_distrib_diff by simp
   have le0: "le_vec 0 (sr *s y - A *v y)" using assms(2)[unfolded mu_sr] by auto
   have "sr *s y - A *v y = 0" using pos_rowvector_mult_0[OF w(2) 0 le0] .
   hence ev_y: "A *v y = sr *s y" by auto
   show "mu = sr \<and> A *v y = mu *s y" using ev_y mu_sr by auto
 qed
 
 lemma nonnegative_eigenvector_has_ev_sr: assumes "eigen_vector A v mu" and le: "le_vec 0 v" 
   shows "mu = sr" 
 proof -
   from assms(1)[unfolded eigen_vector_def] have v: "v \<noteq> 0" and ev: "A *v v = mu *s v" by auto
   from le v have v: "v \<in> X" unfolding X_def by auto
   from ev have "le_vec (A *v v) (mu *s v)" by auto
   from le_vec_A_mu[OF v this] ev show ?thesis by auto
 qed
 
 lemma similar_matrix_rotation: assumes ev: "eigen_value cA \<alpha>" and \<alpha>: "cmod \<alpha> = sr"
-  shows "similar_matrix (cis (arg \<alpha>) *k cA) cA" 
+  shows "similar_matrix (cis (Arg \<alpha>) *k cA) cA" 
 proof -
   from ev obtain y where ev: "eigen_vector cA y \<alpha>" unfolding eigen_value_def by auto
   let ?y = "norm_v y"
   note maps = map_vector_def map_matrix_def
   define yp where "yp = norm_v y" 
   let ?yp = "map_vector c yp" 
   have yp: "yp \<in> X" unfolding yp_def by (rule norm_v_X[OF ev])
   from ev[unfolded eigen_vector_def] have ev_y: "cA *v y = \<alpha> *s y" by auto
   from ev_le_vec[OF ev, unfolded \<alpha>, folded yp_def]
   have 1: "le_vec (sr *s yp) (A *v yp)" by simp
   from rho_le_x_Ax_imp_rho_le_rx[OF yp 1] have "sr \<le> r yp" by auto
   with ev_inequalities[OF ev, folded yp_def]
   have 2: "r yp = sr" by auto
   have ev_yp: "A *v yp = sr *s yp" 
     and pos_yp: "lt_vec 0 yp" 
     using sr_imp_eigen_vector_main[OF yp 2] sr_u_pos[OF yp 2] by auto
-  define D where "D = diagvector (\<lambda> j. cis (arg (y $ j)))" 
-  define inv_D where "inv_D = diagvector (\<lambda> j. cis (- arg (y $ j)))" 
+  define D where "D = diagvector (\<lambda> j. cis (Arg (y $ j)))" 
+  define inv_D where "inv_D = diagvector (\<lambda> j. cis (- Arg (y $ j)))" 
   have DD: "inv_D ** D = mat 1" "D ** inv_D = mat 1" unfolding D_def inv_D_def 
     by (auto simp add: diagvector_eq_mat cis_mult)
   {
     fix i
-    have "(D *v ?yp) $ i = cis (arg (y $ i)) * c (cmod (y $ i))" 
+    have "(D *v ?yp) $ i = cis (Arg (y $ i)) * c (cmod (y $ i))" 
       unfolding D_def yp_def by (simp add: maps) 
     also have "\<dots> = y $ i" by (simp add: cis_mult_cmod_id)
     also note calculation
   }
   hence y_D_yp: "y = D *v ?yp" by (auto simp: vec_eq_iff)
-  define \<phi> where "\<phi> = arg \<alpha>" 
+  define \<phi> where "\<phi> = Arg \<alpha>" 
   let ?\<phi> = "cis (- \<phi>)" 
   have [simp]: "cis (- \<phi>) * rcis sr \<phi> = sr" unfolding cis_rcis_eq rcis_mult by simp
-  have \<alpha>: "\<alpha> = rcis sr \<phi>" unfolding \<phi>_def \<alpha>[symmetric] rcis_cmod_arg ..
+  have \<alpha>: "\<alpha> = rcis sr \<phi>" unfolding \<phi>_def \<alpha>[symmetric] rcis_cmod_Arg ..
   define F where "F = ?\<phi> *k (inv_D ** cA ** D)" 
   have "cA *v (D *v ?yp) = \<alpha> *s y" unfolding y_D_yp[symmetric] ev_y by simp
   also have "inv_D *v \<dots> = \<alpha> *s ?yp" 
     unfolding vector_smult_distrib y_D_yp matrix_vector_mul_assoc DD matrix_vector_mul_lid ..
   also have "?\<phi> *s \<dots> = sr *s ?yp" unfolding \<alpha> by simp
   also have "\<dots> = map_vector c (sr *s yp)" unfolding vec_eq_iff by (auto simp: maps)
   also have "\<dots> = cA *v ?yp" unfolding ev_yp[symmetric] by (auto simp: maps matrix_vector_mult_def)
   finally have F: "F *v ?yp = cA *v ?yp" unfolding F_def matrix_scalar_vector_ac[symmetric]
     unfolding matrix_vector_mul_assoc[symmetric] vector_smult_distrib .
-  have prod: "inv_D ** cA ** D = (\<chi> i j. cis (- arg (y $ i)) * cA $ i $ j * cis (arg (y $ j)))" 
+  have prod: "inv_D ** cA ** D = (\<chi> i j. cis (- Arg (y $ i)) * cA $ i $ j * cis (Arg (y $ j)))" 
     unfolding inv_D_def D_def diagvector_mult_right diagvector_mult_left by simp
   {
     fix i j
-    have "cmod (F $ i $ j) = cmod (?\<phi> * cA $h i $h j * (cis (- arg (y $h i)) * cis (arg (y $h j))))" 
+    have "cmod (F $ i $ j) = cmod (?\<phi> * cA $h i $h j * (cis (- Arg (y $h i)) * cis (Arg (y $h j))))" 
       unfolding F_def prod vec_lambda_beta matrix_scalar_mult_def
       by (simp only: ac_simps)
     also have "\<dots> = A $ i $ j" unfolding cis_mult unfolding norm_mult by simp
     also note calculation
   }
   hence FA: "map_matrix norm F = A" unfolding maps by auto
   let ?F = "map_matrix c (map_matrix norm F)" 
   let ?G = "?F - F" 
   let ?Re = "map_matrix Re" 
   from F[folded FA] have 0: "?G *v ?yp = 0" unfolding matrix_diff_vect_distrib by simp
   have "?Re ?G *v yp = map_vector Re (?G *v ?yp)" 
     unfolding maps matrix_vector_mult_def vec_lambda_beta Re_sum by auto
   also have "\<dots> = 0" unfolding 0 by (simp add: vec_eq_iff maps)
   finally have 0: "?Re ?G *v yp = 0" .
   have "?Re ?G = 0" 
     by (rule pos_matrix_mult_0[OF _ pos_yp 0], auto simp: maps complex_Re_le_cmod)
   hence "?F = F" by (auto simp: maps vec_eq_iff cmod_eq_Re)
   with FA have AF: "cA = F" by simp
   from arg_cong[OF this, of "\<lambda> A. cis \<phi> *k A"]
   have sim: "cis \<phi> *k cA = inv_D ** cA ** D" unfolding F_def matrix.scale_scale cis_mult
     by simp
   have "similar_matrix (cis \<phi> *k cA) cA" unfolding similar_matrix_def similar_matrix_wit_def
      sim
     by (rule exI[of _ inv_D], rule exI[of _ D], auto simp: DD)
   thus ?thesis unfolding \<phi>_def .
 qed
 
 lemma assumes ev: "eigen_value cA \<alpha>" and \<alpha>: "cmod \<alpha> = sr"
   shows maximal_eigen_value_order_1: "order \<alpha> (charpoly cA) = 1" 
-    and maximal_eigen_value_rotation: "eigen_value cA (x * cis (arg \<alpha>)) = eigen_value cA x"
-      "eigen_value cA (x / cis (arg \<alpha>)) = eigen_value cA x"
+    and maximal_eigen_value_rotation: "eigen_value cA (x * cis (Arg \<alpha>)) = eigen_value cA x"
+      "eigen_value cA (x / cis (Arg \<alpha>)) = eigen_value cA x"
 proof -
-  let ?a = "cis (arg \<alpha>)" 
+  let ?a = "cis (Arg \<alpha>)" 
   let ?p = "charpoly cA" 
   from similar_matrix_rotation[OF ev \<alpha>]
   have "similar_matrix (?a *k cA) cA" .
   from similar_matrix_charpoly[OF this] 
   have id: "charpoly (?a *k cA) = ?p" .
   have a: "?a \<noteq> 0" by simp
   from order_charpoly_smult[OF this, of _ cA, unfolded id]
   have order_neg: "order x ?p = order (x / ?a) ?p" for x .
   have order_pos: "order x ?p = order (x * ?a) ?p" for x 
     using order_neg[symmetric, of "x * ?a"] by simp
   note order_neg[of \<alpha>]
   also have id: "\<alpha> / ?a = sr" unfolding \<alpha>[symmetric]
     by (metis a cis_mult_cmod_id nonzero_mult_div_cancel_left)
   also have sr: "order \<dots> ?p = 1" unfolding multiplicity_sr_1[symmetric] charpoly_of_real
     by (rule map_poly_inj_idom_divide_hom.order_hom, unfold_locales)
   finally show *: "order \<alpha> ?p = 1" .
   show "eigen_value cA (x * ?a) = eigen_value cA x" using order_pos 
     unfolding eigen_value_root_charpoly order_root by auto
   show "eigen_value cA (x / ?a) = eigen_value cA x" using order_neg
     unfolding eigen_value_root_charpoly order_root by auto
 qed
 
 lemma maximal_eigen_values_group: assumes M: "M = {ev :: complex. eigen_value cA ev \<and> cmod ev = sr}"
   and a: "rcis sr \<alpha> \<in> M" 
   and b: "rcis sr \<beta> \<in> M" 
 shows "rcis sr (\<alpha> + \<beta>) \<in> M" "rcis sr (\<alpha> - \<beta>) \<in> M" "rcis sr 0 \<in> M" 
 proof -
   {
     fix a
     assume *: "rcis sr a \<in> M" 
-    have id: "cis (arg (rcis sr a)) = cis a"
+    have id: "cis (Arg (rcis sr a)) = cis a"
       by (smt * M mem_Collect_eq nonzero_mult_div_cancel_left of_real_eq_0_iff 
-         rcis_cmod_arg rcis_def sr_pos) 
+         rcis_cmod_Arg rcis_def sr_pos) 
     from *[unfolded assms] have "eigen_value cA (rcis sr a)" "cmod (rcis sr a) = sr" by auto
     from maximal_eigen_value_rotation[OF this, unfolded id]
     have "eigen_value cA (x * cis a) = eigen_value cA x" 
       "eigen_value cA (x / cis a) = eigen_value cA x" for x by auto
   } note * = this
   from *(1)[OF b, of "rcis sr \<alpha>"] a show "rcis sr (\<alpha> + \<beta>) \<in> M" unfolding M by auto
   from *(2)[OF a, of "rcis sr \<alpha>"] a show "rcis sr 0 \<in> M" unfolding M by auto
   from *(2)[OF b, of "rcis sr \<alpha>"] a show "rcis sr (\<alpha> - \<beta>) \<in> M" unfolding M by auto
 qed 
 
 lemma maximal_eigen_value_roots_of_unity_rotation: 
   assumes M: "M = {ev :: complex. eigen_value cA ev \<and> cmod ev = sr}" 
    and kM: "k = card M" 
  shows "k \<noteq> 0" 
     "k \<le> CARD('n)"
     "\<exists> f. charpoly A = (monom 1 k - [:sr^k:]) * f 
        \<and> (\<forall> x. poly (map_poly c f) x = 0 \<longrightarrow> cmod x < sr)"
     "M = (*) (c sr) ` (\<lambda> i. (cis (of_nat i * 2 * pi / k))) ` {0 ..< k}"
     "M = (*) (c sr) ` { x :: complex. x ^ k = 1}"
     "(*) (cis (2 * pi / k)) ` Spectrum cA = Spectrum cA"
   unfolding kM
 proof -
   let ?M = "card M" 
   note fin = finite_spectrum[of cA]  
   note char = degree_monic_charpoly[of cA]
   have "?M \<le> card (Collect (eigen_value cA))" 
     by (rule card_mono[OF fin], unfold M, auto)
   also have "Collect (eigen_value cA) = {x. poly (charpoly cA) x = 0}" 
     unfolding eigen_value_root_charpoly by auto
   also have "card \<dots> \<le> degree (charpoly cA)" 
     by (rule poly_roots_degree, insert char, auto)
   also have "\<dots> = CARD('n)" using char by simp
   finally show "?M \<le> CARD ('n)" .
   from finite_subset[OF _ fin, of M] 
   have finM: "finite M" unfolding M by blast
   from finite_distinct_list[OF this]
   obtain m where Mm: "M = set m" and dist: "distinct m" by auto
   from Mm dist have card: "?M = length m" by (auto simp: distinct_card)
   have sr: "sr \<in> set m" using eigen_value_sr_c sr_pos unfolding Mm[symmetric] M by auto
-  define s where "s = sort_key arg m" 
-  define a where "a = map arg s" 
+  define s where "s = sort_key Arg m" 
+  define a where "a = map Arg s" 
   let ?k = "length a" 
   from dist Mm card sr have s: "M = set s" "distinct s"  "sr \<in> set s" 
     and card: "?M = ?k"
     and sorted: "sorted a" 
     unfolding s_def a_def by auto
   have map_s: "map ((*) (c sr)) (map cis a) = s" unfolding map_map o_def a_def
   proof (rule map_idI)
     fix x
     assume "x \<in> set s" 
     from this[folded s(1), unfolded M] 
     have id: "cmod x = sr" by auto
-    show "sr * cis (arg x) = x" 
-      by (subst (5) rcis_cmod_arg[symmetric], unfold id[symmetric] rcis_def, simp)
+    show "sr * cis (Arg x) = x" 
+      by (subst (5) rcis_cmod_Arg[symmetric], unfold id[symmetric] rcis_def, simp)
   qed
   from s(2)[folded map_s, unfolded distinct_map] have a: "distinct a" "inj_on cis (set a)" by auto
   from s(3) obtain aa a' where a_split: "a = aa # a'" unfolding a_def by (cases s, auto)
-  from arg_bounded have bounded: "x \<in> set a \<Longrightarrow> - pi < x \<and> x \<le> pi" for x unfolding a_def by auto
+  from Arg_bounded have bounded: "x \<in> set a \<Longrightarrow> - pi < x \<and> x \<le> pi" for x unfolding a_def by auto
   from bounded[of aa, unfolded a_split] have aa: "- pi < aa \<and> aa \<le> pi" by auto
   let ?aa = "aa + 2 * pi" 
   define args where "args = a @ [?aa]" 
   let ?diff = "\<lambda> i. args ! Suc i - args ! i" 
   have bnd: "x \<in> set a \<Longrightarrow> x < ?aa" for x using aa bounded[of x] by auto
   hence aa_a: "?aa \<notin> set a" by fast
   have sorted: "sorted args" unfolding args_def using sorted unfolding sorted_append
     by (insert bnd, auto simp: order.strict_iff_order)
   have dist: "distinct args" using a aa_a unfolding args_def distinct_append by auto
   have sum: "(\<Sum> i < ?k. ?diff i) = 2 * pi" 
     unfolding sum_lessThan_telescope args_def a_split by simp
   have k: "?k \<noteq> 0" unfolding a_split by auto
   let ?A = "?diff ` {..< ?k}" 
   let ?Min = "Min ?A" 
   define Min where "Min = ?Min" 
   have "?Min = (?k * ?Min) / ?k" using k by auto
   also have "?k * ?Min = (\<Sum> i < ?k. ?Min)" by auto
   also have "\<dots> / ?k \<le> (\<Sum> i < ?k. ?diff i) / ?k" 
     by (rule divide_right_mono[OF sum_mono[OF Min_le]], auto)
   also have "\<dots> = 2 * pi / ?k" unfolding sum ..
   finally have Min: "Min \<le> 2 * pi / ?k" unfolding Min_def by auto
   have lt: "i < ?k \<Longrightarrow> args ! i < args ! (Suc i)" for i 
     using sorted[unfolded sorted_iff_nth_mono, rule_format, of i "Suc i"]
     dist[unfolded distinct_conv_nth, rule_format, of "Suc i" i] by (auto simp: args_def)
   let ?c = "\<lambda> i. rcis sr (args ! i)" 
   have hda[simp]: "hd a = aa" unfolding a_split by simp  
   have Min0: "Min > 0" using lt unfolding Min_def by (subst Min_gr_iff, insert k, auto)
   have Min_A: "Min \<in> ?A" unfolding Min_def by (rule Min_in, insert k, auto)
   {
     fix i :: nat
     assume i: "i < length args" 
     hence "?c i = rcis sr ((a @ [hd a]) ! i)" 
       by (cases "i = ?k", auto simp: args_def nth_append rcis_def)
     also have "\<dots> \<in> set (map (rcis sr) (a @ [hd a]))" using i 
       unfolding args_def set_map unfolding set_conv_nth by auto
     also have "\<dots> = rcis sr ` set a" unfolding a_split by auto
     also have "\<dots> = M" unfolding s(1) map_s[symmetric] set_map image_image
       by (rule image_cong[OF refl], auto simp: rcis_def)
     finally have "?c i \<in> M" by auto
   } note ciM = this
   {
     fix i :: nat
     assume i: "i < ?k" 
     hence "i < length args" "Suc i < length args" unfolding args_def by auto
     from maximal_eigen_values_group[OF M ciM[OF this(2)] ciM[OF this(1)]]
     have "rcis sr (?diff i) \<in> M" by simp
   }
   hence Min_M: "rcis sr Min \<in> M" using Min_A by force  
   have rcisM: "rcis sr (of_nat n * Min) \<in> M" for n
   proof (induct n)
     case 0
     show ?case using sr Mm by auto
   next
     case (Suc n)    
     have *: "rcis sr (of_nat (Suc n) * Min) = rcis sr (of_nat n * Min) * cis Min" 
       by (simp add: rcis_mult ring_distribs add.commute)
     from maximal_eigen_values_group(1)[OF M Suc Min_M]
     show ?case unfolding * by simp
   qed
   let ?list = "map (rcis sr) (map (\<lambda> i. of_nat i * Min) [0 ..< ?k])" 
   define list where "list = ?list" 
   have len: "length ?list = ?M" unfolding card by simp
   from sr_pos have sr0: "sr \<noteq> 0" by auto
   {
     fix i
     assume i: "i < ?k" 
     hence *: "0 \<le> real i * Min" using Min0 by auto
     from i have "real i < real ?k" by auto
     from mult_strict_right_mono[OF this Min0]
     have "real i * Min < real ?k * Min" by simp
     also have "\<dots> \<le> real ?k * (2 * pi / real ?k)" 
       by (rule mult_left_mono[OF Min], auto)
     also have "\<dots> = 2 * pi" using k by simp
     finally have "real i * Min < 2 * pi" .
     note * this
   } note prod_pi = this
   have dist: "distinct ?list"
     unfolding distinct_map[of "rcis sr"] 
   proof (rule conjI[OF _ inj_on_subset[OF rcis_inj_on[OF sr0]]])
     show "distinct (map (\<lambda> i. of_nat i * Min) [0 ..< ?k])" using Min0
       by (auto simp: distinct_map inj_on_def)
     show "set (map (\<lambda>i. real i * Min) [0..<?k]) \<subseteq> {0..<2 * pi}" using prod_pi
       by auto
   qed
   with len have card': "card (set ?list) = ?M" using distinct_card by fastforce
   have listM: "set ?list \<subseteq> M" using rcisM by auto
   from card_subset_eq[OF finM listM card']
   have M_list: "M = set ?list" ..
   let ?piM = "2 * pi / ?M" 
   {
     assume "Min \<noteq> ?piM" 
     with Min have lt: "Min < 2 * pi / ?k" unfolding card by simp
     from k have "0 < real ?k" by auto
     from mult_strict_left_mono[OF lt this] k Min0
     have k: "0 \<le> ?k * Min" "?k * Min < 2 * pi" by auto
     from rcisM[of ?k, unfolded M_list] have "rcis sr (?k * Min) \<in> set ?list" by auto
     then obtain i where i: "i < ?k" and id: "rcis sr (?k * Min) = rcis sr (i * Min)" by auto
     from inj_onD[OF inj_on_subset[OF rcis_inj_on[OF sr0], of "{?k * Min, i * Min}"] id] 
       prod_pi[OF i] k
     have "?k * Min = i * Min" by auto
     with Min0 i have False by auto
   }
   hence Min: "Min = ?piM" by auto
   show cM: "?M \<noteq> 0" unfolding card using k by auto
   let ?f = "(\<lambda> i. cis (of_nat i * 2 * pi / ?M))" 
   note M_list
   also have "set ?list = (*) (c sr) ` (\<lambda> i. cis (of_nat i * Min)) ` {0 ..< ?k}" 
     unfolding set_map image_image 
     by (rule image_cong, insert sr_pos, auto simp: rcis_mult rcis_def)
   finally show M_cis: "M = (*) (c sr) ` ?f ` {0 ..< ?M}" 
     unfolding card Min by (simp add: mult.assoc)
   thus M_pow: "M = (*) (c sr) ` { x :: complex. x ^ ?M = 1}" using roots_of_unity[OF cM] by simp
   let ?rphi = "rcis sr (2 * pi / ?M)" 
   let ?phi = "cis (2 * pi / ?M)" 
   from Min_M[unfolded Min] 
   have ev: "eigen_value cA ?rphi" unfolding M by auto
   have cm: "cmod ?rphi = sr" using sr_pos by simp
-  have id: "cis (arg ?rphi) = cis (arg ?phi) * cmod ?phi" 
+  have id: "cis (Arg ?rphi) = cis (Arg ?phi) * cmod ?phi" 
     unfolding arg_rcis_cis[OF sr_pos] by simp
   also have "\<dots> = ?phi" unfolding cis_mult_cmod_id ..
-  finally have id: "cis (arg ?rphi) = ?phi" .
+  finally have id: "cis (Arg ?rphi) = ?phi" .
   define phi where "phi = ?phi" 
   have phi: "phi \<noteq> 0" unfolding phi_def by auto
   note max = maximal_eigen_value_rotation[OF ev cm, unfolded id phi_def[symmetric]]
   have "((*) phi) ` Spectrum cA = Spectrum cA" (is "?L = ?R")
   proof -
     {
       fix x
       have *: "x \<in> ?L \<Longrightarrow> x \<in> ?R" for x using max(2)[of x] phi unfolding Spectrum_def by auto
       moreover
       {
         assume "x \<in> ?R" 
         hence "eigen_value cA x" unfolding Spectrum_def by auto
         from this[folded max(2)[of x]] have "x / phi \<in> ?R" unfolding Spectrum_def by auto      
         from imageI[OF this, of "(*) phi"]
         have "x \<in> ?L" using phi by auto
       }
       note this *
     }
     thus ?thesis by blast
   qed
   from this[unfolded phi_def]
   show "(*) (cis (2 * pi / real (card M))) ` Spectrum cA = Spectrum cA" .
   let ?p = "monom 1 k - [:sr^k:]" 
   let ?cp = "monom 1 k - [:(c sr)^k:]" 
   let ?one = "1 :: complex" 
   let ?list = "map (rcis sr) (map (\<lambda> i. of_nat i * ?piM) [0 ..< card M])" 
   interpret c: field_hom c ..
   interpret p: map_poly_inj_idom_divide_hom c ..
   have cp: "?cp = map_poly c ?p" by (simp add: hom_distribs)    
   have M_list: "M = set ?list" using M_list[unfolded Min card[symmetric]] .
   have dist: "distinct ?list" using dist[unfolded Min card[symmetric]] .
   have k0: "k \<noteq> 0" using k[folded card] assms by auto
   have "?cp = (monom 1 k + (- [:(c sr)^k:]))" by simp
   also have "degree \<dots> = k" 
     by (subst degree_add_eq_left, insert k0, auto simp: degree_monom_eq)  
   finally have deg: "degree ?cp = k" .
   from deg k0 have cp0: "?cp \<noteq> 0" by auto
   have "{x. poly ?cp x = 0} = {x. x^k = (c sr)^k}" unfolding poly_diff poly_monom 
     by simp
   also have "\<dots> \<subseteq> M" 
   proof -
     {
       fix x
       assume id: "x^k = (c sr)^k" 
       from sr_pos k0 have "(c sr)^k \<noteq> 0" by auto
       with arg_cong[OF id, of "\<lambda> x. x / (c sr)^k"] 
       have "(x / c sr)^k = 1"
         unfolding power_divide by auto
       hence "c sr * (x / c sr) \<in> M" 
         by (subst M_pow, unfold kM[symmetric], blast)
       also have "c sr * (x / c sr) = x" using sr_pos by auto
       finally have "x \<in> M" .
     }
     thus ?thesis by auto
   qed
   finally have cp_M: "{x. poly ?cp x = 0} \<subseteq> M" .
   have "k = card (set ?list)" unfolding distinct_card[OF dist] by (simp add: kM)
   also have "\<dots> \<le> card {x. poly ?cp x = 0}" 
   proof (rule card_mono[OF poly_roots_finite[OF cp0]])
     {
       fix x
       assume "x \<in> set ?list" 
       then obtain i where x: "x = rcis sr (real i * ?piM)" by auto
       have "x^k = (c sr)^k" unfolding x DeMoivre2 kM
         by simp (metis mult.assoc of_real_power rcis_times_2pi)
       hence "poly ?cp x = 0" unfolding poly_diff poly_monom by simp
     }
     thus "set ?list \<subseteq> {x. poly ?cp x = 0}" by auto
   qed
   finally have k_card: "k \<le> card {x. poly ?cp x = 0}" .
   from k_card cp_M finM have M_id: "M = {x. poly ?cp x = 0}"
     unfolding kM by (metis card_seteq)
   have dvdc: "?cp dvd charpoly cA" 
   proof (rule poly_roots_dvd[OF cp0 deg k_card])
     from cp_M
     show "{x. poly ?cp x = 0} \<subseteq> {x. poly (charpoly cA) x = 0}" 
       unfolding M eigen_value_root_charpoly by auto
   qed
   from this[unfolded charpoly_of_real cp p.hom_dvd_iff]
   have dvd: "?p dvd charpoly A" .
   from this[unfolded dvd_def] obtain f where 
     decomp: "charpoly A = ?p * f" by blast
   let ?f = "map_poly c f" 
   have decompc: "charpoly cA = ?cp * ?f" unfolding charpoly_of_real decomp p.hom_mult cp ..
   show "\<exists> f. charpoly A = (monom 1 ?M - [:sr^?M:]) * f \<and> (\<forall> x. poly (map_poly c f) x = 0 \<longrightarrow> cmod x < sr)"
     unfolding kM[symmetric]
   proof (intro exI conjI allI impI, rule decomp)
     fix x
     assume f: "poly ?f x = 0" 
     hence ev: "eigen_value cA x" 
       unfolding decompc p.hom_mult eigen_value_root_charpoly by auto    
     hence le: "cmod x \<le> sr" using eigen_value_norm_sr by auto
     {
       assume max: "cmod x = sr" 
       hence "x \<in> M" unfolding M using ev by auto
       hence "poly ?cp x = 0" unfolding M_id by auto
       hence dvd1: "[: -x, 1 :] dvd ?cp" unfolding poly_eq_0_iff_dvd by auto
       from f[unfolded poly_eq_0_iff_dvd]
       have dvd2: "[: -x, 1 :] dvd ?f" by auto
       from char have 0: "charpoly cA \<noteq> 0" by auto
       from mult_dvd_mono[OF dvd1 dvd2] have "[: -x, 1 :]^2 dvd (charpoly cA)" 
         unfolding decompc power2_eq_square .      
       from order_max[OF this 0] maximal_eigen_value_order_1[OF ev max] 
       have False by auto
     }
     with le show "cmod x < sr" by argo
   qed
 qed
   
 lemmas pf_main =
   eigen_value_sr eigen_vector_z_sr (* sr is eigenvalue *)
   eigen_value_norm_sr  (* it is maximal among all complex eigenvalues *)
   z_pos    (* it's eigenvector is positive *)
   multiplicity_sr_1 (* the algebr. multiplicity is 1 *)
   nonnegative_eigenvector_has_ev_sr (* every non-negative real eigenvector has sr as eigenvalue *)
   maximal_eigen_value_order_1 (* all maximal eigenvalues have order 1 *)
   maximal_eigen_value_roots_of_unity_rotation 
    (* the maximal eigenvalues are precisely the k-th roots of unity for some k \<le> dim A *)
 
 lemmas pf_main_connect = pf_main(1,3,5,7,8-10)[unfolded sr_spectral_radius] 
   sr_pos[unfolded sr_spectral_radius]
 end
 
 end
diff --git a/thys/Perron_Frobenius/Roots_Unity.thy b/thys/Perron_Frobenius/Roots_Unity.thy
--- a/thys/Perron_Frobenius/Roots_Unity.thy
+++ b/thys/Perron_Frobenius/Roots_Unity.thy
@@ -1,585 +1,580 @@
 (* author: Thiemann *)
 
 section \<open>Roots of Unity\<close>
 
 theory Roots_Unity
 imports
   Polynomial_Factorization.Order_Polynomial
   "HOL-Computational_Algebra.Fundamental_Theorem_Algebra"
   Polynomial_Interpolation.Ring_Hom_Poly
 begin
 
-lemma cis_mult_cmod_id: "cis (arg x) * of_real (cmod x) = x"
-  using rcis_cmod_arg[unfolded rcis_def] by (simp add: ac_simps)
+lemma cis_mult_cmod_id: "cis (Arg x) * of_real (cmod x) = x"
+  using rcis_cmod_Arg[unfolded rcis_def] by (simp add: ac_simps)
 
 lemma rcis_mult_cis[simp]: "rcis n a * cis b = rcis n (a + b)" unfolding cis_rcis_eq rcis_mult by simp
 lemma rcis_div_cis[simp]: "rcis n a / cis b = rcis n (a - b)" unfolding cis_rcis_eq rcis_divide by simp
 
 lemma cis_plus_2pi[simp]: "cis (x + 2 * pi) = cis x" by (auto simp: complex_eq_iff)
 lemma cis_plus_2pi_neq_1: assumes x: "0 < x" "x < 2 * pi"
   shows "cis x \<noteq> 1"
 proof -
   from x have "cos x \<noteq> 1" by (smt cos_2pi_minus cos_monotone_0_pi cos_zero)
   thus ?thesis by (auto simp: complex_eq_iff)
 qed
 
 lemma cis_times_2pi[simp]: "cis (of_nat n * 2 * pi) = 1"
 proof (induct n)
   case (Suc n)
   have "of_nat (Suc n) * 2 * pi = of_nat n * 2 * pi + 2 * pi" by (simp add: distrib_right)
   also have "cis \<dots> = 1" unfolding cis_plus_2pi Suc ..
   finally show ?case .
 qed simp
 
-declare cis_pi[simp]
-
-lemma cis_pi_2[simp]: "cis (pi / 2) = \<i>"
-  by (auto simp: complex_eq_iff)
-
 lemma cis_add_pi[simp]: "cis (pi + x) = - cis x"
   by (auto simp: complex_eq_iff)
 
 lemma cis_3_pi_2[simp]: "cis (pi * 3 / 2) = - \<i>"
 proof -
   have "cis (pi * 3 / 2) = cis (pi + pi / 2)"
     by (rule arg_cong[of _ _ cis], simp)
   also have "\<dots> = - \<i>" unfolding cis_add_pi by simp
   finally show ?thesis .
 qed
 
 lemma rcis_plus_2pi[simp]: "rcis y (x + 2 * pi) = rcis y x" unfolding rcis_def by simp
 lemma rcis_times_2pi[simp]: "rcis r (of_nat n * 2 * pi) = of_real r"
   unfolding rcis_def cis_times_2pi by simp
 
-lemma arg_rcis_cis: assumes n: "n > 0" shows "arg (rcis n x) = arg (cis x)"
-  using arg_bounded arg_unique cis_arg complex_mod_rcis n rcis_def sgn_eq by auto
+lemma arg_rcis_cis: assumes n: "n > 0" shows "Arg (rcis n x) = Arg (cis x)"
+  using Arg_bounded arg_unique cis_Arg complex_mod_rcis n rcis_def sgn_eq by auto
 
-lemma arg_eqD: assumes "arg (cis x) = arg (cis y)" "-pi < x" "x \<le> pi" "-pi < y" "y \<le> pi"
+lemma arg_eqD: assumes "Arg (cis x) = Arg (cis y)" "-pi < x" "x \<le> pi" "-pi < y" "y \<le> pi"
   shows "x = y"
   using assms(1) unfolding arg_unique[OF sgn_cis assms(2-3)] arg_unique[OF sgn_cis assms(4-5)] .
 
 lemma rcis_inj_on: assumes r: "r \<noteq> 0" shows "inj_on (rcis r) {0 ..< 2 * pi}"
 proof (rule inj_onI, goal_cases)
   case (1 x y)
   from arg_cong[OF 1(3), of "\<lambda> x. x / r"] have "cis x = cis y" using r by (simp add: rcis_def)
   from arg_cong[OF this, of "\<lambda> x. inverse x"] have "cis (-x) = cis (-y)" by simp
   from arg_cong[OF this, of uminus] have *: "cis (-x + pi) = cis (-y + pi)"
     by (auto simp: complex_eq_iff)
   have "- x + pi = - y + pi"
-    by (rule arg_eqD[OF arg_cong[OF *, of arg]], insert 1(1-2), auto)
+    by (rule arg_eqD[OF arg_cong[OF *, of Arg]], insert 1(1-2), auto)
   thus ?case by simp
 qed
 
 lemma cis_inj_on: "inj_on cis {0 ..< 2 * pi}"
   using rcis_inj_on[of 1] unfolding rcis_def by auto
 
 definition root_unity :: "nat \<Rightarrow> 'a :: comm_ring_1 poly" where
   "root_unity n = monom 1 n - 1"
 
 lemma poly_root_unity: "poly (root_unity n) x = 0 \<longleftrightarrow> x^n = 1"
   unfolding root_unity_def by (simp add: poly_monom)
 
 lemma degree_root_unity[simp]: "degree (root_unity n) = n" (is "degree ?p = _")
 proof -
   have p: "?p = monom 1 n + (-1)" unfolding root_unity_def by auto
   show ?thesis
   proof (cases n)
     case 0
     thus ?thesis unfolding p by simp
   next
     case (Suc m)
     show ?thesis unfolding p unfolding Suc
       by (subst degree_add_eq_left, auto simp: degree_monom_eq)
   qed
 qed
 
 lemma zero_root_unit[simp]: "root_unity n = 0 \<longleftrightarrow> n = 0" (is "?p = 0 \<longleftrightarrow> _")
 proof (cases "n = 0")
   case True
   thus ?thesis unfolding root_unity_def by simp
 next
   case False
   from degree_root_unity[of n] False
   have "degree ?p \<noteq> 0" by auto
   hence "?p \<noteq> 0" by fastforce
   thus ?thesis using False by auto
 qed
 
 definition prod_root_unity :: "nat list \<Rightarrow> 'a :: idom poly" where
   "prod_root_unity ns = prod_list (map root_unity ns)"
 
 lemma poly_prod_root_unity: "poly (prod_root_unity ns) x = 0 \<longleftrightarrow> (\<exists>k\<in>set ns. x ^ k = 1)"
   unfolding prod_root_unity_def
   by (simp add: poly_prod_list prod_list_zero_iff o_def image_def poly_root_unity)
 
 lemma degree_prod_root_unity[simp]: "0 \<notin> set ns \<Longrightarrow> degree (prod_root_unity ns) = sum_list ns"
   unfolding prod_root_unity_def
   by (subst degree_prod_list_eq, auto simp: o_def)
 
 lemma zero_prod_root_unit[simp]: "prod_root_unity ns = 0 \<longleftrightarrow> 0 \<in> set ns"
   unfolding prod_root_unity_def prod_list_zero_iff by auto
 
 lemma roots_of_unity: assumes n: "n \<noteq> 0"
   shows "(\<lambda> i. (cis (of_nat i * 2 * pi / n))) ` {0 ..< n} = { x :: complex. x ^ n = 1}" (is "?prod = ?Roots")
      "{x. poly (root_unity n) x = 0} = { x :: complex. x ^ n = 1}"
      "card { x :: complex. x ^ n = 1} = n"
 proof (atomize(full), goal_cases)
   case 1
   let ?one = "1 :: complex"
   let ?p = "monom ?one n - 1"
   have degM: "degree (monom ?one n) = n" by (rule degree_monom_eq, simp)
   have "degree ?p = degree (monom ?one n + (-1))" by simp
   also have "\<dots> = degree (monom ?one n)"
     by (rule degree_add_eq_left, insert n, simp add: degM)
   finally have degp: "degree ?p = n" unfolding degM .
   with n have p: "?p \<noteq> 0" by auto
   have roots: "?Roots = {x. poly ?p x = 0}"
     unfolding poly_diff poly_monom by simp
   also have "finite \<dots>" by (rule poly_roots_finite[OF p])
   finally have fin: "finite ?Roots" .
   have sub: "?prod \<subseteq> ?Roots"
   proof
     fix x
     assume "x \<in> ?prod"
     then obtain i where x: "x = cis (real i * 2 * pi / n)" by auto
     have "x ^ n = cis (real i * 2 * pi)" unfolding x DeMoivre using n by simp
     also have "\<dots> = 1" by simp
     finally show "x \<in> ?Roots" by auto
   qed
   have Rn: "card ?Roots \<le> n" unfolding roots
     by (rule poly_roots_degree[of ?p, unfolded degp, OF p])
   have "\<dots> = card {0 ..< n}" by simp
   also have "\<dots> = card ?prod"
   proof (rule card_image[symmetric], rule inj_onI, goal_cases)
     case (1 x y)
     {
       fix m
       assume "m < n"
       hence "real m < real n" by simp
       from mult_strict_right_mono[OF this, of "2 * pi / real n"] n
       have "real m * 2 * pi / real n < real n * 2 * pi / real n" by simp
       hence "real m * 2 * pi / real n < 2 * pi" using n by simp
     } note [simp] = this
     have 0: "(1 :: real) \<noteq> 0" using n by auto
     have "real x * 2 * pi / real n = real y * 2 * pi / real n"
       by (rule inj_onD[OF rcis_inj_on 1(3)[unfolded cis_rcis_eq]], insert 1(1-2), auto)
     with n show "x = y" by auto
   qed
   finally have cn:  "card ?prod = n" ..
   with Rn have "card ?prod \<ge> card ?Roots" by auto
   with card_mono[OF fin sub] have card: "card ?prod = card ?Roots" by auto
   have "?prod = ?Roots"
     by (rule card_subset_eq[OF fin sub card])
   from this roots[symmetric] cn[unfolded this]
   show ?case unfolding root_unity_def by blast
 qed
 
 lemma poly_roots_dvd: fixes p :: "'a :: field poly"
   assumes "p \<noteq> 0" and "degree p = n"
   and "card {x. poly p x = 0} \<ge> n" and "{x. poly p x = 0} \<subseteq> {x. poly q x = 0}"
 shows "p dvd q"
 proof -
   from poly_roots_degree[OF assms(1)] assms(2-3) have "card {x. poly p x = 0} = n" by auto
   from assms(1-2) this assms(4)
   show ?thesis
   proof (induct n arbitrary: p q)
     case (0 p q)
     from is_unit_iff_degree[OF 0(1)] 0(2) show ?case by blast
   next
     case (Suc n p q)
     let ?P = "{x. poly p x = 0}"
     let ?Q = "{x. poly q x = 0}"
     from Suc(4-5) card_gt_0_iff[of ?P] obtain x where
       x: "poly p x = 0" "poly q x = 0" and fin: "finite ?P" by auto
     define r where "r = [:-x, 1:]"
     from x[unfolded poly_eq_0_iff_dvd r_def[symmetric]] obtain p' q' where
       p: "p = r * p'" and q: "q = r * q'" unfolding dvd_def by auto
     from Suc(2) have "degree p = degree r + degree p'" unfolding p
       by (subst degree_mult_eq, auto)
     with Suc(3) have deg: "degree p' = n" unfolding r_def by auto
     from Suc(2) p have p'0: "p' \<noteq> 0" by auto
     let ?P' = "{x. poly p' x = 0}"
     let ?Q' = "{x. poly q' x = 0}"
     have P: "?P = insert x ?P'" unfolding p poly_mult unfolding r_def by auto
     have Q: "?Q = insert x ?Q'" unfolding q poly_mult unfolding r_def by auto
     {
       assume "x \<in> ?P'"
       hence "?P = ?P'" unfolding P by auto
       from arg_cong[OF this, of card, unfolded Suc(4)] deg have False
         using poly_roots_degree[OF p'0] by auto
     } note xp' = this
     hence xP': "x \<notin> ?P'" by auto
     have "card ?P = Suc (card ?P')" unfolding P
       by (rule card_insert_disjoint[OF _ xP'], insert fin[unfolded P], auto)
     with Suc(4) have card: "card ?P' = n" by auto
     from Suc(5)[unfolded P Q] xP' have "?P' \<subseteq> ?Q'" by auto
     from Suc(1)[OF p'0 deg card this]
     have IH: "p' dvd q'" .
     show ?case unfolding p q using IH by simp
   qed
 qed
 
 lemma root_unity_decomp: assumes n: "n \<noteq> 0"
   shows "root_unity n =
     prod_list (map (\<lambda> i. [:-cis (of_nat i * 2 * pi / n), 1:]) [0 ..< n])" (is "?u = ?p")
 proof -
   have deg: "degree ?u = n" by simp
   note main = roots_of_unity[OF n]
   have dvd: "?u dvd ?p"
   proof (rule poly_roots_dvd[OF _ deg])
     show "n \<le> card {x. poly ?u x = 0}" using main by auto
     show "?u \<noteq> 0" using n by auto
     show "{x. poly ?u x = 0} \<subseteq> {x. poly ?p x = 0}"
       unfolding main(2) main(1)[symmetric] poly_prod_list prod_list_zero_iff by auto
   qed
   have deg': "degree ?p = n"
     by (subst degree_prod_list_eq, auto simp: o_def sum_list_triv)
   have mon: "monic ?u" using deg unfolding root_unity_def using n by auto
   have mon': "monic ?p" by (rule monic_prod_list, auto)
   from dvd[unfolded dvd_def] obtain f where puf: "?p = ?u * f" by auto
   have "degree ?p = degree ?u + degree f" using mon' n unfolding puf
     by (subst degree_mult_eq, auto)
   with deg deg' have "degree f = 0" by auto
   from degree0_coeffs[OF this] obtain a where f: "f = [:a:]" by blast
   from arg_cong[OF puf, of lead_coeff] mon mon'
   have "a = 1" unfolding puf f by (cases "a = 0", auto)
   with f have f: "f = 1" by auto
   with puf show ?thesis by auto
 qed
 
 lemma order_monic_linear: "order x [:y,1:] = (if y + x = 0 then 1 else 0)"
 proof (cases "y + x = 0")
   case True
   hence "poly [:y,1:] x = 0" by simp
   from this[unfolded order_root] have "order x [:y,1:] \<noteq> 0" by auto
   moreover from order_degree[of "[:y,1:]" x] have "order x [:y,1:] \<le> 1" by auto
   ultimately show ?thesis unfolding True by auto
 next
   case False
   hence "poly [:y,1:] x \<noteq> 0" by auto
   from order_0I[OF this] False show ?thesis by auto
 qed
 
 lemma order_root_unity: fixes x :: complex assumes n: "n \<noteq> 0"
   shows "order x (root_unity n) = (if x^n = 1 then 1 else 0)"
   (is "order _ ?u = _")
 proof (cases "x^n = 1")
   case False
   with roots_of_unity(2)[OF n] have "poly ?u x \<noteq> 0" by auto
   from False order_0I[OF this] show ?thesis by auto
 next
   case True
   let ?phi = "\<lambda> i :: nat. i * 2 * pi / n"
   from True roots_of_unity(1)[OF n] obtain i where i: "i < n"
     and x: "x = cis (?phi i)" by force
   from i have n_split: "[0 ..< n] = [0 ..< i] @ i # [Suc i ..< n]"
     by (metis le_Suc_ex less_imp_le_nat not_le_imp_less not_less0 upt_add_eq_append upt_conv_Cons)
   {
     fix j
     assume j: "j < n \<or> j < i" and eq: "cis (?phi i) = cis (?phi j)"
     from inj_onD[OF cis_inj_on eq] i j n have "i = j" by (auto simp: field_simps)
   } note inj = this
   have "order x ?u = 1" unfolding root_unity_decomp[OF n]
     unfolding x n_split using inj
     by (subst order_prod_list, force, fastforce simp: order_monic_linear)
   with True show ?thesis by auto
 qed
 
 lemma order_prod_root_unity: assumes 0: "0 \<notin> set ks"
   shows "order (x :: complex) (prod_root_unity ks) = length (filter (\<lambda> k. x^k = 1) ks)"
 proof -
   have "order x (prod_root_unity ks) = (\<Sum>k\<leftarrow>ks. order x (root_unity k))"
     unfolding prod_root_unity_def
     by (subst order_prod_list, insert 0, auto simp: o_def)
   also have "\<dots> = (\<Sum>k\<leftarrow>ks. (if x^k = 1 then 1 else 0))"
     by (rule arg_cong, rule map_cong, insert 0, force, intro order_root_unity, metis)
   also have "\<dots> = length (filter (\<lambda> k. x^k = 1) ks)"
     by (subst sum_list_map_filter'[symmetric], simp add: sum_list_triv)
   finally show ?thesis .
 qed
 
 lemma root_unity_witness: fixes xs :: "complex list"
   assumes "prod_list (map (\<lambda> x. [:-x,1:]) xs) = monom 1 n - 1"
   shows "x^n = 1 \<longleftrightarrow> x \<in> set xs"
 proof -
   from assms have n0: "n \<noteq> 0" by (cases "n = 0", auto simp: prod_list_zero_iff)
   have "x \<in> set xs \<longleftrightarrow> poly (prod_list (map (\<lambda> x. [:-x,1:]) xs)) x = 0"
     unfolding poly_prod_list prod_list_zero_iff by auto
   also have "\<dots> \<longleftrightarrow> x^n = 1" using roots_of_unity(2)[OF n0] unfolding assms root_unity_def by auto
   finally show ?thesis by auto
 qed
 
 lemma root_unity_explicit: fixes x :: complex
   shows
     "(x ^ 1 = 1) \<longleftrightarrow> x = 1"
     "(x ^ 2 = 1) \<longleftrightarrow> (x \<in> {1, -1})"
     "(x ^ 3 = 1) \<longleftrightarrow> (x \<in> {1, Complex (-1/2) (sqrt 3 / 2), Complex (-1/2) (- sqrt 3 / 2)})"
     "(x ^ 4 = 1) \<longleftrightarrow> (x \<in> {1, -1, \<i>, - \<i>})"
 proof -
   show "(x ^ 1 = 1) \<longleftrightarrow> x = 1"
     by (subst root_unity_witness[of "[1]"], code_simp, auto)
   show "(x ^ 2 = 1) \<longleftrightarrow> (x \<in> {1, -1})"
     by (subst root_unity_witness[of "[1,-1]"], code_simp, auto)
   show "(x ^ 4 = 1) \<longleftrightarrow> (x \<in> {1, -1, \<i>, - \<i>})"
     by (subst root_unity_witness[of "[1,-1, \<i>, - \<i>]"], code_simp, auto)
   have 3: "3 = Suc (Suc (Suc 0))" "1 = [:1:]" by auto
   show "(x ^ 3 = 1) \<longleftrightarrow> (x \<in> {1, Complex (-1/2) (sqrt 3 / 2), Complex (-1/2) (- sqrt 3 / 2)})"
     by (subst root_unity_witness[of
       "[1, Complex (-1/2) (sqrt 3 / 2), Complex (-1/2) (- sqrt 3 / 2)]"],
       auto simp: 3 monom_altdef complex_mult complex_eq_iff)
 qed
 
 definition primitive_root_unity :: "nat \<Rightarrow> 'a :: power \<Rightarrow> bool" where
   "primitive_root_unity k x = (k \<noteq> 0 \<and> x^k = 1 \<and> (\<forall> k' < k. k' \<noteq> 0 \<longrightarrow> x^k' \<noteq> 1))"
 
 lemma primitive_root_unityD: assumes "primitive_root_unity k x"
   shows "k \<noteq> 0" "x^k = 1" "k' \<noteq> 0 \<Longrightarrow> x^k' = 1 \<Longrightarrow> k \<le> k'"
 proof -
   note * = assms[unfolded primitive_root_unity_def]
   from * have **: "k' < k \<Longrightarrow> k' \<noteq> 0 \<Longrightarrow> x ^ k' \<noteq> 1" by auto
   show "k \<noteq> 0" "x^k = 1" using * by auto
   show "k' \<noteq> 0 \<Longrightarrow> x^k' = 1 \<Longrightarrow> k \<le> k'" using ** by force
 qed
 
 lemma primitive_root_unity_exists: assumes "k \<noteq> 0" "x ^ k = 1"
   shows "\<exists> k'. k' \<le> k \<and> primitive_root_unity k' x"
 proof -
   let ?P = "\<lambda> k. x ^ k = 1 \<and> k \<noteq> 0"
   define k' where "k' = (LEAST k. ?P k)"
   from assms have Pk: "\<exists> k. ?P k" by auto
   from LeastI_ex[OF Pk, folded k'_def]
   have "k' \<noteq> 0" "x ^ k' = 1" by auto
   with not_less_Least[of _ ?P, folded k'_def]
   have "primitive_root_unity k' x" unfolding primitive_root_unity_def by auto
   with primitive_root_unityD(3)[OF this assms]
   show ?thesis by auto
 qed
 
 lemma primitive_root_unity_dvd: fixes x :: "complex"
   assumes k: "primitive_root_unity k x"
   shows "x ^ n = 1 \<longleftrightarrow> k dvd n"
 proof
   assume "k dvd n" then obtain j where n: "n = k * j" unfolding dvd_def by auto
   have "x ^ n = (x ^ k) ^ j" unfolding n power_mult by simp
   also have "\<dots> = 1" unfolding primitive_root_unityD[OF k] by simp
   finally show "x ^ n = 1" .
 next
   assume n: "x ^ n = 1"
   note k = primitive_root_unityD[OF k]
   show "k dvd n"
   proof (cases "n = 0")
     case n0: False
     from k(3)[OF n0] n have nk: "n \<ge> k" by force
     from roots_of_unity[OF k(1)] k(2) obtain i :: nat where xk: "x = cis (i * 2 * pi / k)"
       and ik: "i < k" by force
     from roots_of_unity[OF n0] n obtain j :: nat where xn: "x = cis (j * 2 * pi / n)"
       and jn: "j < n" by force
     have cop: "coprime i k"
     proof (rule gcd_eq_1_imp_coprime)
       from k(1) have "gcd i k \<noteq> 0" by auto
       from gcd_coprime_exists[OF this] this obtain i' k' g where
         *: "i = i' * g" "k = k' * g" "g \<noteq> 0" and g: "g = gcd i k" by blast
       from *(2) k(1) have k': "k' \<noteq> 0" by auto
       have "x = cis (i * 2 * pi / k)" by fact
       also have "i * 2 * pi / k = i' * 2 * pi / k'" unfolding * using *(3) by auto
       finally have "x ^ k' = 1" by (simp add: DeMoivre k')
       with k(3)[OF k'] have "k' \<ge> k" by linarith
       moreover with * k(1) have "g = 1" by auto
       then show "gcd i k = 1" by (simp add: g)
     qed
     from inj_onD[OF cis_inj_on xk[unfolded xn]] n0 k(1) ik jn
     have "j * real k = i * real n" by (auto simp: field_simps)
     hence "real (j * k) = real (i * n)" by simp
     hence eq: "j * k = i * n" by linarith
     with cop show "k dvd n"
       by (metis coprime_commute coprime_dvd_mult_right_iff dvd_triv_right)
   qed auto
 qed
 
 lemma primitive_root_unity_simple_computation:
   "primitive_root_unity k x  = (if k = 0 then False else
      x ^ k = 1 \<and> (\<forall> i \<in> {1 ..< k}. x ^ i \<noteq> 1))"
   unfolding primitive_root_unity_def by auto
 
 lemma primitive_root_unity_explicit: fixes x :: complex
   shows "primitive_root_unity 1 x \<longleftrightarrow> x = 1"
     "primitive_root_unity 2 x \<longleftrightarrow> x = -1"
     "primitive_root_unity 3 x \<longleftrightarrow> (x \<in> {Complex (-1/2) (sqrt 3 / 2), Complex (-1/2) (- sqrt 3 / 2)})"
     "primitive_root_unity 4 x \<longleftrightarrow> (x \<in> {\<i>, - \<i>})"
 proof (atomize(full), goal_cases)
   case 1
   {
     fix P :: "nat \<Rightarrow> bool"
     have *: "{1 ..< 2 :: nat} = {1}" "{1 ..< 3 :: nat} = {1,2}" "{1 ..< 4 :: nat} = {1,2,3}"
       by code_simp+
     have "(\<forall>i\<in> {1 ..< 2}. P i) = P 1" "(\<forall>i\<in> {1 ..< 3}. P i) \<longleftrightarrow> P 1 \<and> P 2"
       "(\<forall>i\<in> {1 ..< 4}. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
       unfolding * by auto
   } note * = this
   show ?case unfolding primitive_root_unity_simple_computation root_unity_explicit *
     by (auto simp: complex_eq_iff)
 qed
 
 function decompose_prod_root_unity_main ::
   "'a :: field poly \<Rightarrow> nat \<Rightarrow> nat list \<times> 'a poly" where
   "decompose_prod_root_unity_main p k = (
     if k = 0 then ([], p) else
    let q = root_unity k in if q dvd p then if p = 0 then ([],0) else
      map_prod (Cons k) id (decompose_prod_root_unity_main (p div q) k) else
      decompose_prod_root_unity_main p (k - 1))"
   by pat_completeness auto
 
 termination by (relation "measure (\<lambda> (p,k). degree p + k)", auto simp: degree_div_less)
 
 declare decompose_prod_root_unity_main.simps[simp del]
 
 lemma decompose_prod_root_unity_main: fixes p :: "complex poly"
   assumes p: "p = prod_root_unity ks * f"
   and d: "decompose_prod_root_unity_main p k = (ks',g)"
   and f: "\<And> x. cmod x = 1 \<Longrightarrow> poly f x \<noteq> 0"
   and k: "\<And> k'. k' > k \<Longrightarrow> \<not> root_unity k' dvd p"
 shows "p = prod_root_unity ks' * f \<and> f = g \<and> set ks = set ks'"
   using d p k
 proof (induct p k arbitrary: ks ks' rule: decompose_prod_root_unity_main.induct)
   case (1 p k ks ks')
   note p = 1(4)
   note k = 1(5)
   from k[of "Suc k"] have p0: "p \<noteq> 0" by auto
   hence "p = 0 \<longleftrightarrow> False" by auto
   note d = 1(3)[unfolded decompose_prod_root_unity_main.simps[of p k] this if_False Let_def]
   from p0[unfolded p] have ks0: "0 \<notin> set ks" by simp
   from f[of 1] have f0: "f \<noteq> 0" by auto
   note IH = 1(1)[OF _ refl _ p0] 1(2)[OF _ refl]
   show ?case
   proof (cases "k = 0")
     case True
     with p k[unfolded this, of "hd ks"] p0 have "ks = []"
       by (cases ks, auto simp: prod_root_unity_def)
     with d p True show ?thesis by (auto simp: prod_root_unity_def)
   next
     case k0: False
     note IH = IH[OF k0]
     from k0 have "k = 0 \<longleftrightarrow> False" by auto
     note d = d[unfolded this if_False]
     let ?u = "root_unity k :: complex poly"
     show ?thesis
     proof (cases "?u dvd p")
       case True
       note IH = IH(1)[OF True]
       let ?call = "decompose_prod_root_unity_main (p div ?u) k"
       from True d obtain Ks where rec: "?call = (Ks,g)" and ks': "ks' = (k # Ks)"
         by (cases ?call, auto)
       from True have "?u dvd p \<longleftrightarrow> True" by simp
       note d = d[unfolded this if_True rec]
       let ?x = "cis (2 * pi / k)"
       have rt: "poly ?u ?x = 0" unfolding poly_root_unity using cis_times_2pi[of 1]
         by (simp add: DeMoivre)
       with True have "poly p ?x = 0" unfolding dvd_def by auto
       from this[unfolded p] f[of ?x] rt have "poly (prod_root_unity ks) ?x = 0"
         unfolding poly_root_unity by auto
       from this[unfolded poly_prod_root_unity] ks0 obtain k' where k': "k' \<in> set ks"
         and rt: "?x ^ k' = 1" and k'0: "k' \<noteq> 0" by auto
       let ?u' = "root_unity k' :: complex poly"
       from k' rt k'0 have rtk': "poly ?u' ?x = 0" unfolding poly_root_unity by auto
       {
         let ?phi = " k' * (2 * pi / k)"
         assume "k' < k"
         hence "0 < ?phi" "?phi < 2 * pi" using k0 k'0 by (auto simp: field_simps)
         from cis_plus_2pi_neq_1[OF this] rtk'
         have False unfolding poly_root_unity DeMoivre ..
       }
       hence kk': "k \<le> k'" by presburger
       {
         assume "k' > k"
         from k[OF this, unfolded p]
         have "\<not> ?u' dvd prod_root_unity ks" using dvd_mult2 by auto
         with k' have False unfolding prod_root_unity_def
           using prod_list_dvd[of ?u' "map root_unity ks"] by auto
       }
       with kk' have kk': "k' = k" by presburger
       with k' have "k \<in> set ks" by auto
       from split_list[OF this] obtain ks1 ks2 where ks: "ks = ks1 @ k # ks2" by auto
       hence "p div ?u = (?u * (prod_root_unity (ks1 @ ks2) * f)) div ?u"
         by (simp add: ac_simps p prod_root_unity_def)
       also have "\<dots> = prod_root_unity (ks1 @ ks2) * f"
         by (rule nonzero_mult_div_cancel_left, insert k0, auto)
       finally have id: "p div ?u = prod_root_unity (ks1 @ ks2) * f" .
       from d have ks': "ks' = k # Ks" by auto
       have "k < k' \<Longrightarrow> \<not> root_unity k' dvd p div ?u" for k'
         using k[of k'] True by (metis dvd_div_mult_self dvd_mult2)
       from IH[OF rec id this]
       have id: "p div root_unity k = prod_root_unity Ks * f" and
         *: "f = g \<and> set (ks1 @ ks2) = set Ks" by auto
       from arg_cong[OF id, of "\<lambda> x. x * ?u"] True
       have "p = prod_root_unity Ks * f * root_unity k" by auto
       thus ?thesis using * unfolding ks ks' by (auto simp: prod_root_unity_def)
     next
       case False
       from d False have "decompose_prod_root_unity_main p (k - 1) = (ks',g)" by auto
       note IH = IH(2)[OF False this p]
       have k: "k - 1 < k' \<Longrightarrow> \<not> root_unity k' dvd p" for k' using False k[of k'] k0
         by (cases "k' = k", auto)
       show ?thesis by (rule IH, insert False k, auto)
     qed
   qed
 qed
 
 definition "decompose_prod_root_unity p = decompose_prod_root_unity_main p (degree p)"
 
 lemma decompose_prod_root_unity: fixes p :: "complex poly"
   assumes p: "p = prod_root_unity ks * f"
   and d: "decompose_prod_root_unity p = (ks',g)"
   and f: "\<And> x. cmod x = 1 \<Longrightarrow> poly f x \<noteq> 0"
   and p0: "p \<noteq> 0"
 shows "p = prod_root_unity ks' * f \<and> f = g \<and> set ks = set ks'"
 proof (rule decompose_prod_root_unity_main[OF p d[unfolded decompose_prod_root_unity_def] f])
   fix k
   assume deg: "degree p < k"
   hence "degree p < degree (root_unity k)" by simp
   with p0 show "\<not> root_unity k dvd p"
     by (simp add: poly_divides_conv0)
 qed
 
 lemma (in comm_ring_hom) hom_root_unity: "map_poly hom (root_unity n) = root_unity n"
 proof -
   interpret p: map_poly_comm_ring_hom hom ..
   show ?thesis unfolding root_unity_def
     by (simp add: hom_distribs)
 qed
 
 lemma (in idom_hom) hom_prod_root_unity: "map_poly hom (prod_root_unity n) = prod_root_unity n"
 proof -
   interpret p: map_poly_comm_ring_hom hom ..
   show ?thesis unfolding prod_root_unity_def p.hom_prod_list map_map o_def hom_root_unity ..
 qed
 
 lemma (in field_hom) hom_decompose_prod_root_unity_main:
   "decompose_prod_root_unity_main (map_poly hom p) k = map_prod id (map_poly hom)
     (decompose_prod_root_unity_main p k)"
 proof (induct p k rule: decompose_prod_root_unity_main.induct)
   case (1 p k)
   let ?h = "map_poly hom"
   let ?p = "?h p"
   let ?u = "root_unity k :: 'a poly"
   let ?u' = "root_unity k :: 'b poly"
   interpret p: map_poly_inj_idom_divide_hom hom ..
   have u': "?u' = ?h ?u" unfolding hom_root_unity ..
   note simp = decompose_prod_root_unity_main.simps
   let ?rec1 = "decompose_prod_root_unity_main (p div ?u) k"
   have 0: "?p = 0 \<longleftrightarrow> p = 0" by simp
   show ?case
     unfolding simp[of ?p k] simp[of p k] if_distrib[of "map_prod id ?h"] Let_def u'
     unfolding 0 p.hom_div[symmetric] p.hom_dvd_iff
     by (rule if_cong[OF refl], force, rule if_cong[OF refl if_cong[OF refl]], force,
      (subst 1(1), auto, cases ?rec1, auto)[1],
      (subst 1(2), auto))
 qed
 
 lemma (in field_hom) hom_decompose_prod_root_unity:
   "decompose_prod_root_unity (map_poly hom p) = map_prod id (map_poly hom)
     (decompose_prod_root_unity p)"
   unfolding decompose_prod_root_unity_def
   by (subst hom_decompose_prod_root_unity_main, simp)
 
 
 end
diff --git a/thys/Poincare_Disc/Poincare_Between.thy b/thys/Poincare_Disc/Poincare_Between.thy
--- a/thys/Poincare_Disc/Poincare_Between.thy
+++ b/thys/Poincare_Disc/Poincare_Between.thy
@@ -1,1257 +1,1257 @@
 theory Poincare_Between
   imports Poincare_Distance
 begin
 
 (* ------------------------------------------------------------------ *)
 section\<open>H-betweenness in the Poincar\'e model\<close>
 (* ------------------------------------------------------------------ *)
 
 subsection \<open>H-betwenness expressed by a cross-ratio\<close>
 
 text\<open>The point $v$ is h-between $u$ and $w$ if the cross-ratio between the pairs $u$ and $w$ and $v$
 and inverse of $v$ is real and negative.\<close>
 definition poincare_between :: "complex_homo \<Rightarrow> complex_homo \<Rightarrow> complex_homo \<Rightarrow> bool" where
   "poincare_between u v w \<longleftrightarrow>
          u = v \<or> v = w \<or>
          (let cr = cross_ratio u v w (inversion v)
            in is_real (to_complex cr) \<and> Re (to_complex cr) < 0)"
 
 subsubsection \<open>H-betwenness is preserved by h-isometries\<close>
 
 text \<open>Since they preserve cross-ratio and inversion, h-isometries (unit disc preserving Möbius
 transformations and conjugation) preserve h-betweeness.\<close>
 
 lemma unit_disc_fix_moebius_preserve_poincare_between [simp]:
   assumes "unit_disc_fix M" and "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   shows "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \<longleftrightarrow>
          poincare_between u v w"
 proof (cases "u = v \<or> v = w")
   case True
   thus ?thesis
     using assms
     unfolding poincare_between_def
     by auto
 next
   case False
   moreover
   hence "moebius_pt M u \<noteq> moebius_pt M v \<and> moebius_pt M v \<noteq> moebius_pt M w"
     by auto
   moreover
   have "v \<noteq> inversion v" "w \<noteq> inversion v"
     using inversion_noteq_unit_disc[of v w]
     using inversion_noteq_unit_disc[of v v]
     using \<open>v \<in> unit_disc\<close> \<open>w \<in> unit_disc\<close>
     by auto
   ultimately
   show ?thesis
     using assms
     using unit_circle_fix_moebius_pt_inversion[of M v, symmetric]
     unfolding poincare_between_def
     by (simp del: unit_circle_fix_moebius_pt_inversion)
 qed
 
 lemma conjugate_preserve_poincare_between [simp]:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   shows "poincare_between (conjugate u) (conjugate v) (conjugate w) \<longleftrightarrow>
          poincare_between u v w"
 proof (cases "u = v \<or> v = w")
   case True
   thus ?thesis
     using assms
     unfolding poincare_between_def
     by auto
 next
   case False
   moreover
   hence "conjugate u \<noteq> conjugate v \<and> conjugate v \<noteq> conjugate w"
     using conjugate_inj by blast
   moreover
   have "v \<noteq> inversion v" "w \<noteq> inversion v"
     using inversion_noteq_unit_disc[of v w]
     using inversion_noteq_unit_disc[of v v]
     using \<open>v \<in> unit_disc\<close> \<open>w \<in> unit_disc\<close>
     by auto
   ultimately
   show ?thesis
     using assms
     using conjugate_cross_ratio[of v w "inversion v" u]
     unfolding poincare_between_def
     by (metis conjugate_id_iff conjugate_involution inversion_def inversion_sym o_apply)
 qed
 
 
 subsubsection \<open>Some elementary properties of h-betwenness\<close>
 
 lemma poincare_between_nonstrict [simp]:
   shows "poincare_between u u v" and "poincare_between u v v"
   by (simp_all add: poincare_between_def)                       
 
 lemma poincare_between_sandwich:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc"
   assumes "poincare_between u v u"
   shows "u = v"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   thus False
     using assms
     using inversion_noteq_unit_disc[of v u]
     using cross_ratio_1[of v u "inversion v"]
     unfolding poincare_between_def Let_def
     by auto
 qed
 
 lemma poincare_between_rev:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   shows "poincare_between u v w \<longleftrightarrow> poincare_between w v u"       
   using assms 
   using inversion_noteq_unit_disc[of v w]
   using inversion_noteq_unit_disc[of v u]
   using cross_ratio_commute_13[of u v w "inversion v"]
   using cross_ratio_not_inf[of w "inversion v" v u]
   using cross_ratio_not_zero[of w v u "inversion v"]
   using inf_or_of_complex[of "cross_ratio w v u (inversion v)"]
   unfolding poincare_between_def
   by (auto simp add: Let_def Im_complex_div_eq_0 Re_divide divide_less_0_iff)
 
 subsubsection \<open>H-betwenness and h-collinearity\<close>
 
 text\<open>Three points can be in an h-between relation only when they are h-collinear.\<close>
 lemma poincare_between_poincare_collinear [simp]:       
   assumes in_disc: "u \<in> unit_disc"  "v \<in> unit_disc"  "w \<in> unit_disc"
   assumes betw: "poincare_between u v w"
   shows "poincare_collinear {u, v, w}"
 proof (cases "u = v \<or> v = w")
   case True
   thus ?thesis
     using assms
     by auto
 next
   case False
   hence distinct: "distinct [u, v, w, inversion v]"
     using in_disc inversion_noteq_unit_disc[of v v] inversion_noteq_unit_disc[of v u] inversion_noteq_unit_disc[of v w]
     using betw poincare_between_sandwich[of w v]
     by (auto simp add: poincare_between_def Let_def)
 
   then obtain H where *: "{u, v, w, inversion v} \<subseteq> circline_set H"
     using assms
     unfolding poincare_between_def
     using four_points_on_circline_iff_cross_ratio_real[of u v w "inversion v"]
     by auto
   hence "H = poincare_line u v"
     using assms distinct
     using unique_circline_set[of u v "inversion v"]
     using poincare_line[of u v] poincare_line_inversion[of u v]
     unfolding circline_set_def
     by auto
   thus ?thesis
     using * assms False
     unfolding poincare_collinear_def
     by (rule_tac x="poincare_line u v" in exI) simp
 qed
 
 lemma poincare_between_poincare_line_uvz:
   assumes "u \<noteq> v" and "u \<in> unit_disc" and "v \<in> unit_disc" and
           "z \<in> unit_disc" and "poincare_between u v z"
   shows "z \<in> circline_set (poincare_line u v)"
   using assms
   using poincare_between_poincare_collinear[of u v z]
   using unique_poincare_line[OF assms(1-3)]
   unfolding poincare_collinear_def
   by auto
 
 lemma poincare_between_poincare_line_uzv:
   assumes "u \<noteq> v" and "u \<in> unit_disc" and "v \<in> unit_disc" and
           "z \<in> unit_disc" "poincare_between u z v"
   shows "z \<in> circline_set (poincare_line u v)"
   using assms
   using poincare_between_poincare_collinear[of u z v]
   using unique_poincare_line[OF assms(1-3)]
   unfolding poincare_collinear_def
   by auto
 
 subsubsection \<open>H-betweeness on Euclidean segments\<close> 
 
 text\<open>If the three points lie on an h-line that is a Euclidean line (e.g., if it contains zero),
 h-betweenness can be characterized much simpler than in the definition.\<close>
 
 lemma poincare_between_x_axis_u0v:
   assumes "is_real u'" and "u' \<noteq> 0" and "v' \<noteq> 0"
   shows "poincare_between (of_complex u') 0\<^sub>h (of_complex v') \<longleftrightarrow> is_real v' \<and> Re u' * Re v' < 0"
 proof-
   have "Re u' \<noteq> 0"
     using \<open>is_real u'\<close> \<open>u' \<noteq> 0\<close>
     using complex_eq_if_Re_eq
     by auto
   have nz: "of_complex u' \<noteq> 0\<^sub>h" "of_complex v' \<noteq> 0\<^sub>h"
     by (simp_all add: \<open>u' \<noteq> 0\<close> \<open>v' \<noteq> 0\<close>)
   hence "0\<^sub>h \<noteq> of_complex v'"
     by metis
 
   let ?cr = "cross_ratio (of_complex u') 0\<^sub>h (of_complex v') \<infinity>\<^sub>h"
   have "is_real (to_complex ?cr) \<and> Re (to_complex ?cr) < 0 \<longleftrightarrow> is_real v' \<and> Re u' * Re v' < 0"
     using cross_ratio_0inf[of v' u'] \<open>v' \<noteq> 0\<close> \<open>u' \<noteq> 0\<close> \<open>is_real u'\<close>
     by (metis Re_complex_div_lt_0 Re_mult_real complex_cnj_divide divide_cancel_left eq_cnj_iff_real to_complex_of_complex)
   thus ?thesis
     unfolding poincare_between_def inversion_zero
     using \<open>of_complex u' \<noteq> 0\<^sub>h\<close> \<open>0\<^sub>h \<noteq> of_complex v'\<close>
     by simp
 qed
 
 lemma poincare_between_u0v:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "u \<noteq> 0\<^sub>h" and "v \<noteq> 0\<^sub>h"
   shows "poincare_between u 0\<^sub>h v \<longleftrightarrow> (\<exists> k < 0. to_complex u = cor k * to_complex v)" (is "?P u v")
 proof (cases "u = v")
   case True
   thus ?thesis
     using assms
     using inf_or_of_complex[of v]
     using poincare_between_sandwich[of u "0\<^sub>h"]      
     by auto
 next                                                 
   case False
   have "\<forall> u. u \<in> unit_disc \<and> u \<noteq> 0\<^sub>h \<longrightarrow> ?P u v" (is "?P' v")
   proof (rule wlog_rotation_to_positive_x_axis)
     fix \<phi> v
     let ?M = "moebius_pt (moebius_rotation \<phi>)"
     assume 1: "v \<in> unit_disc" "v \<noteq> 0\<^sub>h"
     assume 2: "?P' (?M v)"
     show "?P' v"
     proof (rule allI, rule impI, (erule conjE)+)
       fix u
       assume 3: "u \<in> unit_disc" "u \<noteq> 0\<^sub>h"  
       have "poincare_between (?M u) 0\<^sub>h (?M v) \<longleftrightarrow> poincare_between u 0\<^sub>h v"
         using \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close>
         using unit_disc_fix_moebius_preserve_poincare_between unit_disc_fix_rotation zero_in_unit_disc 
         by fastforce
       thus "?P u v"
         using 1 2[rule_format, of "?M u"] 3
         using inf_or_of_complex[of u] inf_or_of_complex[of v]
         by auto
     qed
   next
     fix x
     assume 1: "is_real x" "0 < Re x" "Re x < 1"
     hence "x \<noteq> 0"
       by auto
     show "?P' (of_complex x)"    
     proof (rule allI, rule impI, (erule conjE)+)
       fix u
       assume 2: "u \<in> unit_disc" "u \<noteq> 0\<^sub>h"
       then obtain u' where "u = of_complex u'"
         using inf_or_of_complex[of u]
         by auto
       show "?P u (of_complex x)"
         using 1 2 \<open>x \<noteq> 0\<close> \<open>u = of_complex u'\<close>
         using poincare_between_rev[of u "0\<^sub>h" "of_complex x"]
         using poincare_between_x_axis_u0v[of x u'] \<open>is_real x\<close>
         apply (auto simp add: cmod_eq_Re)
         apply (rule_tac x="Re u' / Re x" in exI, simp add: divide_neg_pos algebra_split_simps)
         using mult_neg_pos mult_pos_neg
         by blast
     qed
   qed fact+
   thus ?thesis
     using assms
     by auto
 qed
 
 lemma poincare_between_u0v_polar_form:
   assumes "x \<in> unit_disc" and "y \<in> unit_disc" and "x \<noteq> 0\<^sub>h" and "y \<noteq> 0\<^sub>h" and 
           "to_complex x = cor rx * cis \<phi>" "to_complex y = cor ry * cis \<phi>"
   shows "poincare_between x 0\<^sub>h y \<longleftrightarrow> rx * ry < 0" (is "?P x y rx ry")
 proof-
   from assms have "rx \<noteq> 0" "ry \<noteq> 0"
     using inf_or_of_complex[of x] inf_or_of_complex[of y]
     by auto
 
   have "(\<exists>k<0. cor rx = cor k * cor ry ) = (rx * ry < 0)"
   proof
     assume "\<exists>k<0. cor rx = cor k * cor ry"
     then obtain k where "k < 0" "cor rx = cor k * cor ry"
       by auto
     hence "rx = k * ry"
       using of_real_eq_iff
       by fastforce
     thus "rx * ry < 0" 
       using \<open>k < 0\<close> \<open>rx \<noteq> 0\<close> \<open>ry \<noteq> 0\<close>
       by (smt divisors_zero mult_nonneg_nonpos mult_nonpos_nonpos zero_less_mult_pos2)
   next
     assume "rx * ry < 0"
     hence "rx = (rx/ry)*ry" "rx / ry < 0"
       using \<open>rx \<noteq> 0\<close> \<open>ry \<noteq> 0\<close>
       by (auto simp add: divide_less_0_iff algebra_split_simps)
     thus "\<exists>k<0. cor rx = cor k * cor ry"
       using \<open>rx \<noteq> 0\<close> \<open>ry \<noteq> 0\<close>
       by (rule_tac x="rx / ry" in exI, simp)
   qed
   thus ?thesis
     using assms                                 
     using poincare_between_u0v[OF assms(1-4)]
     by auto
 qed
 
 lemma poincare_between_x_axis_0uv:
   fixes x y :: real
   assumes "-1 < x" and "x < 1" and "x \<noteq> 0"
   assumes "-1 < y" and "y < 1" and "y \<noteq> 0"
   shows "poincare_between 0\<^sub>h (of_complex x) (of_complex y) \<longleftrightarrow>
         (x < 0 \<and> y < 0 \<and> y \<le> x) \<or> (x > 0 \<and> y > 0 \<and> x \<le> y)" (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x = y")
   case True
   thus ?thesis
     using assms
     unfolding poincare_between_def
     by auto
 next
   case False
   let ?x = "of_complex x" and ?y = "of_complex y"
 
   have "?x \<in> unit_disc" "?y \<in> unit_disc"
     using assms
     by auto
 
   have distinct: "distinct [0\<^sub>h, ?x, ?y, inversion ?x]"
     using \<open>x \<noteq> 0\<close> \<open>y \<noteq> 0\<close> \<open>x \<noteq> y\<close> \<open>?x \<in> unit_disc\<close> \<open>?y \<in> unit_disc\<close>
     using inversion_noteq_unit_disc[of ?x ?y]
     using inversion_noteq_unit_disc[of ?x ?x]
     using inversion_noteq_unit_disc[of ?x "0\<^sub>h"]
     using of_complex_inj[of x y]
     by (metis distinct_length_2_or_more distinct_singleton of_complex_zero_iff of_real_eq_0_iff of_real_eq_iff zero_in_unit_disc)
 
   let ?cr = "cross_ratio 0\<^sub>h ?x ?y (inversion ?x)"
   have "Re (to_complex ?cr) = x\<^sup>2 * (x*y - 1) / (x * (y - x))"
     using \<open>x \<noteq> 0\<close> \<open>x \<noteq> y\<close>
     unfolding inversion_def
     by simp (transfer, transfer, auto simp add: vec_cnj_def power2_eq_square field_simps split: if_split_asm)
   moreover
   { 
     fix a b :: real
     assume "b \<noteq> 0"
     hence "a < 0 \<longleftrightarrow> b\<^sup>2 * a < (0::real)"
       by (metis mult.commute mult_eq_0_iff mult_neg_pos mult_pos_pos not_less_iff_gr_or_eq not_real_square_gt_zero power2_eq_square)
   }
   hence "x\<^sup>2 * (x*y - 1) < 0"
     using assms
     by (smt minus_mult_minus mult_le_cancel_left1)
   moreover
   have "x * (y - x) > 0 \<longleftrightarrow> ?rhs"
     using \<open>x \<noteq> 0\<close> \<open>y \<noteq> 0\<close> \<open>x \<noteq> y\<close>
     by (smt mult_le_0_iff)
   ultimately
   have *: "Re (to_complex ?cr) < 0 \<longleftrightarrow> ?rhs"
     by (simp add: divide_less_0_iff)
 
   show ?thesis
   proof
     assume ?lhs
     have "is_real (to_complex ?cr)" "Re (to_complex ?cr) < 0"
       using \<open>?lhs\<close> distinct
       unfolding poincare_between_def Let_def
       by auto
     thus ?rhs
       using *
       by simp
   next
     assume ?rhs
     hence "Re (to_complex ?cr) < 0"
       using *
       by simp
     moreover
     have "{0\<^sub>h, of_complex (cor x), of_complex (cor y), inversion (of_complex (cor x))} \<subseteq> circline_set x_axis"
       using \<open>x \<noteq> 0\<close> is_real_inversion[of "cor x"]
       using inf_or_of_complex[of "inversion ?x"]
       by (auto simp del: inversion_of_complex)
     hence "is_real (to_complex ?cr)"
       using four_points_on_circline_iff_cross_ratio_real[OF distinct]
       by auto
     ultimately
     show ?lhs
       using distinct
       unfolding poincare_between_def Let_def
       by auto
   qed
 qed
 
 lemma poincare_between_0uv:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "u \<noteq> 0\<^sub>h" and "v \<noteq> 0\<^sub>h"
   shows "poincare_between 0\<^sub>h u v \<longleftrightarrow>
          (let u' = to_complex u; v' = to_complex v in arg u' = arg v' \<and> cmod u' \<le> cmod v')" (is "?P u v")
 proof (cases "u = v")
   case True
   thus ?thesis
     by simp
 next
   case False
   have "\<forall> v. v \<in> unit_disc \<and> v \<noteq> 0\<^sub>h \<and> v \<noteq> u \<longrightarrow> (poincare_between 0\<^sub>h u v \<longleftrightarrow> (let u' = to_complex u; v' = to_complex v in arg u' = arg v' \<and> cmod u' \<le> cmod v'))" (is "?P' u")
   proof (rule wlog_rotation_to_positive_x_axis)
     show "u \<in> unit_disc" "u \<noteq> 0\<^sub>h"
       by fact+
   next
     fix x
     assume *: "is_real x" "0 < Re x" "Re x < 1"
     hence "of_complex x \<in> unit_disc" "of_complex x \<noteq> 0\<^sub>h" "of_complex x \<in> circline_set x_axis"
       unfolding circline_set_x_axis
       by (auto simp add: cmod_eq_Re)
     show "?P' (of_complex x)"
     proof safe
       fix v
       assume "v \<in> unit_disc" "v \<noteq> 0\<^sub>h" "v \<noteq> of_complex x" "poincare_between 0\<^sub>h (of_complex x) v"
       hence "v \<in> circline_set x_axis"
         using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex x" v]
         using poincare_line_0_real_is_x_axis[of "of_complex x"]
         using \<open>of_complex x \<noteq> 0\<^sub>h\<close> \<open>v \<noteq> 0\<^sub>h\<close> \<open>v \<noteq> of_complex x\<close> \<open>of_complex x \<in> unit_disc\<close> \<open>of_complex x \<in> circline_set x_axis\<close>
         by auto
       obtain v' where "v = of_complex v'"
         using \<open>v \<in> unit_disc\<close>
         using inf_or_of_complex[of v]
         by auto
       hence **: "v = of_complex v'" "-1 < Re v'" "Re v' < 1" "Re v' \<noteq> 0" "is_real v'"
         using \<open>v \<in> unit_disc\<close> \<open>v \<noteq> 0\<^sub>h\<close> \<open>v \<in> circline_set x_axis\<close> of_complex_inj[of v']
         unfolding circline_set_x_axis
         by (auto simp add: cmod_eq_Re real_imag_0)
       show "let u' = to_complex (of_complex x); v' = to_complex v in arg u' = arg v' \<and> cmod u' \<le> cmod v'"
         using poincare_between_x_axis_0uv[of "Re x" "Re v'"] * **
         using \<open>poincare_between 0\<^sub>h (of_complex x) v\<close>
         using arg_complex_of_real_positive[of "Re x"] arg_complex_of_real_negative[of "Re x"]
         using arg_complex_of_real_positive[of "Re v'"] arg_complex_of_real_negative[of "Re v'"]
         by (auto simp add: cmod_eq_Re)
     next
       fix v
       assume "v \<in> unit_disc" "v \<noteq> 0\<^sub>h" "v \<noteq> of_complex x"
       then obtain v' where **: "v = of_complex v'" "v' \<noteq> 0" "v' \<noteq> x"
         using inf_or_of_complex[of v]
         by auto blast
       assume "let u' = to_complex (of_complex x); v' = to_complex v in arg u' = arg v' \<and> cmod u' \<le> cmod v'"
       hence ***: "Re x < 0 \<and> Re v' < 0 \<and> Re v' \<le> Re x \<or> 0 < Re x \<and> 0 < Re v' \<and> Re x \<le> Re v'" "is_real v'"
         using arg_pi_iff[of x] arg_pi_iff[of v']
         using arg_0_iff[of x] arg_0_iff[of v']
         using * **
         by (smt cmod_Re_le_iff to_complex_of_complex)+
       have "-1 < Re v'" "Re v' < 1" "Re v' \<noteq> 0" "is_real v'"
         using \<open>v \<in> unit_disc\<close> ** \<open>is_real v'\<close>
         by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq)
       thus "poincare_between 0\<^sub>h (of_complex x) v"
         using poincare_between_x_axis_0uv[of "Re x" "Re v'"] * ** ***
         by simp
     qed
   next
     fix \<phi> u
     assume "u \<in> unit_disc" "u \<noteq> 0\<^sub>h"
     let ?M = "moebius_rotation \<phi>"
     assume *: "?P' (moebius_pt ?M u)"
     show "?P' u"
     proof (rule allI, rule impI, (erule conjE)+)
       fix v
       assume "v \<in> unit_disc" "v \<noteq> 0\<^sub>h" "v \<noteq> u"
       have "moebius_pt ?M v \<noteq> moebius_pt ?M u"
         using \<open>v \<noteq> u\<close>
         by auto
       obtain u' v' where "v = of_complex v'" "u = of_complex u'" "v' \<noteq> 0" "u' \<noteq> 0"
         using inf_or_of_complex[of u] inf_or_of_complex[of v]
         using \<open>v \<in> unit_disc\<close> \<open>u \<in> unit_disc\<close> \<open>v \<noteq> 0\<^sub>h\<close> \<open>u \<noteq> 0\<^sub>h\<close>
         by auto
       thus "?P u v"
         using *[rule_format, of "moebius_pt ?M v"]
         using \<open>moebius_pt ?M v \<noteq> moebius_pt ?M u\<close>
         using unit_disc_fix_moebius_preserve_poincare_between[of ?M "0\<^sub>h" u v]
         using \<open>v \<in> unit_disc\<close> \<open>u \<in> unit_disc\<close> \<open>v \<noteq> 0\<^sub>h\<close> \<open>u \<noteq> 0\<^sub>h\<close>
         using arg_mult_eq[of "cis \<phi>" u' v']
         by simp (auto simp add: arg_mult norm_mult)
     qed
   qed
   thus ?thesis
     using assms False
     by auto
 qed
 
 lemma poincare_between_y_axis_0uv:
   fixes x y :: real
   assumes "-1 < x" and "x < 1" and "x \<noteq> 0"
   assumes "-1 < y" and "y < 1" and "y \<noteq> 0"
   shows "poincare_between 0\<^sub>h (of_complex (\<i> * x)) (of_complex (\<i> * y)) \<longleftrightarrow>
         (x < 0 \<and> y < 0 \<and> y \<le> x) \<or> (x > 0 \<and> y > 0 \<and> x \<le> y)" (is "?lhs \<longleftrightarrow> ?rhs")
   using assms
   using poincare_between_0uv[of "of_complex (\<i> * x)" "of_complex (\<i> * y)"]
   using arg_pi2_iff[of "\<i> * cor x"] arg_pi2_iff[of "\<i> * cor y"]
   using arg_minus_pi2_iff[of "\<i> * cor x"] arg_minus_pi2_iff[of "\<i> * cor y"]
   apply (simp add: norm_mult)
   apply (smt (verit, best))
   done
 
 lemma poincare_between_x_axis_uvw:
   fixes x y z :: real
   assumes "-1 < x" and "x < 1" 
   assumes "-1 < y" and "y < 1" and "y \<noteq> x"
   assumes "-1 < z" and "z < 1" and "z \<noteq> x"
   shows "poincare_between (of_complex x) (of_complex y) (of_complex z) \<longleftrightarrow>
         (y < x \<and> z < x \<and> z \<le> y) \<or> (y > x \<and> z > x \<and> y \<le> z)"  (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x = 0 \<or> y = 0 \<or> z = 0")
   case True
   thus ?thesis
   proof (cases "x = 0")
     case True
     thus ?thesis
       using poincare_between_x_axis_0uv assms
       by simp
   next
     case False
     show ?thesis
     proof (cases "z = 0")
       case True
       thus ?thesis
         using poincare_between_x_axis_0uv assms poincare_between_rev
         by (smt norm_of_real of_complex_zero of_real_0 poincare_between_nonstrict(2) unit_disc_iff_cmod_lt_1)
     next
       case False
       have "y = 0"
         using \<open>x \<noteq> 0\<close> \<open>z \<noteq> 0\<close> \<open>x = 0 \<or> y = 0 \<or> z = 0\<close>
         by simp
 
       have "poincare_between (of_complex x) 0\<^sub>h (of_complex z) = (is_real z \<and> x * z < 0)"
         using \<open>x \<noteq> 0\<close> \<open>z \<noteq> 0\<close> poincare_between_x_axis_u0v 
         by auto
       moreover
       have "x * z < 0 \<longleftrightarrow> ?rhs"
         using True \<open>x \<noteq> 0\<close> \<open>z \<noteq> 0\<close>
         by (smt zero_le_mult_iff)
       ultimately
       show ?thesis
         using \<open>y = 0\<close>
         by auto
     qed
   qed
 next
   case False
   thus ?thesis
   proof (cases "z = y")
     case True
     thus ?thesis
       using assms
       unfolding poincare_between_def
       by auto
   next
     case False
     let ?x = "of_complex x" and ?y = "of_complex y" and ?z = "of_complex z"
   
     have "?x \<in> unit_disc" "?y \<in> unit_disc" "?z \<in> unit_disc"
       using assms
       by auto
   
     have distinct: "distinct [?x, ?y, ?z, inversion ?y]"
       using \<open>y \<noteq> x\<close> \<open>z \<noteq> x\<close> False \<open>?x \<in> unit_disc\<close> \<open>?y \<in> unit_disc\<close> \<open>?z \<in> unit_disc\<close>
       using inversion_noteq_unit_disc[of ?y ?y]
       using inversion_noteq_unit_disc[of ?y ?x]
       using inversion_noteq_unit_disc[of ?y ?z]
       using of_complex_inj[of x y]  of_complex_inj[of y z]  of_complex_inj[of x z]
       by auto
 
     have "cor y * cor x \<noteq> 1"
       using assms
       by (smt minus_mult_minus mult_less_cancel_left2 mult_less_cancel_right2 of_real_1 of_real_eq_iff of_real_mult)
   
     let ?cr = "cross_ratio ?x ?y ?z (inversion ?y)"
     have "Re (to_complex ?cr) = (x - y) * (z*y - 1)/ ((x*y - 1)*(z - y))"
     proof-
       have " \<And>y x z. \<lbrakk>y \<noteq> x; z \<noteq> x; z \<noteq> y; cor y * cor x \<noteq> 1; x \<noteq> 0; y \<noteq> 0; z \<noteq> 0\<rbrakk> \<Longrightarrow> 
            (y * y + y * (y * (x * z)) - (y * x + y * (y * (y * z)))) /
            (y * y + y * (y * (x * z)) - (y * z + y * (y * (y * x)))) =
            (y + y * (x * z) - (x + y * (y * z))) / (y + y * (x * z) - (z + y * (y * x)))"
         by (metis (no_types, hide_lams) ab_group_add_class.ab_diff_conv_add_uminus distrib_left mult_divide_mult_cancel_left_if mult_minus_right)
       thus ?thesis
         using \<open>y \<noteq> x\<close> \<open>z \<noteq> x\<close> False \<open>\<not> (x = 0 \<or> y = 0 \<or> z = 0)\<close>
         using \<open>cor y * cor x \<noteq> 1\<close>
         unfolding inversion_def
         by (transfer, transfer, auto simp add: vec_cnj_def power2_eq_square field_simps split: if_split_asm)
     qed
       
     moreover
     have "(x*y - 1) < 0"
       using assms
       by (smt minus_mult_minus mult_less_cancel_right2 zero_less_mult_iff)
     moreover
     have "(z*y - 1) < 0"
       using assms
       by (smt minus_mult_minus mult_less_cancel_right2 zero_less_mult_iff)
     moreover
     have "(x - y) / (z - y) < 0 \<longleftrightarrow> ?rhs"
       using \<open>y \<noteq> x\<close> \<open>z \<noteq> x\<close> False \<open>\<not> (x = 0 \<or> y = 0 \<or> z = 0)\<close>
       by (smt divide_less_cancel divide_nonneg_nonpos divide_nonneg_pos divide_nonpos_nonneg divide_nonpos_nonpos)
     ultimately
     have *: "Re (to_complex ?cr) < 0 \<longleftrightarrow> ?rhs"
       by (smt algebra_split_simps(24) minus_divide_left zero_less_divide_iff zero_less_mult_iff)
     show ?thesis
     proof
       assume ?lhs
       have "is_real (to_complex ?cr)" "Re (to_complex ?cr) < 0"
         using \<open>?lhs\<close> distinct
         unfolding poincare_between_def Let_def
         by auto
       thus ?rhs
         using *
         by simp
     next
       assume ?rhs
       hence "Re (to_complex ?cr) < 0"
         using *
         by simp
       moreover
       have "{of_complex (cor x), of_complex (cor y), of_complex (cor z), inversion (of_complex (cor y))} \<subseteq> circline_set x_axis"
         using \<open>\<not> (x = 0 \<or> y = 0 \<or> z = 0)\<close> is_real_inversion[of "cor y"]
         using inf_or_of_complex[of "inversion ?y"]
         by (auto simp del: inversion_of_complex)
       hence "is_real (to_complex ?cr)"
         using four_points_on_circline_iff_cross_ratio_real[OF distinct]
         by auto
       ultimately
       show ?lhs
         using distinct
         unfolding poincare_between_def Let_def
         by auto
     qed
   qed
 qed
 
 subsubsection \<open>H-betweenness and h-collinearity\<close>
 
 text\<open>For three h-collinear points at least one of the three possible h-betweeness relations must
 hold.\<close>
 lemma poincare_collinear3_between:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   assumes "poincare_collinear {u, v, w}"
   shows "poincare_between u v w \<or> poincare_between u w v \<or> poincare_between v u w" (is "?P' u v w")
 proof (cases "u=v")
   case True
   thus ?thesis
     using assms
     by auto
 next
   case False
   have "\<forall> w. w \<in> unit_disc \<and> poincare_collinear {u, v, w} \<longrightarrow> ?P' u v w" (is "?P u v")
   proof (rule wlog_positive_x_axis[where P="?P"])
     fix x
     assume x: "is_real x" "0 < Re x" "Re x < 1"
     hence "x \<noteq> 0"
       using complex.expand[of x 0]
       by auto
     hence *: "poincare_line 0\<^sub>h (of_complex x) = x_axis"
       using x poincare_line_0_real_is_x_axis[of "of_complex x"]
       unfolding circline_set_x_axis
       by auto
     have "of_complex x \<in> unit_disc"
       using x
       by (auto simp add: cmod_eq_Re)
     have "of_complex x \<noteq> 0\<^sub>h"
       using \<open>x \<noteq> 0\<close>
       by auto
     show "?P 0\<^sub>h (of_complex x)"
     proof safe
       fix w
       assume "w \<in> unit_disc"
       assume "poincare_collinear {0\<^sub>h, of_complex x, w}"
       hence "w \<in> circline_set x_axis"
         using * unique_poincare_line[of "0\<^sub>h" "of_complex x"] \<open>of_complex x \<in> unit_disc\<close> \<open>x \<noteq> 0\<close> \<open>of_complex x \<noteq> 0\<^sub>h\<close>
         unfolding poincare_collinear_def
         by auto
       then obtain w' where w': "w = of_complex w'" "is_real w'"
         using \<open>w \<in> unit_disc\<close>
         using inf_or_of_complex[of w]
         unfolding circline_set_x_axis
         by auto
       hence "-1 < Re w'" "Re w' < 1"
         using \<open>w \<in> unit_disc\<close>
         by (auto simp add: cmod_eq_Re)
       assume 1: "\<not> poincare_between (of_complex x) 0\<^sub>h w"
       hence "w \<noteq> 0\<^sub>h" "w' \<noteq> 0"
         using w'
         unfolding poincare_between_def
         by auto
       hence "Re w' \<noteq> 0"
         using w' complex.expand[of w' 0]
         by auto
 
       have "Re w' \<ge> 0"
         using 1 poincare_between_x_axis_u0v[of x w'] \<open>Re x > 0\<close> \<open>is_real x\<close> \<open>x \<noteq> 0\<close> \<open>w' \<noteq> 0\<close> w'
         using mult_pos_neg
         by force
 
       moreover
 
       assume "\<not> poincare_between 0\<^sub>h (of_complex x) w"
       hence "Re w' < Re x"
         using poincare_between_x_axis_0uv[of "Re x" "Re w'"]
         using w' x \<open>-1 < Re w'\<close> \<open>Re w' < 1\<close> \<open>Re w' \<noteq> 0\<close>
         by auto
 
       ultimately
       show "poincare_between 0\<^sub>h w (of_complex x)"
         using poincare_between_x_axis_0uv[of "Re w'" "Re x"]
         using w' x \<open>-1 < Re w'\<close> \<open>Re w' < 1\<close> \<open>Re w' \<noteq> 0\<close>
         by auto
     qed
   next
     show "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
       by fact+
   next
     fix M u v
     assume 1: "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
     let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v"
     assume 2: "?P ?Mu ?Mv"
     show "?P u v"
     proof safe
       fix w
       assume "w \<in> unit_disc" "poincare_collinear {u, v, w}" "\<not> poincare_between u v w" "\<not> poincare_between v u w"
       thus "poincare_between u w v"
         using 1 2[rule_format, of "moebius_pt M w"]
         by simp
     qed
   qed
   thus ?thesis
     using assms
     by simp
 qed
 
 lemma poincare_collinear3_iff:
   assumes "u \<in> unit_disc" "v \<in> unit_disc"  "w \<in> unit_disc"
   shows "poincare_collinear {u, v, w} \<longleftrightarrow> poincare_between u v w \<or> poincare_between v u w \<or> poincare_between v w u"
   using assms 
   by (metis poincare_collinear3_between insert_commute poincare_between_poincare_collinear poincare_between_rev)
 
 subsection \<open>Some properties of betweenness\<close>
 
 lemma poincare_between_transitivity:
   assumes "a \<in> unit_disc" and "x \<in> unit_disc" and "b \<in> unit_disc" and "y \<in> unit_disc" and
           "poincare_between a x b" and "poincare_between a b y"
   shows "poincare_between x b y"
 proof(cases "a = b")
   case True
   thus ?thesis
     using assms
     using poincare_between_sandwich by blast
 next
   case False
   have "\<forall> x. \<forall> y. poincare_between a x b \<and> poincare_between a b y \<and> x \<in> unit_disc
                   \<and> y \<in> unit_disc \<longrightarrow> poincare_between x b y" (is "?P a b")
   proof (rule wlog_positive_x_axis[where P="?P"])
     show "a \<in> unit_disc"
       using assms by simp
   next
     show "b \<in> unit_disc"
       using assms by simp
   next
     show "a \<noteq> b"
       using False by simp
   next
     fix M u v
     assume *: "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v" 
               "\<forall>x y. poincare_between (moebius_pt M u) x (moebius_pt M v) \<and> 
                   poincare_between (moebius_pt M u) (moebius_pt M v) y \<and>
                   x \<in> unit_disc \<and> y \<in> unit_disc \<longrightarrow>
                   poincare_between x (moebius_pt M v) y"
     show "\<forall>x y. poincare_between u x v \<and> poincare_between u v y \<and> x \<in> unit_disc \<and> y \<in> unit_disc 
                 \<longrightarrow> poincare_between x v y"
     proof safe
       fix x y
       assume "poincare_between u x v" "poincare_between u v y" " x \<in> unit_disc" "y \<in> unit_disc"
 
       have "poincare_between (moebius_pt M u) (moebius_pt M x) (moebius_pt M v)" 
         using \<open>poincare_between u x v\<close> \<open>unit_disc_fix M\<close> \<open>x \<in> unit_disc\<close> \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close>
         by simp
       moreover
       have "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M y)"
         using \<open>poincare_between u v y\<close> \<open>unit_disc_fix M\<close> \<open>y \<in> unit_disc\<close> \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close>
         by simp
       moreover
       have "(moebius_pt M x) \<in> unit_disc"
         using \<open>unit_disc_fix M\<close> \<open>x \<in> unit_disc\<close> by simp
       moreover
       have "(moebius_pt M y) \<in> unit_disc"
         using \<open>unit_disc_fix M\<close> \<open>y \<in> unit_disc\<close> by simp
       ultimately
       have "poincare_between (moebius_pt M x) (moebius_pt M v) (moebius_pt M y)"
         using * by blast
       thus "poincare_between x v y"
         using \<open>y \<in> unit_disc\<close> * \<open>x \<in> unit_disc\<close> by simp
     qed
   next
     fix x
     assume xx: "is_real x" "0 < Re x" "Re x < 1"
     hence "of_complex x \<in> unit_disc"
       using cmod_eq_Re by auto
     hence "of_complex x \<noteq> \<infinity>\<^sub>h"
       by simp
     have " of_complex x \<noteq> 0\<^sub>h"
       using xx by auto
     have "of_complex x \<in> circline_set x_axis"
       using xx by simp
     show "\<forall>m n. poincare_between 0\<^sub>h m (of_complex x) \<and> poincare_between 0\<^sub>h (of_complex x) n \<and>
             m \<in> unit_disc \<and> n \<in> unit_disc \<longrightarrow> poincare_between m (of_complex x) n"
     proof safe
       fix m n
       assume **: "poincare_between 0\<^sub>h m (of_complex x)" "poincare_between 0\<^sub>h (of_complex x) n"
                  "m \<in> unit_disc" " n \<in> unit_disc"
       show "poincare_between m (of_complex x) n"
       proof(cases "m = 0\<^sub>h")
         case True
         thus ?thesis
           using ** by auto
       next
         case False
         hence "m \<in> circline_set x_axis"
           using poincare_between_poincare_line_uzv[of "0\<^sub>h" "of_complex x" m]
           using poincare_line_0_real_is_x_axis[of "of_complex x"] 
           using \<open>of_complex x \<in> unit_disc\<close> \<open>of_complex x \<noteq> \<infinity>\<^sub>h\<close> \<open>of_complex x \<noteq> 0\<^sub>h\<close>
           using \<open>of_complex x \<in> circline_set x_axis\<close> \<open>m \<in> unit_disc\<close> **(1)
           by simp
         then obtain m' where "m = of_complex m'" "is_real m'"
           using inf_or_of_complex[of m] \<open>m \<in> unit_disc\<close>
           unfolding circline_set_x_axis
           by auto
         hence "Re m' \<le> Re x"
           using \<open>poincare_between 0\<^sub>h m (of_complex x)\<close> xx \<open>of_complex x \<noteq> 0\<^sub>h\<close>
           using False ** \<open>of_complex x \<in> unit_disc\<close>
           using cmod_Re_le_iff poincare_between_0uv by auto
  
         have "n \<noteq> 0\<^sub>h"
           using **(2, 4) \<open>of_complex x \<noteq> 0\<^sub>h\<close> \<open>of_complex x \<in> unit_disc\<close>
           using poincare_between_sandwich by fastforce
         have "n \<in> circline_set x_axis"
           using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex x" n]
           using poincare_line_0_real_is_x_axis[of "of_complex x"] 
           using \<open>of_complex x \<in> unit_disc\<close> \<open>of_complex x \<noteq> \<infinity>\<^sub>h\<close> \<open>of_complex x \<noteq> 0\<^sub>h\<close>
           using \<open>of_complex x \<in> circline_set x_axis\<close> \<open>n \<in> unit_disc\<close> **(2)
           by simp
         then obtain n' where "n = of_complex n'" "is_real n'"
           using inf_or_of_complex[of n] \<open>n \<in> unit_disc\<close>
           unfolding circline_set_x_axis
           by auto
         hence "Re x \<le> Re n'"
           using \<open>poincare_between 0\<^sub>h (of_complex x) n\<close> xx \<open>of_complex x \<noteq> 0\<^sub>h\<close>
           using False ** \<open>of_complex x \<in> unit_disc\<close> \<open>n \<noteq> 0\<^sub>h\<close>
           using cmod_Re_le_iff poincare_between_0uv
-          by (metis Re_complex_of_real arg_0_iff rcis_cmod_arg rcis_zero_arg to_complex_of_complex)
+          by (metis Re_complex_of_real arg_0_iff rcis_cmod_Arg rcis_zero_arg to_complex_of_complex)
         
         have "poincare_between (of_complex m') (of_complex x) (of_complex n')" 
           using \<open>Re x \<le> Re n'\<close> \<open>Re m' \<le> Re x\<close>
           using poincare_between_x_axis_uvw[of "Re m'" "Re x" "Re n'"]
           using \<open>is_real n'\<close> \<open>is_real m'\<close> \<open>n \<in> unit_disc\<close> \<open>n = of_complex n'\<close>
           using xx \<open>m = of_complex m'\<close> \<open>m \<in> unit_disc\<close>
           by (smt complex_of_real_Re norm_of_real poincare_between_def unit_disc_iff_cmod_lt_1)
 
         thus ?thesis
           using \<open>n = of_complex n'\<close> \<open>m = of_complex m'\<close>
           by auto
       qed
     qed
   qed 
   thus ?thesis
     using assms
     by blast
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Poincare between - sum distances\<close>
 (* ------------------------------------------------------------------ *)
 
 text\<open>Another possible definition of the h-betweenness relation is given in terms of h-distances
 between pairs of points. We prove it as a characterization equivalent to our cross-ratio based
 definition.\<close>
 
 lemma poincare_between_sum_distances_x_axis_u0v:
   assumes "of_complex u' \<in> unit_disc" "of_complex v' \<in> unit_disc"
   assumes "is_real u'" "u' \<noteq> 0" "v' \<noteq> 0"
   shows  "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') = poincare_distance (of_complex u') (of_complex v') \<longleftrightarrow>
           is_real v' \<and> Re u' * Re v' < 0" (is "?P u' v' \<longleftrightarrow> ?Q u' v'")
 proof-
   have "Re u' \<noteq> 0"
     using \<open>is_real u'\<close> \<open>u' \<noteq> 0\<close>
     using complex_eq_if_Re_eq
     by simp
 
   let ?u = "cmod u'" and ?v = "cmod v'" and ?uv = "cmod (u' - v')"
   have disc: "?u\<^sup>2 < 1" "?v\<^sup>2 < 1"
     using unit_disc_cmod_square_lt_1[OF assms(1)]
     using unit_disc_cmod_square_lt_1[OF assms(2)]
     by auto
   have "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') =
               arcosh (((1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v) / ((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2)))" (is "_ = arcosh ?r1")
           using poincare_distance_formula_zero_sum[OF assms(1-2)]
           by (simp add: Let_def)
   moreover
   have "poincare_distance (of_complex u') (of_complex v') =
               arcosh (((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) + 2 * ?uv\<^sup>2) / ((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2)))" (is "_ = arcosh ?r2")
     using disc
     using poincare_distance_formula[OF assms(1-2)]
     by (subst add_divide_distrib) simp
   moreover
   have "arcosh ?r1 = arcosh ?r2 \<longleftrightarrow> ?Q u' v'"
   proof
     assume "arcosh ?r1 = arcosh ?r2"
     hence "?r1 = ?r2"
     proof (subst (asm) arcosh_eq_iff)
       show "?r1 \<ge> 1"
       proof-
         have "(1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) \<le> (1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v"
           by (simp add: field_simps)
         thus ?thesis
           using disc
           by simp
       qed
     next
       show "?r2 \<ge> 1"
         using disc
         by simp
     qed
     hence "(1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v = (1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) + 2 * ?uv\<^sup>2"
       using disc
       by auto              
     hence "(cmod (u' - v'))\<^sup>2 = (cmod u' + cmod v')\<^sup>2"
       by (simp add: field_simps power2_eq_square)
     hence *: "Re u' * Re v' + \<bar>Re u'\<bar> * sqrt ((Im v')\<^sup>2 + (Re v')\<^sup>2) = 0"
       using \<open>is_real u'\<close>
       unfolding cmod_power2 cmod_def
       by (simp add: field_simps) (simp add: power2_eq_square field_simps)
     hence "sqrt ((Im v')\<^sup>2 + (Re v')\<^sup>2) = \<bar>Re v'\<bar>"
       using \<open>Re u' \<noteq> 0\<close> \<open>v' \<noteq> 0\<close>
       by (smt complex_neq_0 mult.commute mult_cancel_right mult_minus_left real_sqrt_gt_0_iff)
     hence "Im v' = 0"
       by (smt Im_eq_0 norm_complex_def)
     moreover
     hence "Re u' * Re v' = - \<bar>Re u'\<bar> * \<bar>Re v'\<bar>"
       using *
       by simp
     hence "Re u' * Re v' < 0"
       using \<open>Re u' \<noteq> 0\<close> \<open>v' \<noteq> 0\<close>
       by (simp add: \<open>is_real v'\<close> complex_eq_if_Re_eq)
     ultimately
     show "?Q u' v'"
       by simp
   next
     assume "?Q u' v'"
     hence "is_real v'" "Re u' * Re v' < 0"
       by auto
     have "?r1 = ?r2"
     proof (cases "Re u' > 0")
       case True
       hence "Re v' < 0"
         using \<open>Re u' * Re v' < 0\<close>
         by (smt zero_le_mult_iff)
       show ?thesis
         using disc \<open>is_real u'\<close> \<open>is_real v'\<close>
         using \<open>Re u' > 0\<close> \<open>Re v' < 0\<close>
         unfolding cmod_power2 cmod_def
         by simp (simp add: power2_eq_square field_simps)
     next
       case False
       hence "Re u' < 0"
         using \<open>Re u' \<noteq> 0\<close>
         by simp
       hence "Re v' > 0"
         using \<open>Re u' * Re v' < 0\<close>
         by (smt zero_le_mult_iff)
       show ?thesis
         using disc \<open>is_real u'\<close> \<open>is_real v'\<close>
         using \<open>Re u' < 0\<close> \<open>Re v' > 0\<close>
         unfolding cmod_power2 cmod_def
         by simp (simp add: power2_eq_square field_simps)
     qed
     thus "arcosh ?r1 = arcosh ?r2"
       by metis
   qed
   ultimately
   show ?thesis
     by simp
 qed
 
 text\<open>
   Different proof of the previous theorem relying on the cross-ratio definition, and not the distance formula.
   We suppose that this could be also used to prove the triangle inequality.
 \<close>
 lemma poincare_between_sum_distances_x_axis_u0v_different_proof:
   assumes "of_complex u' \<in> unit_disc" "of_complex v' \<in> unit_disc"
   assumes "is_real u'" "u' \<noteq> 0" "v' \<noteq> 0" (* additional condition *) "is_real v'"
   shows  "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') = poincare_distance (of_complex u') (of_complex v') \<longleftrightarrow>
           Re u' * Re v' < 0" (is "?P u' v' \<longleftrightarrow> ?Q u' v'")
 proof-
   have "-1 < Re u'" "Re u' < 1" "Re u' \<noteq> 0"
     using assms
     by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq)
   have "-1 < Re v'" "Re v' < 1" "Re v' \<noteq> 0"
     using assms
     by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq)
 
   have "\<bar>ln (Re ((1 - u') / (1 + u')))\<bar> + \<bar>ln (Re ((1 - v') / (1 + v')))\<bar> =
         \<bar>ln (Re ((1 + u') * (1 - v') / ((1 - u') * (1 + v'))))\<bar> \<longleftrightarrow> Re u' * Re v' < 0" (is "\<bar>ln ?a1\<bar>  + \<bar>ln ?a2\<bar> = \<bar>ln ?a3\<bar> \<longleftrightarrow> _")
   proof-
     have 1: "0 < ?a1" "ln ?a1 > 0 \<longleftrightarrow> Re u' < 0"
       using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
       using complex_is_Real_iff
       by auto
     have 2: "0 < ?a2" "ln ?a2 > 0 \<longleftrightarrow> Re v' < 0"
       using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
       using complex_is_Real_iff
       by auto
     have 3: "0 < ?a3" "ln ?a3 > 0 \<longleftrightarrow> Re v' < Re u'"
       using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
       using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
       using complex_is_Real_iff
        by auto (simp add: field_simps)+
     show ?thesis
     proof
       assume *: "Re u' * Re v' < 0"
       show "\<bar>ln ?a1\<bar> + \<bar>ln ?a2\<bar> = \<bar>ln ?a3\<bar>"
       proof (cases "Re u' > 0")
         case True
         hence "Re v' < 0"
           using *
           by (smt mult_nonneg_nonneg)
         show ?thesis
           using 1 2 3 \<open>Re u' > 0\<close> \<open>Re v' < 0\<close>
           using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
           using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
           using complex_is_Real_iff
           using ln_div ln_mult
           by simp
       next
         case False
         hence "Re v' > 0" "Re u' < 0"
           using *
           by (smt zero_le_mult_iff)+
         show ?thesis
           using 1 2 3 \<open>Re u' < 0\<close> \<open>Re v' > 0\<close>
           using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
           using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
           using complex_is_Real_iff
           using ln_div ln_mult
           by simp
       qed
     next
       assume *: "\<bar>ln ?a1\<bar> + \<bar>ln ?a2\<bar> = \<bar>ln ?a3\<bar>"
       {
         assume "Re u' > 0" "Re v' > 0"
         hence False
           using * 1 2 3
           using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
           using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
           using complex_is_Real_iff
           using ln_mult ln_div
           by (cases "Re v' < Re u'") auto
       }
       moreover
       {
         assume "Re u' < 0" "Re v' < 0"
         hence False
           using * 1 2 3
           using \<open>Re u' < 1\<close> \<open>Re u' > -1\<close> \<open>is_real u'\<close>
           using \<open>Re v' < 1\<close> \<open>Re v' > -1\<close> \<open>is_real v'\<close>
           using complex_is_Real_iff
           using ln_mult ln_div
           by (cases "Re v' < Re u'") auto
       }
       ultimately
       show "Re u' * Re v' < 0"
         using \<open>Re u' \<noteq> 0\<close> \<open>Re v' \<noteq> 0\<close>
         by (smt divisors_zero mult_le_0_iff)
     qed
   qed
   thus ?thesis
     using assms
     apply (subst poincare_distance_sym, simp, simp)
     apply (subst poincare_distance_zero_x_axis, simp, simp add: circline_set_x_axis)
     apply (subst poincare_distance_zero_x_axis, simp, simp add: circline_set_x_axis)
     apply (subst poincare_distance_x_axis_x_axis, simp, simp, simp add: circline_set_x_axis, simp add: circline_set_x_axis)
     apply simp
     done
 qed
 
 lemma poincare_between_sum_distances:
   assumes "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   shows "poincare_between u v w \<longleftrightarrow> 
          poincare_distance u v + poincare_distance v w = poincare_distance u w" (is "?P' u v w")
 proof (cases "u = v")
   case True
   thus ?thesis
     using assms
     by simp
 next
   case False
   have "\<forall> w. w \<in> unit_disc \<longrightarrow> (poincare_between u v w \<longleftrightarrow> poincare_distance u v + poincare_distance v w = poincare_distance u w)" (is "?P u v")
   proof (rule wlog_positive_x_axis)
     fix x
     assume "is_real x" "0 < Re x" "Re x < 1"
     have "of_complex x \<in> circline_set x_axis"
       using \<open>is_real x\<close>
       by (auto simp add: circline_set_x_axis)
 
     have "of_complex x \<in> unit_disc"
       using \<open>is_real x\<close> \<open>0 < Re x\<close> \<open>Re x < 1\<close>
       by (simp add: cmod_eq_Re)
 
     have "x \<noteq> 0"
       using \<open>is_real x\<close> \<open>Re x > 0\<close>
       by auto
 
     show "?P (of_complex x) 0\<^sub>h"
     proof (rule allI, rule impI)
       fix w
       assume "w \<in> unit_disc"
       then obtain w' where "w = of_complex w'"
         using inf_or_of_complex[of w]
         by auto
 
       show "?P' (of_complex x) 0\<^sub>h w"
       proof (cases "w = 0\<^sub>h")
         case True
         thus ?thesis
           by simp
       next
         case False
         hence "w' \<noteq> 0"
           using \<open>w = of_complex w'\<close>
           by auto
 
         show ?thesis
           using \<open>is_real x\<close> \<open>x \<noteq> 0\<close> \<open>w = of_complex w'\<close> \<open>w' \<noteq> 0\<close>
           using \<open>of_complex x \<in> unit_disc\<close> \<open>w \<in> unit_disc\<close>
           apply simp
           apply (subst poincare_between_x_axis_u0v, simp_all)
           apply (subst poincare_between_sum_distances_x_axis_u0v, simp_all)
           done
       qed
     qed
   next
     show "v \<in> unit_disc" "u \<in> unit_disc"
       using assms
       by auto
   next
     show "v \<noteq> u"
       using \<open>u \<noteq> v\<close>
       by simp
   next
     fix M u v
     assume *: "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v" and
           **: "?P (moebius_pt M v) (moebius_pt M u)"
     show "?P v u"
     proof (rule allI, rule impI)
       fix w
       assume "w \<in> unit_disc"
       hence "moebius_pt M w \<in> unit_disc"
         using \<open>unit_disc_fix M\<close>
         by auto
       thus "?P' v u w"
         using \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close> \<open>w \<in> unit_disc\<close> \<open>unit_disc_fix M\<close>
         using **[rule_format, of "moebius_pt M w"]
         by auto
     qed
   qed
   thus ?thesis
     using assms
     by simp
 qed
 
 subsection \<open>Some more properties of h-betweenness.\<close>
 
 text \<open>Some lemmas proved earlier are proved almost directly using the sum of distances characterization.\<close>
 
 lemma unit_disc_fix_moebius_preserve_poincare_between':
   assumes "unit_disc_fix M" and "u \<in> unit_disc" and "v \<in> unit_disc" and "w \<in> unit_disc"
   shows "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \<longleftrightarrow>
          poincare_between u v w"
   using assms
   using poincare_between_sum_distances
   by simp
 
 lemma conjugate_preserve_poincare_between':
   assumes "u \<in> unit_disc" "v \<in> unit_disc" "w \<in> unit_disc"
   shows "poincare_between (conjugate u) (conjugate v) (conjugate w) \<longleftrightarrow> poincare_between u v w"
   using assms
   using poincare_between_sum_distances
   by simp
 
 text \<open>There is a unique point on a ray on the given distance from the given starting point\<close>
 lemma unique_poincare_distance_on_ray:
   assumes "d \<ge> 0" "u \<noteq> v" "u \<in> unit_disc" "v \<in> unit_disc"
   assumes "y \<in> unit_disc" "poincare_distance u y = d" "poincare_between u v y"
   assumes "z \<in> unit_disc" "poincare_distance u z = d" "poincare_between u v z"
   shows "y = z"
 proof-
   have "\<forall> d y z. d \<ge> 0 \<and>
         y \<in> unit_disc \<and> poincare_distance u y = d \<and> poincare_between u v y \<and>
         z \<in> unit_disc \<and> poincare_distance u z = d \<and> poincare_between u v z \<longrightarrow> y = z" (is "?P u v")
   proof (rule wlog_positive_x_axis[where P="?P"])
     fix x
     assume x: "is_real x" "0 < Re x" "Re x < 1"
     hence "x \<noteq> 0"
       using complex.expand[of x 0]
       by auto
     hence *: "poincare_line 0\<^sub>h (of_complex x) = x_axis"
       using x poincare_line_0_real_is_x_axis[of "of_complex x"]
       unfolding circline_set_x_axis
       by auto
     have "of_complex x \<in> unit_disc"
       using x
       by (auto simp add: cmod_eq_Re)
     have "arg x = 0"
       using x
       using arg_0_iff by blast
     show "?P 0\<^sub>h (of_complex x)"
     proof safe
       fix y z
       assume "y \<in> unit_disc" "z \<in> unit_disc"
       then obtain y' z' where yz: "y = of_complex y'" "z = of_complex z'"
         using inf_or_of_complex[of y] inf_or_of_complex[of z]
         by auto
       assume betw: "poincare_between 0\<^sub>h (of_complex x) y"  "poincare_between 0\<^sub>h (of_complex x) z"
       hence "y \<noteq> 0\<^sub>h" "z \<noteq> 0\<^sub>h"
         using \<open>x \<noteq> 0\<close> \<open>of_complex x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close>
         using poincare_between_sandwich[of "0\<^sub>h" "of_complex x"]
         using of_complex_zero_iff[of x]
         by force+
 
       hence "arg y' = 0" "cmod y' \<ge> cmod x" "arg z' = 0" "cmod z' \<ge> cmod x"
         using poincare_between_0uv[of "of_complex x" y] poincare_between_0uv[of "of_complex x" z]
         using \<open>of_complex x \<in> unit_disc\<close> \<open>x \<noteq> 0\<close> \<open>arg x = 0\<close> \<open>y \<in> unit_disc\<close> \<open>z \<in> unit_disc\<close> betw yz
         by (simp_all add: Let_def)
       hence *: "is_real y'" "is_real z'" "Re y' > 0" "Re z' > 0"
         using arg_0_iff[of y'] arg_0_iff[of z'] x \<open>y \<noteq> 0\<^sub>h\<close> \<open>z \<noteq> 0\<^sub>h\<close> yz
         by auto
       assume "poincare_distance 0\<^sub>h z = poincare_distance 0\<^sub>h y" "0 \<le> poincare_distance 0\<^sub>h y"
       thus "y = z"
         using * yz \<open>y \<in> unit_disc\<close> \<open>z \<in> unit_disc\<close>
         using unique_x_axis_poincare_distance_positive[of "poincare_distance 0\<^sub>h y"]
         by (auto simp add: cmod_eq_Re unit_disc_to_complex_inj)
     qed
   next
     show "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
       by fact+
   next
     fix M u v
     assume *: "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
     assume **: "?P (moebius_pt M u) (moebius_pt M v)"
     show "?P u v"
     proof safe
       fix d y z
       assume ***: "0 \<le> poincare_distance u y"
              "y \<in> unit_disc" "poincare_between u v y"
              "z \<in> unit_disc" "poincare_between u v z"
              "poincare_distance u z = poincare_distance u y"
       let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" and ?My = "moebius_pt M y" and ?Mz = "moebius_pt M z"
       have "?Mu \<in> unit_disc" "?Mv \<in> unit_disc" "?My \<in> unit_disc" "?Mz \<in> unit_disc"
         using \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>z \<in> unit_disc\<close>
         using \<open>unit_disc_fix M\<close>
         by auto
       hence "?My = ?Mz"
         using * ***
         using **[rule_format, of "poincare_distance ?Mu ?My" ?My ?Mz]
         by simp
       thus "y = z"
         using bij_moebius_pt[of M]
         unfolding bij_def inj_on_def
         by blast
     qed
   qed
   thus ?thesis
     using assms
     by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Poincare_Disc/Poincare_Tarski.thy b/thys/Poincare_Disc/Poincare_Tarski.thy
--- a/thys/Poincare_Disc/Poincare_Tarski.thy
+++ b/thys/Poincare_Disc/Poincare_Tarski.thy
@@ -1,3044 +1,3044 @@
 section \<open>Poincar\'e model satisfies Tarski axioms\<close>
 
 theory Poincare_Tarski
   imports Poincare Poincare_Lines_Axis_Intersections Tarski
 begin
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Pasch axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma Pasch_fun_mono:
   fixes r1 r2 :: real
   assumes "0 < r1" and "r1 \<le> r2" and "r2 < 1"
   shows "r1 + 1/r1 \<ge> r2 + 1/r2"
 proof (cases "r1 = r2")
   case True
   thus ?thesis
     by simp
 next
   case False
   hence "r2 - r1 > 0"
     using assms
     by simp
 
   have "r1 * r2 < 1"
     using assms
     by (smt mult_le_cancel_left1)
   hence "1 / (r1 * r2) > 1"
     using assms
     by simp
   hence "(r2 - r1) / (r1 * r2) > (r2 - r1)"
     using \<open>r2 - r1 > 0\<close>
     using mult_less_cancel_left_pos[of "r2 - r1" 1 "1 / (r1 * r2)"]
     by simp
   hence "1 / r1 - 1 / r2 > r2 - r1"
     using assms
     by (simp add: field_simps)
   thus ?thesis
     by simp
 qed
 
 text\<open>Pasch axiom, non-degenerative case.\<close>
 lemma Pasch_nondeg:
   assumes "x \<in> unit_disc" and "y \<in> unit_disc" and "z \<in> unit_disc" and "u \<in> unit_disc" and "v \<in> unit_disc"
   assumes "distinct [x, y, z, u, v]" 
   assumes "\<not> poincare_collinear {x, y, z}" 
   assumes "poincare_between x u z" and "poincare_between y v z"
   shows "\<exists> a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between x a v"
 proof-
   have "\<forall> y z u. distinct [x, y, z, u, v] \<and> \<not> poincare_collinear {x, y, z} \<and> y \<in> unit_disc \<and> z \<in> unit_disc \<and> u \<in> unit_disc \<and>
                  poincare_between x u z \<and> poincare_between y v z \<longrightarrow> (\<exists> a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between x a v)" (is "?P x v")
   proof (rule wlog_positive_x_axis[where P="?P"])
     fix v
     assume v: "is_real v" "0 < Re v" "Re v < 1"
     hence "of_complex v \<in> unit_disc"
       by (auto simp add: cmod_eq_Re)
     show "?P 0\<^sub>h (of_complex v)"
     proof safe
       fix y z u
       assume distinct: "distinct [0\<^sub>h, y, z, u, of_complex v]"
       assume in_disc: "y \<in> unit_disc" "z \<in> unit_disc" "u \<in> unit_disc"
       then obtain y' z' u'
         where *: "y = of_complex y'" "z = of_complex z'" "u = of_complex u'"
         using inf_or_of_complex inf_notin_unit_disc
         by metis
 
       have "y' \<noteq> 0" "z' \<noteq> 0" "u' \<noteq> 0" "v \<noteq> 0" "y' \<noteq> z'" "y' \<noteq> u'" "z' \<noteq> u'" "y \<noteq> z" "y \<noteq> u" "z \<noteq> u"
         using of_complex_inj distinct *
         by auto
 
       note distinct = distinct this
 
       assume "\<not> poincare_collinear {0\<^sub>h, y, z}"
 
       hence nondeg_yz: "y'*cnj z' \<noteq> cnj y' * z'"
         using * poincare_collinear_zero_iff[of y' z'] in_disc distinct
         by auto
 
       assume "poincare_between 0\<^sub>h u z"
 
       hence "arg u' = arg z'" "cmod u' \<le> cmod z'"
         using * poincare_between_0uv[of u z] distinct in_disc
         by auto
 
       then obtain \<phi> ru rz where
         uz_polar: "u' = cor ru * cis \<phi>" "z' = cor rz * cis \<phi>" "0 < ru" "ru \<le> rz" "0 < rz" and
                   "\<phi> = arg u'" "\<phi> = arg z'"
         using * \<open>u' \<noteq> 0\<close> \<open>z' \<noteq> 0\<close>
         by (smt cmod_cis norm_le_zero_iff)
 
       obtain \<theta> ry where
         y_polar: "y' = cor ry * cis \<theta>" "ry > 0" and "\<theta> = arg y'"
         using \<open>y' \<noteq> 0\<close>
         by (smt cmod_cis norm_le_zero_iff)
 
       from in_disc * \<open>u' = cor ru * cis \<phi>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>y' = cor ry * cis \<theta>\<close>
       have "ru < 1" "rz < 1" "ry < 1"
         by (auto simp: norm_mult)
 
       note polar = this y_polar uz_polar
 
       have nondeg: "cis \<theta> * cis (- \<phi>) \<noteq> cis (- \<theta>) * cis \<phi>"
         using nondeg_yz polar
         by simp
 
       let ?yz = "poincare_line y z"
       let ?v = "calc_x_axis_intersection ?yz"
 
       assume "poincare_between y (of_complex v) z"
 
       hence "of_complex v \<in> circline_set ?yz"
         using in_disc \<open>of_complex v \<in> unit_disc\<close>
         using distinct poincare_between_poincare_collinear[of y "of_complex v" z]
         using unique_poincare_line[of y z]
         by (auto simp add: poincare_collinear_def)
       moreover
       have "of_complex v \<in> circline_set x_axis"
         using \<open>is_real v\<close>
         unfolding circline_set_x_axis
         by auto
       moreover
       have "?yz \<noteq> x_axis"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         hence "{0\<^sub>h, y, z} \<subseteq> circline_set (poincare_line y z)"
           unfolding circline_set_def
           using distinct poincare_line[of y z]
           by auto
         hence "poincare_collinear {0\<^sub>h, y, z}"
           unfolding poincare_collinear_def
           using distinct
           by force
         thus False
           using \<open>\<not> poincare_collinear {0\<^sub>h, y, z}\<close>
           by simp
       qed
       ultimately
       have "?v = of_complex v" "intersects_x_axis ?yz"
         using unique_calc_x_axis_intersection[of "poincare_line y z" "of_complex v"]
         using intersects_x_axis_iff[of ?yz]
         using distinct \<open>of_complex v \<in> unit_disc\<close>
         by (metis IntI is_poincare_line_poincare_line)+
 
       have "intersects_x_axis_positive ?yz"
         using \<open>Re v > 0\<close> \<open>of_complex v \<in> unit_disc\<close>
         using \<open>of_complex v \<in> circline_set ?yz\<close> \<open>of_complex v \<in> circline_set x_axis\<close>
         using intersects_x_axis_positive_iff[of ?yz] \<open>y \<noteq> z\<close> \<open>?yz \<noteq> x_axis\<close>
         unfolding positive_x_axis_def
         by force
 
       have "y \<notin> circline_set x_axis"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         moreover
         hence "poincare_line y (of_complex v) = x_axis"
           using distinct \<open>of_complex v \<in> circline_set x_axis\<close>
           using in_disc \<open>of_complex v \<in> unit_disc\<close>
           using unique_poincare_line[of y "of_complex v" x_axis]
           by simp
         moreover
         have "z \<in> circline_set (poincare_line y (of_complex v))"
           using \<open>of_complex v \<in> circline_set ?yz\<close>
           using unique_poincare_line[of y "of_complex v" "poincare_line y z"]
           using in_disc \<open>of_complex v \<in> unit_disc\<close> distinct
           using poincare_line[of y z]
           unfolding circline_set_def
           by (metis distinct_length_2_or_more is_poincare_line_poincare_line mem_Collect_eq)
         ultimately
         have "y \<in> circline_set x_axis" "z \<in> circline_set x_axis"
           by auto
         hence "poincare_collinear {0\<^sub>h, y, z}"
           unfolding poincare_collinear_def
           by force
         thus False
           using \<open>\<not> poincare_collinear {0\<^sub>h, y, z}\<close>
           by simp
       qed
 
       moreover
 
       have "z \<notin> circline_set x_axis"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         moreover
         hence "poincare_line z (of_complex v) = x_axis"
           using distinct \<open>of_complex v \<in> circline_set x_axis\<close>
           using in_disc \<open>of_complex v \<in> unit_disc\<close>
           using unique_poincare_line[of z "of_complex v" x_axis]
           by simp
         moreover
         have "y \<in> circline_set (poincare_line z (of_complex v))"
           using \<open>of_complex v \<in> circline_set ?yz\<close>
           using unique_poincare_line[of z "of_complex v" "poincare_line y z"]
           using in_disc \<open>of_complex v \<in> unit_disc\<close> distinct
           using poincare_line[of y z]
           unfolding circline_set_def
           by (metis distinct_length_2_or_more is_poincare_line_poincare_line mem_Collect_eq)
         ultimately
         have "y \<in> circline_set x_axis" "z \<in> circline_set x_axis"
           by auto
         hence "poincare_collinear {0\<^sub>h, y, z}"
           unfolding poincare_collinear_def
           by force
         thus False
           using \<open>\<not> poincare_collinear {0\<^sub>h, y, z}\<close>
           by simp
       qed
 
       ultimately
 
       have "\<phi> * \<theta> < 0"
         using \<open>poincare_between y (of_complex v) z\<close>
         using poincare_between_x_axis_intersection[of y z "of_complex v"]
         using in_disc \<open>of_complex v \<in> unit_disc\<close> distinct
         using \<open>of_complex v \<in> circline_set ?yz\<close> \<open>of_complex v \<in> circline_set x_axis\<close>
         using \<open>\<phi> = arg z'\<close> \<open>\<theta> = arg y'\<close> *
         by (simp add: field_simps)
 
       have "\<phi> \<noteq> pi" "\<phi> \<noteq> 0"
         using \<open>z \<notin> circline_set x_axis\<close> * polar cis_pi
         unfolding circline_set_x_axis
         by auto
 
       have "\<theta> \<noteq> pi" "\<theta> \<noteq> 0"
         using \<open>y \<notin> circline_set x_axis\<close> * polar cis_pi
         unfolding circline_set_x_axis
         by auto
 
       have phi_sin: "\<phi> > 0 \<longleftrightarrow> sin \<phi> > 0" "\<phi> < 0 \<longleftrightarrow> sin \<phi> < 0"
         using \<open>\<phi> = arg z'\<close> \<open>\<phi> \<noteq> 0\<close> \<open>\<phi> \<noteq> pi\<close>
-        using arg_bounded[of z']
+        using Arg_bounded[of z']
         by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
 
       have theta_sin: "\<theta> > 0 \<longleftrightarrow> sin \<theta> > 0" "\<theta> < 0 \<longleftrightarrow> sin \<theta> < 0"
         using \<open>\<theta> = arg y'\<close> \<open>\<theta> \<noteq> 0\<close> \<open>\<theta> \<noteq> pi\<close>
-        using arg_bounded[of y']
+        using Arg_bounded[of y']
         by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
 
       have "sin \<phi> * sin \<theta> < 0"
         using \<open>\<phi> * \<theta> < 0\<close> phi_sin theta_sin
         by (simp add: mult_less_0_iff)
 
       have "sin (\<phi> - \<theta>) \<noteq> 0"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         hence "sin (\<phi> - \<theta>) = 0"
           by simp
         have "- 2 * pi < \<phi> - \<theta>" "\<phi> - \<theta> < 2 * pi"
-          using \<open>\<phi> = arg z'\<close> \<open>\<theta> = arg y'\<close> arg_bounded[of z'] arg_bounded[of y'] \<open>\<phi> \<noteq> pi\<close> \<open>\<theta> \<noteq> pi\<close>
+          using \<open>\<phi> = arg z'\<close> \<open>\<theta> = arg y'\<close> Arg_bounded[of z'] Arg_bounded[of y'] \<open>\<phi> \<noteq> pi\<close> \<open>\<theta> \<noteq> pi\<close>
           by auto
         hence "\<phi> - \<theta> = -pi \<or> \<phi> - \<theta> = 0 \<or> \<phi> - \<theta> = pi"
           using \<open>sin (\<phi> - \<theta>) = 0\<close>
           by (smt sin_0_iff_canon sin_periodic_pi2)
         moreover
         {
           assume "\<phi> - \<theta> = - pi"
           hence "\<phi> = \<theta> - pi"
             by simp
           hence False
             using nondeg_yz
             using \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>rz > 0\<close> \<open>ry > 0\<close>
             by auto
         }
         moreover
         {
           assume "\<phi> - \<theta> = 0"
           hence "\<phi> = \<theta>"
             by simp
           hence False
             using \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>rz > 0\<close> \<open>ry > 0\<close>
             using nondeg_yz
             by auto
         }
         moreover
         {
           assume "\<phi> - \<theta> = pi"
           hence "\<phi> = \<theta> + pi"
             by simp
           hence False
             using \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>rz > 0\<close> \<open>ry > 0\<close>
             using nondeg_yz
             by auto
         }
         ultimately
         show False
           by auto
       qed
 
       have "u \<notin> circline_set x_axis"
       proof-
         have "\<not> is_real u'"
           using * polar in_disc
           using \<open>\<phi> \<noteq> 0\<close> \<open>\<phi> = arg u'\<close> \<open>\<phi> \<noteq> pi\<close>  phi_sin(1) phi_sin(2)
           by (metis is_real_arg2)
         moreover
         have "u \<noteq> \<infinity>\<^sub>h"
           using in_disc
           by auto
         ultimately
         show ?thesis
           using * of_complex_inj[of u']
           unfolding circline_set_x_axis
           by auto
       qed
 
       let ?yu = "poincare_line y u"
       have nondeg_yu: "y' * cnj u' \<noteq> cnj u' * u'"
         using nondeg_yz polar \<open>ru > 0\<close> \<open>rz > 0\<close> distinct
         by auto
 
       {
         (* derive results simultaneously for both u and z *)
         fix r :: real
         assume "r > 0"
 
         have den: "cor ry * cis \<theta> * cnj 1 * cnj (cor r * cis \<phi>) * 1 - cor r * cis \<phi> * cnj 1 * cnj (cor ry * cis \<theta>) * 1 \<noteq> 0"
           using \<open>0 < r\<close> \<open>0 < ry\<close> nondeg
           by auto
 
         let ?A = "2 * r * ry * sin(\<phi> - \<theta>)"
         let ?B = "\<i> * (r * cis \<phi> * (1 + ry\<^sup>2) - ry * cis \<theta> * (1 + r\<^sup>2))"
         let ?ReB = "ry * (1 + r\<^sup>2) * sin \<theta> - r * (1 + ry\<^sup>2) * sin \<phi>"
 
         have "Re (\<i> * (r * cis (-\<phi>) * ry * cis (\<theta>) - ry * cis (-\<theta>) * r * cis (\<phi>))) = ?A"
           by (simp add: sin_diff field_simps)
         moreover
         have "cor ry * cis (- \<theta>) * (cor ry * cis \<theta>) = ry\<^sup>2"  "cor r * cis (- \<phi>) * (cor r * cis \<phi>) = r\<^sup>2"
           by (metis cis_inverse cis_neq_zero divide_complex_def cor_squared nonzero_mult_div_cancel_right power2_eq_square semiring_normalization_rules(15))+
         ultimately
         have 1: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor r * cis \<phi>)) = (?A, ?B, cnj ?B, ?A)"
           using den
           unfolding poincare_line_cvec_cmat_def of_complex_cvec_def Let_def prod.case
           by (simp add: field_simps)
 
         have 2: "is_real ?A"
           by simp
         let ?mix = "cis \<theta> * cis (- \<phi>) - cis (- \<theta>) * cis \<phi>"
         have "is_imag ?mix"
           using eq_minus_cnj_iff_imag[of ?mix]
           by simp
         hence "Im ?mix \<noteq> 0"
           using nondeg
           using complex.expand[of ?mix 0]
           by auto
         hence 3: "Re ?A \<noteq> 0"
           using \<open>r > 0\<close> \<open>ry > 0\<close>
           by (simp add: sin_diff field_simps)
 
         have "?A \<noteq> 0"
           using 2 3
           by auto
         hence 4: "cor ?A \<noteq> 0"
           using 2 3
           by (metis zero_complex.simps(1))
 
         have 5: "?ReB / ?A = (sin \<theta>) / (2 * sin(\<phi> - \<theta>)) * (1/r + r) - (sin \<phi>) / (2 * sin (\<phi> - \<theta>)) * (1/ry + ry)" 
           using \<open>ry > 0\<close> \<open>r > 0\<close>
           apply (subst diff_divide_distrib)             
           apply (subst add_frac_num, simp)
           apply (subst add_frac_num, simp)
           apply (simp add: power2_eq_square mult.commute)
           apply (simp add: field_simps)
           done
 
         have "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor r * cis \<phi>)) = (?A, ?B, cnj ?B, ?A) \<and>
                 is_real ?A \<and> Re ?A \<noteq> 0 \<and> ?A \<noteq> 0 \<and> cor ?A \<noteq> 0 \<and>
                 Re ?B = ?ReB \<and>
                 ?ReB / ?A = (sin \<theta>) / (2 * sin(\<phi> - \<theta>)) * (1/r + r) - (sin \<phi>) / (2 * sin (\<phi> - \<theta>)) * (1/ry + ry)"
           using 1 2 3 4 5
           by auto
       }
       note ** = this
 
       let ?Ayz = "2 * rz * ry * sin (\<phi> - \<theta>)"
       let ?Byz = "\<i> * (rz * cis \<phi> * (1 + ry\<^sup>2) - ry * cis \<theta> * (1 + rz\<^sup>2))"
       let ?ReByz = "ry * (1 + rz\<^sup>2) * sin \<theta> - rz * (1 + ry\<^sup>2) * sin \<phi>"
       let ?Kz = "(sin \<theta>) / (2 * sin(\<phi> - \<theta>)) * (1/rz + rz) - (sin \<phi>) / (2 * sin (\<phi> - \<theta>)) * (1/ry + ry)"
       have yz: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor rz * cis \<phi>)) = (?Ayz, ?Byz, cnj ?Byz, ?Ayz)"
         "is_real ?Ayz" "Re ?Ayz \<noteq> 0" "?Ayz \<noteq> 0" "cor ?Ayz \<noteq> 0" "Re ?Byz = ?ReByz" and Kz: "?ReByz / ?Ayz = ?Kz"
         using **[OF \<open>0 < rz\<close>]
         by auto
 
       let ?Ayu = "2 * ru * ry * sin (\<phi> - \<theta>)"
       let ?Byu = "\<i> * (ru * cis \<phi> * (1 + ry\<^sup>2) - ry * cis \<theta> * (1 + ru\<^sup>2))"
       let ?ReByu = "ry * (1 + ru\<^sup>2) * sin \<theta> - ru * (1 + ry\<^sup>2) * sin \<phi>"
       let ?Ku = "(sin \<theta>) / (2 * sin(\<phi> - \<theta>)) * (1/ru + ru) - (sin \<phi>) / (2 * sin (\<phi> - \<theta>)) * (1/ry + ry)"
       have yu: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor ru * cis \<phi>)) = (?Ayu, ?Byu, cnj ?Byu, ?Ayu)"
         "is_real ?Ayu" "Re ?Ayu \<noteq> 0" "?Ayu \<noteq> 0" "cor ?Ayu \<noteq> 0" "Re ?Byu = ?ReByu" and Ku: "?ReByu / ?Ayu = ?Ku"
         using **[OF \<open>0 < ru\<close>]
         by auto
 
       have "?Ayz \<noteq> 0"
         using \<open>sin (\<phi> - \<theta>) \<noteq> 0\<close> \<open>ry > 0\<close> \<open>rz > 0\<close>
         by auto
 
       have "Re ?Byz / ?Ayz < -1"
         using \<open>intersects_x_axis_positive ?yz\<close>
           * \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>u' = cor ru * cis \<phi>\<close>
         apply simp
         apply (transfer fixing: ry rz ru \<theta> \<phi>)
         apply (transfer fixing: ry rz ru \<theta> \<phi>)
       proof-
         assume "intersects_x_axis_positive_cmat (poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor rz * cis \<phi>)))"
         thus "(ry * sin \<theta> * (1 + rz\<^sup>2) - rz * sin \<phi> * (1 + ry\<^sup>2)) / (2 * rz * ry * sin (\<phi> - \<theta>)) < - 1"
           using yz
           by simp
       qed
 
       have "?ReByz / ?Ayz \<ge> ?ReByu / ?Ayu"
       proof (cases "sin \<phi> > 0")
         case True
         hence "sin \<theta> < 0"
           using \<open>sin \<phi> * sin \<theta> < 0\<close>
           by (smt mult_nonneg_nonneg)
 
         have "?ReByz < 0"
         proof-
           have "ry * (1 + rz\<^sup>2) * sin \<theta> < 0"
             using \<open>ry > 0\<close> \<open>rz > 0\<close>
             using \<open>sin \<theta> < 0\<close>
             by (smt mult_pos_neg mult_pos_pos zero_less_power)
           moreover
           have "rz * (1 + ry\<^sup>2) * sin \<phi> > 0"
             using \<open>ry > 0\<close> \<open>rz > 0\<close>
             using \<open>sin \<phi> > 0\<close>
             by (smt mult_pos_neg mult_pos_pos zero_less_power)
           ultimately
           show ?thesis
             by simp
         qed
         have "?Ayz > 0"
           using \<open>Re ?Byz / ?Ayz < -1\<close> \<open>Re ?Byz = ?ReByz\<close> \<open>?ReByz < 0\<close>
           by (smt divide_less_0_iff)
         hence "sin (\<phi> - \<theta>) > 0"
           using \<open>ry > 0\<close> \<open>rz > 0\<close>
           by (smt mult_pos_pos zero_less_mult_pos)
 
         have "1 / ru + ru \<ge> 1 / rz + rz"
           using Pasch_fun_mono[of ru rz] \<open>0 < ru\<close> \<open>ru \<le> rz\<close> \<open>rz < 1\<close>
           by simp
         hence "sin \<theta> * (1 / ru + ru) \<le> sin \<theta> * (1 / rz + rz)"
           using \<open>sin \<theta> < 0\<close>
           by auto
         thus ?thesis
           using \<open>ru > 0\<close> \<open>rz > 0\<close> \<open>ru \<le> rz\<close> \<open>rz < 1\<close> \<open>?Ayz > 0\<close> \<open>sin (\<phi> - \<theta>) > 0\<close>
           using divide_right_mono[of "sin \<theta> * (1 / ru + ru)" "sin \<theta> * (1 / rz + rz)" "2 * sin (\<phi> - \<theta>)"]
           by (subst Kz, subst Ku) simp
       next
         assume "\<not> sin \<phi> > 0"
         hence "sin \<phi> < 0"
           using \<open>sin \<phi> * sin \<theta> < 0\<close>
           by (cases "sin \<phi> = 0", simp_all)
         hence "sin \<theta> > 0"
           using \<open>sin \<phi> * sin \<theta> < 0\<close>
           by (smt mult_nonpos_nonpos)
         have "?ReByz > 0"
         proof-
           have "ry * (1 + rz\<^sup>2) * sin \<theta> > 0"
             using \<open>ry > 0\<close> \<open>rz > 0\<close>
             using \<open>sin \<theta> > 0\<close>
             by (smt mult_pos_neg mult_pos_pos zero_less_power)
           moreover
           have "rz * (1 + ry\<^sup>2) * sin \<phi> < 0"
             using \<open>ry > 0\<close> \<open>rz > 0\<close>
             using \<open>sin \<phi> < 0\<close>
             by (smt mult_pos_neg mult_pos_pos zero_less_power)
           ultimately
           show ?thesis
             by simp
         qed
         have "?Ayz < 0"
           using \<open>Re ?Byz / ?Ayz < -1\<close> \<open>?Ayz \<noteq> 0\<close> \<open>Re ?Byz = ?ReByz\<close> \<open>?ReByz > 0\<close>
           by (smt divide_less_0_iff)
         hence "sin (\<phi> - \<theta>) < 0"
           using \<open>ry > 0\<close> \<open>rz > 0\<close>
           by (smt mult_nonneg_nonneg)
 
         have "1 / ru + ru \<ge> 1 / rz + rz"
           using Pasch_fun_mono[of ru rz] \<open>0 < ru\<close> \<open>ru \<le> rz\<close> \<open>rz < 1\<close>
           by simp
         hence "sin \<theta> * (1 / ru + ru) \<ge> sin \<theta> * (1 / rz + rz)"
           using \<open>sin \<theta> > 0\<close>
           by auto
         thus ?thesis
           using \<open>ru > 0\<close> \<open>rz > 0\<close> \<open>ru \<le> rz\<close> \<open>rz < 1\<close> \<open>?Ayz < 0\<close> \<open>sin (\<phi> - \<theta>) < 0\<close>
           using divide_right_mono_neg[of  "sin \<theta> * (1 / rz + rz)" "sin \<theta> * (1 / ru + ru)" "2 * sin (\<phi> - \<theta>)"]
           by (subst Kz, subst Ku) simp
       qed
 
       have "intersects_x_axis_positive ?yu"
         using * \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>u' = cor ru * cis \<phi>\<close>
         apply simp
         apply (transfer fixing: ry rz ru \<theta> \<phi>)
         apply (transfer fixing: ry rz ru \<theta> \<phi>)
       proof-
         have "Re ?Byu / ?Ayu < -1"
           using \<open>Re ?Byz / ?Ayz < -1\<close> \<open>?ReByz / ?Ayz \<ge> ?ReByu / ?Ayu\<close>
           by (subst (asm) \<open>Re ?Byz = ?ReByz\<close>, subst \<open>Re ?Byu = ?ReByu\<close>) simp
         thus "intersects_x_axis_positive_cmat (poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \<theta>)) (of_complex_cvec (cor ru * cis \<phi>)))"
           using yu
           by simp
       qed
 
       let ?a = "calc_x_axis_intersection ?yu"
       have "?a \<in> positive_x_axis" "?a \<in> circline_set ?yu" "?a \<in> unit_disc"
         using \<open>intersects_x_axis_positive ?yu\<close>
         using intersects_x_axis_positive_iff'[of ?yu] \<open>y \<noteq> u\<close>
         by auto
 
       then obtain a' where a': "?a = of_complex a'" "is_real a'" "Re a' > 0" "Re a' < 1"
         unfolding positive_x_axis_def circline_set_x_axis
         by (auto simp add: cmod_eq_Re)
 
       have "intersects_x_axis ?yz" "intersects_x_axis ?yu"
         using \<open>intersects_x_axis_positive ?yz\<close> \<open>intersects_x_axis_positive ?yu\<close>
         by auto
 
       show "\<exists>a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between 0\<^sub>h a (of_complex v)"
       proof (rule_tac x="?a" in exI, safe)
         show "poincare_between u ?a y"
           using poincare_between_x_axis_intersection[of y u ?a]
           using calc_x_axis_intersection[OF is_poincare_line_poincare_line[OF \<open>y \<noteq> u\<close>] \<open>intersects_x_axis ?yu\<close>]
           using calc_x_axis_intersection_in_unit_disc[OF is_poincare_line_poincare_line[OF \<open>y \<noteq> u\<close>] \<open>intersects_x_axis ?yu\<close>]
           using in_disc \<open>y \<noteq> u\<close> \<open>y \<notin> circline_set x_axis\<close> \<open>u \<notin> circline_set x_axis\<close>
           using * \<open>\<phi> = arg u'\<close> \<open>\<theta> = arg y'\<close> \<open>\<phi> * \<theta> < 0\<close>
           by (subst poincare_between_rev, auto simp add: mult.commute)
       next
         show "poincare_between 0\<^sub>h ?a (of_complex v)"
         proof-
           have "-?ReByz / ?Ayz \<le> -?ReByu / ?Ayu"
             using \<open>?ReByz / ?Ayz \<ge> ?ReByu / ?Ayu\<close>
             by linarith
           have "outward ?yz ?yu"
             using * \<open>y' = cor ry * cis \<theta>\<close> \<open>z' = cor rz * cis \<phi>\<close> \<open>u' = cor ru * cis \<phi>\<close>
             apply simp
             apply (transfer fixing: ry rz ru \<theta> \<phi>)
             apply (transfer fixing: ry rz ru \<theta> \<phi>)
             apply (subst yz yu)+
             unfolding outward_cmat_def
             apply (simp only: Let_def prod.case)
             apply (subst yz yu)+
             using \<open>-?ReByz / ?Ayz \<le> -?ReByu / ?Ayu\<close>
             by simp
           hence "Re a' \<le> Re v"
             using \<open>?v = of_complex v\<close>
             using \<open>?a = of_complex a'\<close>
             using \<open>intersects_x_axis_positive ?yz\<close> \<open>intersects_x_axis_positive ?yu\<close>
             using outward[OF is_poincare_line_poincare_line[OF \<open>y \<noteq> z\<close>] is_poincare_line_poincare_line[OF \<open>y \<noteq> u\<close>]]
             by simp
           thus ?thesis
             using \<open>?v = of_complex v\<close>
             using poincare_between_x_axis_0uv[of "Re a'" "Re v"] a' v
             by simp
         qed
       next
         show "?a \<in> unit_disc"
           by fact
       qed
     qed
   next
     show "x \<in> unit_disc" "v \<in> unit_disc" "x \<noteq> v"
       using assms
       by auto
   next
     fix M x v
     let ?Mx = "moebius_pt M x" and ?Mv = "moebius_pt M v"
     assume 1: "unit_disc_fix M" "x \<in> unit_disc" "v \<in> unit_disc" "x \<noteq> v"
     assume 2: "?P ?Mx ?Mv"
     show "?P x v"
     proof safe
       fix y z u
       let ?My = "moebius_pt M y" and ?Mz = "moebius_pt M z" and ?Mu = "moebius_pt M u"
       assume "distinct [x, y, z, u, v]" "\<not> poincare_collinear {x, y, z}" "y \<in> unit_disc" "z \<in> unit_disc" "u \<in> unit_disc"
              "poincare_between x u z" "poincare_between y v z"
       hence "\<exists> Ma. Ma \<in> unit_disc \<and> poincare_between ?Mu Ma ?My \<and> poincare_between ?Mx Ma ?Mv"
         using 1 2[rule_format, of ?My ?Mz ?Mu]
         by simp
       then obtain Ma where Ma: "Ma \<in> unit_disc" "poincare_between ?Mu Ma ?My \<and> poincare_between ?Mx Ma ?Mv"
         by blast
       let ?a = "moebius_pt (-M) Ma"
       let ?Ma = "moebius_pt M ?a"
       have "?Ma = Ma"
         by (metis moebius_pt_invert uminus_moebius_def)
       hence "?Ma \<in> unit_disc" "poincare_between ?Mu ?Ma ?My \<and> poincare_between ?Mx ?Ma ?Mv"
         using Ma
         by auto
       thus "\<exists>a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between x a v"
         using unit_disc_fix_moebius_inv[OF \<open>unit_disc_fix M\<close>] \<open>unit_disc_fix M\<close> \<open>Ma \<in> unit_disc\<close>
         using \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close> \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close>
         by (rule_tac x="?a" in exI, simp del: moebius_pt_comp_inv_right)
     qed
   qed
   thus ?thesis
     using assms
     by auto
 qed
 
 text\<open>Pasch axiom, only degenerative cases.\<close>
 lemma Pasch_deg:
   assumes "x \<in> unit_disc" and "y \<in> unit_disc" and "z \<in> unit_disc" and "u \<in> unit_disc" and "v \<in> unit_disc"
   assumes "\<not> distinct [x, y, z, u, v] \<or> poincare_collinear {x, y, z}"
   assumes "poincare_between x u z" and "poincare_between y v z"
   shows "\<exists> a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between x a v"
 proof(cases "poincare_collinear {x, y, z}")
   case True
   hence "poincare_between x y z \<or> poincare_between y x z \<or> poincare_between y z x"
     using assms(1, 2, 3) poincare_collinear3_between poincare_between_rev by blast
   show ?thesis
   proof(cases "poincare_between x y z")
     case True
     have "poincare_between x y v"
       using True assms poincare_between_transitivity
       by (meson poincare_between_rev)
     thus ?thesis
       using assms(2)
       by (rule_tac x="y" in exI, simp)
   next
     case False
     hence "poincare_between y x z \<or> poincare_between y z x"
       using \<open>poincare_between x y z \<or> poincare_between y x z \<or> poincare_between y z x\<close>
       by simp
     show ?thesis
     proof(cases "poincare_between y x z")
       case True
       hence "poincare_between u x y"
         using assms
         by (meson poincare_between_rev poincare_between_transitivity)
       thus ?thesis
         using assms
         by (rule_tac x="x" in exI, simp)
     next
       case False
       hence "poincare_between y z x"
         using \<open>poincare_between y x z \<or> poincare_between y z x\<close>
         by auto
       hence "poincare_between x z v"
         using assms
         by (meson poincare_between_rev poincare_between_transitivity)
       hence "poincare_between x u v"
         using assms poincare_between_transitivity poincare_between_rev
         by (smt poincare_between_sum_distances)
       thus ?thesis
         using assms
         by (rule_tac x="u" in exI, simp)
     qed
   qed
 next
   case False
   hence "\<not> distinct [x, y, z, u, v]"
     using assms(6) by auto
   show ?thesis
   proof(cases "u=z")
     case True
     thus ?thesis
       using assms
       apply(rule_tac x="v" in exI)
       by(simp add:poincare_between_rev)
   next
     case False (* "u \<noteq> z" *)
     hence "x \<noteq> z"
       using assms poincare_between_sandwich by blast
     show ?thesis
     proof(cases "v=z")
       case True
       thus ?thesis
         using assms
         by (rule_tac x="u" in exI, simp)
     next
       case False (* v \<noteq> z *)
       hence "y \<noteq> z"
         using assms poincare_between_sandwich by blast
       show ?thesis
       proof(cases "u = x")
         case True
         thus ?thesis
           using assms
           by (rule_tac x="x" in exI, simp)
       next
         case False (*u \<noteq> x*)
         have "x \<noteq> y"
           using assms \<open>\<not> poincare_collinear {x, y, z}\<close>
           by fastforce
         have "x \<noteq> v"
           using assms \<open>\<not> poincare_collinear {x, y, z}\<close>
           by (metis insert_commute poincare_between_poincare_collinear)
         have "u \<noteq> y"
           using assms \<open>\<not> poincare_collinear {x, y, z}\<close>
           using poincare_between_poincare_collinear by blast
         have "u \<noteq> v"
         proof(rule ccontr)
           assume "\<not> u \<noteq> v"
           hence "poincare_between x v z"
             using assms by auto
           hence "x \<in> circline_set (poincare_line z v)"
             using poincare_between_rev[of x v z]
             using poincare_between_poincare_line_uvz[of z v x]
             using assms \<open>v \<noteq> z\<close>
             by auto
           have "y \<in> circline_set (poincare_line z v)"
             using assms \<open>\<not> u \<noteq> v\<close> 
             using poincare_between_rev[of y v z]
             using poincare_between_poincare_line_uvz[of z v y]
             using assms \<open>v \<noteq> z\<close>
             by auto
           have "z \<in> circline_set (poincare_line z v)"
             using ex_poincare_line_two_points[of z v] \<open>v \<noteq> z\<close>
             by auto
           have "is_poincare_line (poincare_line z v)"
             using \<open>v \<noteq> z\<close>
             by auto
           hence "poincare_collinear {x, y, z}"
             using \<open>x \<in> circline_set (poincare_line z v)\<close>
             using \<open>y \<in> circline_set (poincare_line z v)\<close>
             using \<open>z \<in> circline_set (poincare_line z v)\<close>
             unfolding poincare_collinear_def
             by (rule_tac x="poincare_line z v" in exI, simp)            
           thus False
             using \<open>\<not> poincare_collinear {x, y, z}\<close> by simp
         qed
         have "v = y"
           using \<open>u \<noteq> v\<close> \<open>u \<noteq> y\<close> \<open>x \<noteq> v\<close> \<open>x \<noteq> y\<close> \<open>u \<noteq> x\<close> \<open>y \<noteq> z\<close> \<open>v \<noteq> z\<close> \<open>x \<noteq> z\<close> \<open>u \<noteq> z\<close>
           using \<open>\<not> distinct [x, y, z, u, v]\<close>
           by auto
         thus ?thesis
           using assms
           by (rule_tac x="y" in exI, simp)
       qed
     qed
   qed
 qed
 
 text \<open>Axiom of Pasch\<close>
 lemma Pasch:
   assumes "x \<in> unit_disc" and "y \<in> unit_disc" and "z \<in> unit_disc" and "u \<in> unit_disc" and "v \<in> unit_disc"
   assumes "poincare_between x u z" and "poincare_between y v z"
   shows "\<exists> a. a \<in> unit_disc \<and> poincare_between u a y \<and> poincare_between x a v"
 proof(cases "distinct [x, y, z, u, v] \<and> \<not> poincare_collinear {x, y, z}")
   case True
   thus ?thesis
     using assms Pasch_nondeg by auto
 next
   case False
   thus ?thesis
     using assms Pasch_deg by auto
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Segment construction axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma segment_construction:
   assumes "x \<in> unit_disc" and "y \<in> unit_disc"
   assumes "a \<in> unit_disc" and "b \<in> unit_disc"
   shows "\<exists> z. z \<in> unit_disc \<and> poincare_between x y z \<and> poincare_distance y z = poincare_distance a b"
 proof-
   obtain d where d: "d = poincare_distance a b"
     by auto
   have "d \<ge> 0"
     using assms
     by (simp add: d poincare_distance_ge0)
 
   have "\<exists> z. z \<in> unit_disc \<and> poincare_between x y z \<and> poincare_distance y z = d" (is "?P x y")
   proof (cases "x = y")
     case True
     have "\<exists> z. z \<in> unit_disc \<and> poincare_distance x z = d"
     proof (rule wlog_zero)
       show "\<exists> z. z \<in> unit_disc \<and> poincare_distance 0\<^sub>h z = d"
         using ex_x_axis_poincare_distance_negative[of d] \<open>d \<ge> 0\<close>
         by blast
     next
       show "x \<in> unit_disc"
         by fact
     next
       fix a u
       assume "u \<in> unit_disc" "cmod a < 1"
       assume "\<exists>z. z \<in> unit_disc \<and> poincare_distance (moebius_pt (blaschke a) u) z = d"
       then obtain z where *: "z \<in> unit_disc" "poincare_distance (moebius_pt (blaschke a) u) z = d"
         by auto
       obtain z' where z': "z = moebius_pt (blaschke a) z'" "z' \<in> unit_disc"
         using \<open>z \<in> unit_disc\<close>
         using unit_disc_fix_iff[of "blaschke a"] \<open>cmod a < 1\<close>
         using blaschke_unit_disc_fix[of a]
         by blast
 
       show "\<exists>z. z \<in> unit_disc \<and> poincare_distance u z = d"
         using * z' \<open>u : unit_disc\<close>
         using blaschke_unit_disc_fix[of a] \<open>cmod a < 1\<close>
         by (rule_tac x=z' in exI, simp)
     qed
     thus ?thesis
       using \<open>x = y\<close>
       unfolding poincare_between_def
       by auto
   next
     case False
     show ?thesis
     proof (rule wlog_positive_x_axis[where P="\<lambda> y x. ?P x y"])
       fix x
       assume "is_real x" "0 < Re x" "Re x < 1"
 
       then obtain z where z: "is_real z" "Re z \<le> 0" "- 1 < Re z" "of_complex z \<in> unit_disc"
         "of_complex z \<in> unit_disc" "of_complex z \<in> circline_set x_axis" "poincare_distance 0\<^sub>h (of_complex z) = d"
         using ex_x_axis_poincare_distance_negative[of d] \<open>d \<ge> 0\<close>
         by auto
 
       have "poincare_between (of_complex x) 0\<^sub>h (of_complex z)"
       proof (cases "z = 0")
         case True
         thus ?thesis
           unfolding poincare_between_def
           by auto
       next
         case False
         have "x \<noteq> 0"
           using \<open>is_real x\<close> \<open>Re x > 0\<close>
           by auto
         thus ?thesis
           using poincare_between_x_axis_u0v[of x z]
           using z \<open>is_real x\<close> \<open>x \<noteq> 0\<close> \<open>Re x > 0\<close> False
           using complex_eq_if_Re_eq mult_pos_neg
           by fastforce
     qed
     thus "?P (of_complex x) 0\<^sub>h"
       using \<open>poincare_distance 0\<^sub>h (of_complex z) = d\<close> \<open>of_complex z \<in> unit_disc\<close>
       by blast
   next
     show "x \<in> unit_disc" "y \<in> unit_disc"
       by fact+
   next
     show "y \<noteq> x" using \<open>x \<noteq> y\<close> by simp
   next
     fix M u v
     assume "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
     assume "?P (moebius_pt M v) (moebius_pt M u)"
     then obtain z where *: "z \<in> unit_disc" "poincare_between (moebius_pt M v) (moebius_pt M u) z" "poincare_distance (moebius_pt M u) z = d"
       by auto
     obtain z' where z': "z = moebius_pt M z'" "z' \<in> unit_disc"
         using \<open>z \<in> unit_disc\<close>
         using unit_disc_fix_iff[of M] \<open>unit_disc_fix M\<close>
         by blast
       thus "?P v u"
         using * \<open>u \<in> unit_disc\<close> \<open>v \<in> unit_disc\<close> \<open>unit_disc_fix M\<close>
         by auto
     qed
   qed
   thus ?thesis
     using assms d
     by auto
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Five segment axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma five_segment_axiom:
   assumes
      in_disc: "x \<in> unit_disc"  "y \<in> unit_disc" "z \<in> unit_disc" "u \<in> unit_disc" and
      in_disc': "x' \<in> unit_disc" "y' \<in> unit_disc" "z' \<in> unit_disc" "u' \<in> unit_disc" and
       "x \<noteq> y" and
       betw: "poincare_between x y z" "poincare_between x' y' z'" and
       xy: "poincare_distance x y = poincare_distance x' y'" and
       xu: "poincare_distance x u = poincare_distance x' u'" and
       yu: "poincare_distance y u = poincare_distance y' u'" and
       yz: "poincare_distance y z = poincare_distance y' z'"
     shows
      "poincare_distance z u = poincare_distance z' u'"
 proof-
   from assms obtain M where
   M: "unit_disc_fix_f M" "M x = x'" "M u = u'" "M y = y'"
     using unit_disc_fix_f_congruent_triangles[of x y u]
     by blast
   have "M z = z'"
   proof (rule unique_poincare_distance_on_ray[where u=x' and v=y' and y="M z" and z=z' and d="poincare_distance x z"])
     show "0 \<le> poincare_distance x z"
       using poincare_distance_ge0 in_disc
       by simp
   next
     show "x' \<noteq> y'"
       using M \<open>x \<noteq> y\<close>
       using in_disc in_disc' poincare_distance_eq_0_iff xy
       by auto
   next
     show "poincare_distance x' (M z) = poincare_distance x z"
       using M in_disc
       unfolding unit_disc_fix_f_def
       by auto
   next
     show "M z \<in> unit_disc"
       using M in_disc
       unfolding unit_disc_fix_f_def
       by auto
   next
     show "poincare_distance x' z' = poincare_distance x z"
       using xy yz betw
       using poincare_between_sum_distances[of x y z]
       using poincare_between_sum_distances[of x' y' z']
       using in_disc in_disc'
       by auto
   next
     show "poincare_between x' y' (M z)"
       using M
       using in_disc betw
       unfolding unit_disc_fix_f_def
       by auto
   qed fact+
   thus ?thesis
     using \<open>unit_disc_fix_f M\<close>
     using in_disc in_disc'
     \<open>M u = u'\<close>
     unfolding unit_disc_fix_f_def
     by auto
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Upper dimension axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma upper_dimension_axiom:
   assumes in_disc: "x \<in> unit_disc" "y \<in> unit_disc" "z \<in> unit_disc" "u \<in> unit_disc" "v \<in> unit_disc"
   assumes "poincare_distance x u = poincare_distance x v"
           "poincare_distance y u = poincare_distance y v"
           "poincare_distance z u = poincare_distance z v"
           "u \<noteq> v"
   shows "poincare_between x y z \<or> poincare_between y z x \<or> poincare_between z x y"
 proof (cases "x = y \<or> y = z \<or> x = z")
   case True
   thus ?thesis
     using in_disc
     by auto
 next
   case False
   hence "x \<noteq> y" "x \<noteq> z" "y \<noteq> z"
     by auto
   let ?cong = "\<lambda> a b a' b'. poincare_distance a b = poincare_distance a' b'"
   have "\<forall> z u v. z \<in> unit_disc \<and> u \<in> unit_disc \<and> v \<in> unit_disc \<and>
                  ?cong x u x v \<and> ?cong y u y v \<and> ?cong z u z v  \<and> u \<noteq> v \<longrightarrow>
                  poincare_collinear {x, y, z}" (is "?P x y")
   proof (rule wlog_positive_x_axis[where P="?P"])
     fix x
     assume x: "is_real x" "0 < Re x" "Re x < 1"
     hence "x \<noteq> 0"
       by auto
     have "0\<^sub>h \<in> circline_set x_axis"
       by simp
     show "?P 0\<^sub>h (of_complex x)"
     proof safe
       fix z u v
       assume in_disc: "z \<in> unit_disc" "u \<in> unit_disc" "v \<in> unit_disc"
       then obtain z' u' v' where zuv: "z = of_complex z'" "u = of_complex u'" "v = of_complex v'"
         using inf_or_of_complex[of z] inf_or_of_complex[of u] inf_or_of_complex[of v]
         by auto
 
       assume cong: "?cong 0\<^sub>h u 0\<^sub>h v" "?cong (of_complex x) u (of_complex x) v" "?cong z u z v" "u \<noteq> v"
 
       let ?r0 = "poincare_distance 0\<^sub>h u" and
           ?rx = "poincare_distance (of_complex x) u"
 
       have "?r0 > 0" "?rx > 0"
         using in_disc  cong
         using poincare_distance_eq_0_iff[of "0\<^sub>h" u] poincare_distance_ge0[of "0\<^sub>h" u]
         using poincare_distance_eq_0_iff[of "0\<^sub>h" v] poincare_distance_ge0[of "0\<^sub>h" v]
         using poincare_distance_eq_0_iff[of "of_complex x" u] poincare_distance_ge0[of "of_complex x" u]
         using poincare_distance_eq_0_iff[of "of_complex x" v] poincare_distance_ge0[of "of_complex x" v]
         using x
         by (auto simp add: cmod_eq_Re)
 
       let ?pc0 = "poincare_circle 0\<^sub>h ?r0" and
           ?pcx = "poincare_circle (of_complex x) ?rx"
       have "u \<in> ?pc0 \<inter> ?pcx" "v \<in> ?pc0 \<inter> ?pcx"
         using in_disc cong
         by (auto simp add: poincare_circle_def)
       hence "u = conjugate v"
         using intersect_poincare_circles_x_axis[of 0 x ?r0 ?rx u v]
         using x \<open>x \<noteq> 0\<close> \<open>u \<noteq> v\<close> \<open>?r0 > 0\<close> \<open>?rx > 0\<close>
         by simp
 
       let ?ru = "poincare_distance u z"
       have "?ru > 0"
         using poincare_distance_ge0[of u z] in_disc
         using cong
         using poincare_distance_eq_0_iff[of z u] poincare_distance_eq_0_iff[of z v]
         using poincare_distance_eq_0_iff
         by force
 
       have "z \<in> poincare_circle u ?ru \<inter> poincare_circle v ?ru"
         using cong in_disc
         unfolding poincare_circle_def
         by (simp add: poincare_distance_sym)
 
       hence "is_real z'"
         using intersect_poincare_circles_conjugate_centers[of u v ?ru z] \<open>u = conjugate v\<close> zuv
         using in_disc \<open>u \<noteq> v\<close> \<open>?ru > 0\<close>
         by simp
 
       thus "poincare_collinear {0\<^sub>h, of_complex x, z}"
         using poincare_line_0_real_is_x_axis[of "of_complex x"] x \<open>x \<noteq> 0\<close> zuv \<open>0\<^sub>h \<in> circline_set x_axis\<close>
         unfolding poincare_collinear_def
         by (rule_tac x=x_axis in exI, auto simp add: circline_set_x_axis)
     qed
   next
     fix M x y
     assume 1: "unit_disc_fix M" "x \<in> unit_disc" "y \<in> unit_disc" "x \<noteq> y"
     assume 2: "?P (moebius_pt M x) (moebius_pt M y)"
     show "?P x y"
     proof safe
       fix z u v
       assume "z \<in> unit_disc" "u \<in> unit_disc" "v \<in> unit_disc"
              "?cong x u x v" "?cong y u y v" "?cong z u z v" "u \<noteq> v"
       hence "poincare_collinear {moebius_pt M x, moebius_pt M y, moebius_pt M z}"
         using 1 2[rule_format, of "moebius_pt M z" "moebius_pt M u" "moebius_pt M v"]
         by simp
       then obtain p where "is_poincare_line p" "{moebius_pt M x, moebius_pt M y, moebius_pt M z} \<subseteq> circline_set p"
         unfolding poincare_collinear_def
         by auto
       thus "poincare_collinear {x, y, z}"
         using \<open>unit_disc_fix M\<close>
         unfolding poincare_collinear_def
         by (rule_tac x="moebius_circline (-M) p" in exI, auto)
     qed
   qed fact+
 
   thus ?thesis
     using assms
     using poincare_collinear3_between[of x y z]
     using poincare_between_rev
     by auto
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Lower dimension axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma lower_dimension_axiom:
   shows "\<exists> a \<in> unit_disc. \<exists> b \<in> unit_disc. \<exists> c \<in> unit_disc.
             \<not> poincare_between a b c \<and> \<not> poincare_between b c a \<and> \<not> poincare_between c a b"
 proof-
   let ?u = "of_complex (1/2)" and ?v = "of_complex (\<i>/2)"
   have 1: "0\<^sub>h \<in> unit_disc" and 2: "?u \<in> unit_disc" and 3: "?v \<in> unit_disc"
     by simp_all
   have *: "\<not> poincare_collinear {0\<^sub>h, ?u, ?v}"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then obtain p where "is_poincare_line p" "{0\<^sub>h, ?u, ?v} \<subseteq> circline_set p"
       unfolding poincare_collinear_def
       by auto
     moreover
     have "of_complex (1 / 2) \<noteq> of_complex (\<i> / 2)"
       using of_complex_inj
       by fastforce
     ultimately
     have "0\<^sub>h \<in> circline_set (poincare_line ?u ?v)"
       using unique_poincare_line[of ?u ?v p]
       by auto
     thus False
       unfolding circline_set_def
       by simp (transfer, transfer, simp add: vec_cnj_def)
   qed
   show ?thesis
     apply (rule_tac x="0\<^sub>h" in bexI, rule_tac x="?u" in bexI, rule_tac x="?v" in bexI)
     apply (rule ccontr, auto)
     using *
     using poincare_between_poincare_collinear[OF 1 2 3]
     using poincare_between_poincare_collinear[OF 2 3 1]
     using poincare_between_poincare_collinear[OF 3 1 2]
     by (metis insert_commute)+
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Negated Euclidean axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 lemma negated_euclidean_axiom_aux:
   assumes "on_circline H (of_complex (1/2 + \<i>/2))" and "is_poincare_line H"
   assumes "intersects_x_axis_positive H"
   shows "\<not> intersects_y_axis_positive H"
   using assms
 proof (transfer, transfer)
   fix H
   assume hh: "hermitean H \<and> H \<noteq> mat_zero" "is_poincare_line_cmat H"
   obtain A B C D where "H = (A, B, C, D)"
     by (cases H, auto)
   hence *: "is_real A" "H = (A, B, cnj B, A)" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2"
     using hermitean_elems[of A B C D] hh
     by auto
 
   assume "intersects_x_axis_positive_cmat H"
   hence "Re A \<noteq> 0" "Re B / Re A < - 1"
     using *
     by auto
 
   assume "on_circline_cmat_cvec H (of_complex_cvec (1 / 2 + \<i> / 2))"
   hence "6*A + 4*Re B + 4*Im B = 0"
     using *
     unfolding of_real_mult
     apply (subst Re_express_cnj[of B])
     apply (subst Im_express_cnj[of B])
     apply (simp add: vec_cnj_def)
     apply (simp add: field_simps)
     done
   hence "Re (6*A + 4*Re B + 4*Im B) = 0"
     by simp
   hence "3*Re A + 2*Re B + 2*Im B = 0"
     using \<open>is_real A\<close>
     by simp
 
   hence "3/2 + Re B/Re A + Im B/Re A = 0"
     using \<open>Re A \<noteq> 0\<close>
     by (simp add: field_simps)
 
   hence "-Im B/Re A - 3/2 < -1"
     using \<open>Re B / Re A < -1\<close>
     by simp
   hence "Im B/Re A > -1/2"
     by (simp add: field_simps)
   thus "\<not> intersects_y_axis_positive_cmat H"
     using *
     by simp
 qed
 
 lemma negated_euclidean_axiom:
   shows "\<exists> a b c d t.
            a \<in> unit_disc \<and> b \<in> unit_disc \<and> c \<in> unit_disc \<and> d \<in> unit_disc \<and> t \<in> unit_disc \<and>
            poincare_between a d t \<and> poincare_between b d c \<and> a \<noteq> d \<and>
                 (\<forall> x y. x \<in> unit_disc \<and> y \<in> unit_disc \<and>
                         poincare_between a b x \<and> poincare_between x t y \<longrightarrow> \<not> poincare_between a c y)"
 proof-
   let ?a = "0\<^sub>h"
   let ?b = "of_complex (1/2)"
   let ?c = "of_complex (\<i>/2)"
   let ?dl = "(5 - sqrt 17) / 4"
   let ?d = "of_complex (?dl + \<i>*?dl)"
   let ?t = "of_complex (1/2 + \<i>/2)"
 
   have "?dl \<noteq> 0"
   proof-
     have "(sqrt 17)\<^sup>2 \<noteq> 5\<^sup>2"
       by simp
     hence "sqrt 17 \<noteq> 5"
       by force
     thus ?thesis
       by simp
   qed
 
   have "?d \<noteq> ?a"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     hence "?dl + \<i>*?dl = 0"
       by simp
     hence "Re (?dl + \<i>*?dl) = 0"
       by simp
     thus False
       using \<open>?dl \<noteq> 0\<close>
       by simp
   qed
 
   have "?dl > 0"
   proof-
     have "(sqrt 17)\<^sup>2 < 5\<^sup>2"
       by (simp add: power2_eq_square)
     hence "sqrt 17 < 5"
       by (rule power2_less_imp_less, simp)
     thus ?thesis
       by simp
   qed
 
   have "?a \<noteq> ?b"
     by (metis divide_eq_0_iff of_complex_zero_iff zero_neq_numeral zero_neq_one)
 
   have "?a \<noteq> ?c"
     by (metis complex_i_not_zero divide_eq_0_iff of_complex_zero_iff zero_neq_numeral)
 
   show ?thesis
   proof (rule_tac x="?a" in exI, rule_tac x="?b" in exI, rule_tac x="?c" in exI, rule_tac x="?d" in exI, rule_tac x="?t" in exI, safe)
 
 
     show "?a \<in> unit_disc" "?b \<in> unit_disc" "?c \<in> unit_disc" "?t \<in> unit_disc"
       by (auto simp add: cmod_def power2_eq_square)
 
     have cmod_d: "cmod (?dl + \<i>*?dl) = ?dl * sqrt 2"
       using \<open>?dl > 0\<close>
       unfolding cmod_def
       by (simp add: real_sqrt_mult)
 
     show "?d \<in> unit_disc"
     proof-
       have "?dl < 1 / sqrt 2"
       proof-
         have "17\<^sup>2 < (5 * sqrt 17)\<^sup>2"
           by (simp add: field_simps)
         hence "17 < 5 * sqrt 17"
           by (rule power2_less_imp_less, simp)
         hence "?dl\<^sup>2 < (1 / sqrt 2)\<^sup>2"
           by (simp add: power2_eq_square field_simps)
         thus "?dl < 1 / sqrt 2"
           by (rule power2_less_imp_less, simp)
       qed
       thus ?thesis
         using cmod_d
         by (simp add: field_simps)
     qed
 
     have cmod_d: "1 - (cmod (to_complex ?d))\<^sup>2 = (-17 + 5*sqrt 17) / 4" (is "_ = ?cmod_d")
       apply (simp only: to_complex_of_complex)
       apply (subst cmod_d)
       apply (simp add: power_mult_distrib)
       apply (simp add: power2_eq_square field_simps)
       done
 
     have cmod_d_c: "(cmod (to_complex ?d - to_complex ?c))\<^sup>2 = (17 - 4*sqrt 17) / 4" (is "_ = ?cmod_dc")
       unfolding cmod_square
       by (simp add: field_simps)
 
     have cmod_c: "1 - (cmod (to_complex ?c))\<^sup>2 = 3/4" (is "_ = ?cmod_c")
       by (simp add: power2_eq_square)
 
     have xx: "\<And> x::real. x + x = 2*x"
       by simp
 
     have "cmod ((to_complex ?b) - (to_complex ?d)) = cmod ((to_complex ?d) - (to_complex ?c))"
       by (simp add: cmod_def power2_eq_square field_simps)
     moreover
     have "cmod (to_complex ?b) = cmod (to_complex ?c)"
       by simp
     ultimately
     have *: "poincare_distance_formula' (to_complex ?b) (to_complex ?d) =
              poincare_distance_formula' (to_complex ?d) (to_complex ?c)"
       unfolding poincare_distance_formula'_def
       by simp
 
     have **: "poincare_distance_formula' (to_complex ?d) (to_complex ?c) = (sqrt 17) / 3"
       unfolding poincare_distance_formula'_def
     proof (subst cmod_d, subst cmod_c, subst cmod_d_c)
       have "(sqrt 17 * 15)\<^sup>2 \<noteq> 51\<^sup>2"
         by simp
       hence "sqrt 17 * 15 \<noteq> 51"
         by force
       hence "sqrt 17 * 15 - 51 \<noteq> 0"
         by simp
 
       have "(5 * sqrt 17)\<^sup>2 \<noteq> 17\<^sup>2"
         by simp
       hence "5 * sqrt 17 \<noteq> 17"
         by force
       hence "?cmod_d * ?cmod_c \<noteq> 0"
         by simp
       hence "1 + 2 * (?cmod_dc / (?cmod_d * ?cmod_c)) =  (?cmod_d * ?cmod_c + 2 * ?cmod_dc) / (?cmod_d * ?cmod_c)"
         using add_frac_num[of "?cmod_d * ?cmod_c" "2 * ?cmod_dc" 1]
         by (simp add: field_simps)
       also have "... = (64 * (85 - sqrt 17 * 17)) / (64 * (sqrt 17 * 15 - 51))"
         by (simp add: field_simps)
       also have "... = (85 - sqrt 17 * 17) / (sqrt 17 * 15 - 51)"
         by (rule mult_divide_mult_cancel_left, simp)
       also have "... = sqrt 17 / 3"
         by (subst frac_eq_eq, fact, simp, simp add: field_simps)
       finally
       show "1 + 2 * (?cmod_dc / (?cmod_d * ?cmod_c)) = sqrt 17 / 3"
         .
     qed
 
     have "sqrt 17 \<ge> 3"
     proof-
       have "(sqrt 17)\<^sup>2 \<ge> 3\<^sup>2"
         by simp
       thus ?thesis
         by (rule power2_le_imp_le, simp)
     qed
     thus "poincare_between ?b ?d ?c"
       unfolding poincare_between_sum_distances[OF \<open>?b \<in> unit_disc\<close> \<open>?d \<in> unit_disc\<close> \<open>?c \<in> unit_disc\<close>]
       unfolding poincare_distance_formula[OF \<open>?b \<in> unit_disc\<close> \<open>?d \<in> unit_disc\<close>]
       unfolding poincare_distance_formula[OF \<open>?d \<in> unit_disc\<close> \<open>?c \<in> unit_disc\<close>]
       unfolding poincare_distance_formula[OF \<open>?b \<in> unit_disc\<close> \<open>?c \<in> unit_disc\<close>]
       unfolding poincare_distance_formula_def
       apply (subst *, subst xx, subst **, subst arcosh_double)
       apply (simp_all add: cmod_def power2_eq_square)
       done
 
     show "poincare_between ?a ?d ?t"
     proof (subst poincare_between_0uv[OF \<open>?d \<in> unit_disc\<close> \<open>?t \<in> unit_disc\<close> \<open>?d \<noteq> ?a\<close>])
       show "?t \<noteq> 0\<^sub>h"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         hence "1/2 + \<i>/2 = 0"
           by simp
         hence "Re (1/2 + \<i>/2) = 0"
           by simp
         thus False
           by simp
       qed
     next
       have "19\<^sup>2 \<le> (5 * sqrt 17)\<^sup>2"
         by simp
       hence "19 \<le> 5 * sqrt 17"
         by (rule power2_le_imp_le, simp)
       hence "cmod (to_complex ?d) \<le> cmod (to_complex ?t)"
         by (simp add: Let_def cmod_def power2_eq_square field_simps)
       moreover
       have "arg (to_complex ?d) = arg (to_complex ?t)"
       proof-
         have 1: "to_complex ?d = ((5 - sqrt 17) / 4) * (1 + \<i>)"
           by (simp add: field_simps)
 
         have 2: "to_complex ?t = (cor (1/2)) * (1 + \<i>)"
           by (simp add: field_simps)
 
         have "(sqrt 17)\<^sup>2 < 5\<^sup>2"
           by simp
         hence "sqrt 17 < 5"
           by (rule power2_less_imp_less, simp)
         hence 3: "(5 - sqrt 17) / 4 > 0"
           by simp
 
         have 4: "(1::real) / 2 > 0"
           by simp
 
         show ?thesis
           apply (subst 1, subst 2)
           apply (subst arg_mult_real_positive[OF 3])
           apply (subst arg_mult_real_positive[OF 4])
           by simp
       qed
       ultimately
       show "let d' = to_complex ?d; t' = to_complex ?t in arg d' = arg t' \<and> cmod d' \<le> cmod t'"
         by simp
     qed
 
     show "?a = ?d \<Longrightarrow> False"
       using \<open>?d \<noteq> ?a\<close>
       by simp
 
     fix x y
     assume "x \<in> unit_disc" "y \<in> unit_disc"
 
     assume abx: "poincare_between ?a ?b x"
     hence "x \<in> circline_set x_axis"
       using poincare_between_poincare_line_uvz[of ?a ?b x] \<open>x \<in> unit_disc\<close> \<open>?a \<noteq> ?b\<close>
       using poincare_line_0_real_is_x_axis[of ?b]
       by (auto simp add: circline_set_x_axis)
 
     have "x \<noteq> 0\<^sub>h"
       using abx poincare_between_sandwich[of ?a ?b] \<open>?a \<noteq> ?b\<close>
       by auto
 
     have "x \<in> positive_x_axis"
       using \<open>x \<in> circline_set x_axis\<close> \<open>x \<noteq> 0\<^sub>h\<close> \<open>x \<in> unit_disc\<close>
       using abx poincare_between_x_axis_0uv[of "1/2" "Re (to_complex x)"]
       unfolding circline_set_x_axis positive_x_axis_def
       by (auto simp add: cmod_eq_Re abs_less_iff complex_eq_if_Re_eq)
 
     assume acy: "poincare_between ?a ?c y"
     hence "y \<in> circline_set y_axis"
       using poincare_between_poincare_line_uvz[of ?a ?c y] \<open>y \<in> unit_disc\<close> \<open>?a \<noteq> ?c\<close>
       using poincare_line_0_imag_is_y_axis[of ?c]
       by (auto simp add: circline_set_y_axis)
 
     have "y \<noteq> 0\<^sub>h"
       using acy poincare_between_sandwich[of ?a ?c] \<open>?a \<noteq> ?c\<close>
       by auto
 
     have "y \<in> positive_y_axis"
     proof-
       have " \<And>x. \<lbrakk>x \<noteq> 0; poincare_between 0\<^sub>h (of_complex (\<i> / 2)) (of_complex x); is_imag x; - 1 < Im x\<rbrakk> \<Longrightarrow> 0 < Im x"
         by (smt add.left_neutral complex.expand divide_complex_def complex_eq divide_less_0_1_iff divide_less_eq_1_pos imaginary_unit.simps(1) mult.left_neutral of_real_1 of_real_add of_real_divide of_real_eq_0_iff one_add_one poincare_between_y_axis_0uv zero_complex.simps(1) zero_complex.simps(2) zero_less_divide_1_iff)
       thus ?thesis
         using \<open>y \<in> circline_set y_axis\<close> \<open>y \<noteq> 0\<^sub>h\<close> \<open>y \<in> unit_disc\<close>
         using acy
         unfolding circline_set_y_axis positive_y_axis_def
         by (auto simp add: cmod_eq_Im abs_less_iff)
     qed
 
     have "x \<noteq> y"
       using \<open>x \<in> positive_x_axis\<close> \<open>y \<in> positive_y_axis\<close>
       unfolding positive_x_axis_def positive_y_axis_def circline_set_x_axis circline_set_y_axis
       by auto
 
     assume xty: "poincare_between x ?t y"
 
     let ?xy = "poincare_line x y"
 
     have "?t \<in> circline_set ?xy"
       using xty poincare_between_poincare_line_uzv[OF \<open>x \<noteq> y\<close> \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>?t \<in> unit_disc\<close>]
       by simp
 
     moreover
 
     have "?xy \<noteq> x_axis"
       using poincare_line_circline_set[OF \<open>x \<noteq> y\<close>] \<open>y \<in> positive_y_axis\<close>
       by (auto simp add: circline_set_x_axis positive_y_axis_def)
     hence "intersects_x_axis_positive ?xy"
       using intersects_x_axis_positive_iff[of "?xy"] \<open>x \<noteq> y\<close> \<open>x \<in> unit_disc\<close> \<open>x \<in> positive_x_axis\<close>
       by auto
 
     moreover
 
     have "?xy \<noteq> y_axis"
       using poincare_line_circline_set[OF \<open>x \<noteq> y\<close>] \<open>x \<in> positive_x_axis\<close>
       by (auto simp add: circline_set_y_axis positive_x_axis_def)
     hence "intersects_y_axis_positive ?xy"
       using intersects_y_axis_positive_iff[of "?xy"] \<open>x \<noteq> y\<close> \<open>y \<in> unit_disc\<close> \<open>y \<in> positive_y_axis\<close>
       by auto
 
     ultimately
 
     show False
       using negated_euclidean_axiom_aux[of ?xy] \<open>x \<noteq> y\<close>
       unfolding circline_set_def
       by auto
   qed
 qed
 
 text \<open>Alternate form of the Euclidean axiom -- this one is much easier to prove\<close>
 lemma negated_euclidean_axiom':
   shows "\<exists> a b c.
            a \<in> unit_disc \<and> b \<in> unit_disc \<and> c \<in> unit_disc \<and> \<not>(poincare_collinear {a, b, c})  \<and>
                 \<not>(\<exists> x. x \<in> unit_disc \<and> 
                   poincare_distance a x = poincare_distance b x \<and>
                   poincare_distance a x = poincare_distance c x)"
 proof-
   let ?a = "of_complex (\<i>/2)"
   let ?b = "of_complex (-\<i>/2)"
   let ?c = "of_complex (1/5)"
 
   have "(\<i>/2) \<noteq> (-\<i>/2)"
     by simp
   hence "?a \<noteq> ?b"
     by (metis to_complex_of_complex)
   have "(\<i>/2) \<noteq> (1/5)"
     by simp
   hence "?a \<noteq> ?c"
     by (metis to_complex_of_complex)
   have "(-\<i>/2) \<noteq> (1/5)"
     by (simp add: minus_equation_iff)
   hence "?b \<noteq> ?c"
     by (metis to_complex_of_complex)
 
   have "?a \<in> unit_disc" "?b \<in> unit_disc" "?c \<in> unit_disc"
     by auto
 
   moreover
   have "\<not>(poincare_collinear {?a, ?b, ?c})"
     unfolding poincare_collinear_def
   proof(rule ccontr)
     assume " \<not> (\<nexists>p. is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p)"
     then obtain p where "is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p"
       by auto
     let ?ab = "poincare_line ?a ?b"
     have "p = ?ab"
       using \<open>is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p\<close>
       using unique_poincare_line[of ?a ?b] \<open>?a \<noteq> ?b\<close> \<open>?a \<in> unit_disc\<close> \<open>?b \<in> unit_disc\<close>
       by auto
     have "?c \<notin> circline_set ?ab"
     proof(rule ccontr)
       assume "\<not> ?c \<notin> circline_set ?ab"
       have "poincare_between ?a 0\<^sub>h ?b"
         unfolding poincare_between_def
         using cross_ratio_0inf by auto
       hence "0\<^sub>h \<in> circline_set ?ab"
         using \<open>?a \<noteq> ?b\<close> \<open>?a \<in> unit_disc\<close> \<open>?b \<in> unit_disc\<close>
         using poincare_between_poincare_line_uzv zero_in_unit_disc 
         by blast
       hence "?ab = poincare_line 0\<^sub>h ?a"
         using unique_poincare_line[of ?a ?b] \<open>?a \<noteq> ?b\<close> \<open>?a \<in> unit_disc\<close> \<open>?b \<in> unit_disc\<close>
         using \<open>is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p\<close> 
         using \<open>p = ?ab\<close> poincare_line_circline_set(1) unique_poincare_line
         by (metis add.inverse_neutral divide_minus_left of_complex_zero_iff  zero_in_unit_disc)
       hence "(\<i>/2) * cnj(1/5) = cnj(\<i>/2) * (1/5)"
         using poincare_collinear_zero_iff[of "(\<i>/2)" "(1/5)"]
         using \<open>?a \<noteq> ?c\<close> \<open>\<not> ?c \<notin> circline_set ?ab\<close> \<open>?a \<in> unit_disc\<close> \<open>?c \<in> unit_disc\<close> \<open>p = ?ab\<close>
         using \<open>0\<^sub>h \<in> circline_set ?ab\<close> \<open>is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p\<close> 
         using poincare_collinear_def by auto
       thus False
         by simp
     qed 
     thus False
       using \<open>p = ?ab\<close> \<open>is_poincare_line p \<and> {?a, ?b, ?c} \<subseteq> circline_set p\<close> 
       by auto
   qed
 
   moreover
 
   have "\<not>(\<exists> x. x \<in> unit_disc \<and> 
                   poincare_distance ?a x = poincare_distance ?b x \<and>
                   poincare_distance ?a x = poincare_distance ?c x)"
   proof(rule ccontr)
     assume "\<not> ?thesis"
     then obtain x where "x \<in> unit_disc" "poincare_distance ?a x = poincare_distance ?b x"
                         "poincare_distance ?a x = poincare_distance ?c x"
       by blast
     let ?x = "to_complex x"
     have "poincare_distance_formula' (\<i>/2) ?x = poincare_distance_formula' (-\<i>/2) ?x"
       using \<open>poincare_distance ?a x = poincare_distance ?b x\<close>
       using \<open>x \<in> unit_disc\<close> \<open>?a \<in> unit_disc\<close> \<open>?b \<in> unit_disc\<close>
       by (metis cosh_dist to_complex_of_complex)
     hence "(cmod (\<i> / 2 - ?x))\<^sup>2 = (cmod (- \<i> / 2 - ?x))\<^sup>2"
       unfolding poincare_distance_formula'_def
       apply (simp add:field_simps)
       using \<open>x \<in> unit_disc\<close> unit_disc_cmod_square_lt_1 by fastforce
     hence "Im ?x = 0"
       unfolding cmod_def
       by (simp add: power2_eq_iff)
 
     have "1 - (Re ?x)\<^sup>2 \<noteq> 0"
       using \<open>x \<in> unit_disc\<close> unit_disc_cmod_square_lt_1
       using cmod_power2 by force
     hence "24 - 24 * (Re ?x)\<^sup>2 \<noteq> 0"
       by simp
     have "poincare_distance_formula' (\<i>/2) ?x = poincare_distance_formula' (1/5) ?x"
       using \<open>poincare_distance ?a x = poincare_distance ?c x\<close>
       using \<open>x \<in> unit_disc\<close> \<open>?a \<in> unit_disc\<close> \<open>?c \<in> unit_disc\<close>
       by (metis cosh_dist to_complex_of_complex)
     hence "(2 + 8 * (Re ?x)\<^sup>2) /(3 - 3 * (Re ?x)\<^sup>2) = 2 * (1 - Re ?x * 5)\<^sup>2 / (24 - 24 * (Re ?x)\<^sup>2)" (is "?lhs = ?rhs")
       unfolding poincare_distance_formula'_def
       apply (simp add:field_simps)
       unfolding cmod_def 
       using \<open>Im ?x = 0\<close> 
       by (simp add:field_simps)
     hence *: "?lhs * (24 - 24 * (Re ?x)\<^sup>2)  = ?rhs * (24 - 24 * (Re ?x)\<^sup>2) "
       using \<open>(24 - 24 * (Re ?x)\<^sup>2) \<noteq> 0\<close> 
       by simp
     have "?lhs * (24 - 24 * (Re ?x)\<^sup>2) = (2 + 8 * (Re ?x)\<^sup>2) * 8"
       using \<open>(24 - 24 * (Re ?x)\<^sup>2) \<noteq> 0\<close> \<open>1 - (Re ?x)\<^sup>2 \<noteq> 0\<close>
       by (simp add:field_simps)
     have "?rhs * (24 - 24 * (Re ?x)\<^sup>2) = 2 * (1 - Re ?x * 5)\<^sup>2"
       using \<open>(24 - 24 * (Re ?x)\<^sup>2) \<noteq> 0\<close> \<open>1 - (Re ?x)\<^sup>2 \<noteq> 0\<close>
       by (simp add:field_simps)
     hence "(2 + 8 * (Re ?x)\<^sup>2) * 8 = 2 * (1 - Re ?x * 5)\<^sup>2"
       using * \<open>?lhs * (24 - 24 * (Re ?x)\<^sup>2) = (2 + 8 * (Re ?x)\<^sup>2) * 8\<close>
       by simp      
     hence "7 * (Re ?x)\<^sup>2 + 10 * (Re ?x) + 7 = 0"
       by (simp add:field_simps comm_ring_1_class.power2_diff)
     thus False
       using discriminant_iff[of 7 "Re (to_complex x)" 10 7] discrim_def[of 7 10 7]
       by auto
   qed
 
   ultimately show ?thesis
     apply (rule_tac x="?a" in exI)
     apply (rule_tac x="?b" in exI)
     apply (rule_tac x="?c" in exI)
     by auto
 qed
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Continuity axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 text \<open>The set $\phi$ is on the left of the set $\psi$\<close>
 abbreviation set_order where
  "set_order A \<phi> \<psi> \<equiv> \<forall>x\<in> unit_disc. \<forall>y\<in> unit_disc.  \<phi> x \<and> \<psi> y \<longrightarrow> poincare_between A x y"
 text \<open>The point $B$ is between the sets $\phi$ and $\psi$\<close>
 abbreviation point_between_sets where
  "point_between_sets \<phi> B \<psi> \<equiv> \<forall>x\<in> unit_disc. \<forall>y\<in> unit_disc.  \<phi> x \<and> \<psi> y \<longrightarrow> poincare_between x B y"
 
 lemma  continuity:
   assumes "\<exists> A \<in> unit_disc. set_order A \<phi> \<psi>"
   shows   "\<exists> B \<in> unit_disc. point_between_sets \<phi> B \<psi>"
 proof (cases "(\<exists> x0 \<in> unit_disc. \<phi> x0) \<and> (\<exists> y0 \<in> unit_disc. \<psi> y0)")
   case False
   thus ?thesis
     using assms by blast
 next
   case True
   then obtain Y0 where "\<psi> Y0" "Y0 \<in> unit_disc"
     by auto
   obtain A where *: "A \<in> unit_disc" "set_order A \<phi> \<psi>"
     using assms
     by auto
   show ?thesis
   proof(cases "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> x = A")
     case True
     thus ?thesis
       using \<open>A \<in> unit_disc\<close>
       using poincare_between_nonstrict(1) by blast
   next
     case False
     then obtain X0 where "\<phi> X0" "X0 \<noteq> A" "X0 \<in> unit_disc"
       by auto
     have "Y0 \<noteq> A"
     proof(rule ccontr)
       assume "\<not> Y0 \<noteq> A"
       hence "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> poincare_between A x A"
         using * \<open>\<psi> Y0\<close>
         by (cases A) force
       hence "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> x = A"
         using * poincare_between_sandwich by blast
       thus False
         using False by auto
     qed
 
     show ?thesis
     proof (cases "\<exists> B \<in> unit_disc. \<phi> B \<and> \<psi> B")
       case True
       then obtain B where "B \<in> unit_disc" "\<phi> B" "\<psi> B"
         by auto
       hence "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> poincare_between A x B"
         using * by auto
       have "\<forall> y \<in> unit_disc. \<psi> y \<longrightarrow> poincare_between A B y"
         using * \<open>B \<in> unit_disc\<close> \<open>\<phi> B\<close>
         by auto
 
       show ?thesis
       proof(rule+)
         show "B \<in> unit_disc"
           by fact
       next
         fix x y
         assume "x \<in> unit_disc" "y \<in> unit_disc" "\<phi> x \<and> \<psi> y"
         hence "poincare_between A x B" "poincare_between A B y"
           using \<open>\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> poincare_between A x B\<close>
           using \<open>\<forall> y \<in> unit_disc. \<psi> y \<longrightarrow> poincare_between A B y\<close>
           by simp+
         thus "poincare_between x B y"
           using \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>B \<in> unit_disc\<close> \<open>A \<in> unit_disc\<close>
           using poincare_between_transitivity[of A x B y]
           by simp
       qed
     next
       case False
       have "poincare_between A X0 Y0"
         using \<open>\<phi> X0\<close> \<open>\<psi> Y0\<close> * \<open>Y0 \<in> unit_disc\<close> \<open>X0 \<in> unit_disc\<close>
         by auto
       have "\<forall> \<phi>. \<forall> \<psi>. set_order A \<phi> \<psi> \<and> \<not> (\<exists> B \<in> unit_disc. \<phi> B \<and> \<psi> B) \<and> \<phi> X0 \<and> 
                       (\<exists> y \<in> unit_disc. \<psi> y) \<and> (\<exists> x \<in> unit_disc. \<phi> x)
                    \<longrightarrow> (\<exists> B \<in> unit_disc. point_between_sets \<phi> B \<psi>)"
             (is "?P A X0")
       proof (rule wlog_positive_x_axis[where P="?P"])
         show "A \<in> unit_disc"
           by fact
       next
         show "X0 \<in> unit_disc"
           by fact
       next
         show "A \<noteq> X0"
           using \<open>X0 \<noteq> A\<close> by simp
       next
         fix M u v
         let ?M = "\<lambda> x. moebius_pt M x"
         let ?Mu = "?M u" and ?Mv = "?M v"
         assume hip: "unit_disc_fix M" "u \<in> unit_disc" "v \<in> unit_disc" "u \<noteq> v"
                "?P ?Mu ?Mv"
         show "?P u v"
         proof safe
           fix \<phi> \<psi> x y
           assume "set_order u \<phi> \<psi>" "\<not> (\<exists>B\<in>unit_disc. \<phi> B \<and> \<psi> B)" "\<phi> v"
                   "y \<in> unit_disc" "\<psi> y" "x \<in> unit_disc" "\<phi> x"
 
           let ?M\<phi> = "\<lambda> X'. \<exists> X. \<phi> X \<and> ?M X = X'" 
           let ?M\<psi> = "\<lambda> X'. \<exists> X. \<psi> X \<and> ?M X = X'"
 
           obtain M\<phi> where "M\<phi> = ?M\<phi>" by simp
           obtain M\<psi> where "M\<psi> = ?M\<psi>" by simp
 
           have "M\<phi> ?Mv"
             using \<open>\<phi> v\<close> using \<open>M\<phi> = ?M\<phi>\<close> 
             by blast
           moreover
           have "\<not> (\<exists> B \<in>unit_disc. M\<phi> B \<and> M\<psi> B)"
             using \<open>\<not> (\<exists>B\<in>unit_disc. \<phi> B \<and> \<psi> B)\<close>
             using \<open>M\<phi> = ?M\<phi>\<close> \<open>M\<psi> = ?M\<psi>\<close>
             by (metis hip(1) moebius_pt_invert unit_disc_fix_discI unit_disc_fix_moebius_inv)
           moreover
           have "\<exists> y \<in> unit_disc. M\<psi> y"
             using \<open>y \<in> unit_disc\<close> \<open>\<psi> y\<close>  \<open>M\<psi> = ?M\<psi>\<close> \<open>unit_disc_fix M\<close>
             by auto
           moreover
           have "set_order ?Mu ?M\<phi> ?M\<psi>"
           proof ((rule ballI)+, rule impI)                                       
             fix Mx My
             assume "Mx \<in> unit_disc" "My \<in> unit_disc" "?M\<phi> Mx \<and> ?M\<psi> My"
             then obtain x y where "\<phi> x \<and> ?M x = Mx" "\<psi> y \<and> ?M y = My"
               by blast
 
             hence "x \<in> unit_disc" "y \<in> unit_disc"
               using \<open>Mx \<in> unit_disc\<close> \<open>My \<in> unit_disc\<close> \<open>unit_disc_fix M\<close>
               by (metis moebius_pt_comp_inv_left unit_disc_fix_discI unit_disc_fix_moebius_inv)+
 
             hence "poincare_between u x y"
               using \<open>set_order u \<phi> \<psi>\<close>
               using \<open>Mx \<in> unit_disc\<close> \<open>My \<in> unit_disc\<close> \<open>\<phi> x \<and> ?M x = Mx\<close> \<open>\<psi> y \<and> ?M y = My\<close>
               by blast
             then show "poincare_between ?Mu Mx My"
               using \<open>\<phi> x \<and> ?M x = Mx\<close> \<open>\<psi> y \<and> ?M y = My\<close>
               using \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>u \<in> unit_disc\<close> \<open>unit_disc_fix M\<close> 
               using unit_disc_fix_moebius_preserve_poincare_between by blast
           qed
 
           hence  "set_order ?Mu M\<phi> M\<psi>"
             using \<open>M\<phi> = ?M\<phi>\<close> \<open>M\<psi> = ?M\<psi>\<close>
             by simp
           ultimately
           have "\<exists> Mb \<in> unit_disc. point_between_sets M\<phi> Mb M\<psi>"
             using hip(5)
             by blast
           then obtain Mb where bbb: 
             "Mb \<in> unit_disc" "point_between_sets ?M\<phi> Mb ?M\<psi>"
             using \<open>M\<phi> = ?M\<phi>\<close> \<open>M\<psi> = ?M\<psi>\<close>
             by auto
 
           let ?b = "moebius_pt (moebius_inv M) Mb"
           show "\<exists> b \<in> unit_disc. point_between_sets \<phi> b \<psi>"
           proof (rule_tac x="?b" in bexI, (rule ballI)+, rule impI)
             fix x y
             assume "x \<in> unit_disc" "y \<in> unit_disc" "\<phi> x \<and> \<psi> y"
             hence "poincare_between u x y"
               using \<open>set_order u \<phi> \<psi>\<close>
               by blast
             
             let ?Mx = "?M x" and ?My = "?M y"
 
             have "?M\<phi> ?Mx" "?M\<psi> ?My"
               using \<open>\<phi> x \<and> \<psi> y\<close>
               by blast+
             have "?Mx \<in> unit_disc" "?My \<in> unit_disc"
               using \<open>x \<in> unit_disc\<close> \<open>unit_disc_fix M\<close> \<open>y \<in> unit_disc\<close>
               by auto
 
             hence "poincare_between ?Mx Mb ?My"
               using \<open>?M\<phi> ?Mx\<close> \<open>?M\<psi> ?My\<close> \<open>?Mx \<in> unit_disc\<close> \<open>?My \<in> unit_disc\<close> bbb
               by auto
 
             then show "poincare_between x ?b y"
               using \<open>unit_disc_fix M\<close> 
               using \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>Mb \<in> unit_disc\<close> \<open>?Mx \<in> unit_disc\<close> \<open>?My \<in> unit_disc\<close>
               using unit_disc_fix_moebius_preserve_poincare_between[of M x ?b y]
               by auto
           next
             show "?b \<in> unit_disc"
               using bbb \<open>unit_disc_fix M\<close>
               by auto
           qed
         qed
       next
         fix X
         assume xx: "is_real X" "0 < Re X" "Re X < 1"
         let ?X = "of_complex X"
         show "?P 0\<^sub>h ?X"
         proof ((rule allI)+, rule impI, (erule conjE)+)
           fix \<phi> \<psi>
           assume "set_order 0\<^sub>h \<phi> \<psi>" "\<not> (\<exists>B\<in>unit_disc. \<phi> B \<and> \<psi> B)" "\<phi> ?X" 
                  "\<exists>y\<in>unit_disc. \<psi> y" "\<exists>x\<in>unit_disc. \<phi> x"
           have "?X \<in> unit_disc"
             using xx
             by (simp add: cmod_eq_Re)
 
           have \<psi>pos: "\<forall> y \<in> unit_disc. \<psi> y \<longrightarrow> (is_real (to_complex y) \<and> Re (to_complex y) > 0)"
           proof(rule ballI, rule impI)
             fix y
             let ?y = "to_complex y"
             assume "y \<in> unit_disc" "\<psi> y"
 
             hence "poincare_between 0\<^sub>h ?X y"
               using \<open>set_order 0\<^sub>h \<phi> \<psi>\<close>
               using \<open>?X \<in> unit_disc\<close> \<open>\<phi> ?X\<close>
               by auto
 
             thus "is_real ?y \<and> 0 < Re ?y"
               using xx \<open>?X \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close>
               by (metis (mono_tags, hide_lams) arg_0_iff of_complex_zero_iff poincare_between_0uv poincare_between_sandwich to_complex_of_complex unit_disc_to_complex_inj zero_in_unit_disc)
           qed
 
           have \<phi>noneg: "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> (is_real (to_complex x) \<and> Re (to_complex x) \<ge> 0)"
           proof(rule ballI, rule impI)
             fix x
             assume "x \<in> unit_disc" "\<phi> x"
 
             obtain y where "y \<in> unit_disc" "\<psi> y"
               using \<open>\<exists> y \<in> unit_disc. \<psi> y\<close> by blast
 
             let ?x = "to_complex x" and ?y = "to_complex y"
 
             have "is_real ?y" "Re ?y > 0"
               using \<psi>pos \<open>\<psi> y\<close> \<open>y \<in> unit_disc\<close>
               by auto
 
             have "poincare_between 0\<^sub>h x y"
               using \<open>set_order 0\<^sub>h \<phi> \<psi>\<close>
               using \<open>x \<in> unit_disc\<close> \<open>\<phi> x\<close> \<open>y\<in>unit_disc\<close> \<open>\<psi> y\<close>
               by auto
 
             thus "is_real ?x \<and> 0 \<le> Re ?x"
               using \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>is_real (to_complex y)\<close> \<open>\<psi> y\<close>
               using \<open>set_order 0\<^sub>h \<phi> \<psi>\<close>
               using \<open>\<phi> ?X\<close> \<open>?X \<in> unit_disc\<close> \<open>Re ?y > 0\<close>
               by (metis arg_0_iff le_less of_complex_zero poincare_between_0uv to_complex_of_complex zero_complex.simps(1) zero_complex.simps(2))
           qed
 
           have \<phi>less\<psi>: "\<forall>x\<in>unit_disc. \<forall>y\<in>unit_disc. \<phi> x \<and> \<psi> y \<longrightarrow> Re (to_complex x) < Re (to_complex y)"
           proof((rule ballI)+, rule impI)
             fix x y
             let ?x = "to_complex x" and ?y = "to_complex y"
             assume "x \<in> unit_disc" "y \<in> unit_disc" "\<phi> x \<and> \<psi> y"
 
             hence "poincare_between 0\<^sub>h x y"
               using \<open>set_order 0\<^sub>h \<phi> \<psi>\<close>
               by auto
             moreover
             have "is_real ?x" "Re ?x \<ge> 0"
               using \<phi>noneg
               using \<open>x \<in> unit_disc\<close> \<open>\<phi> x \<and> \<psi> y\<close> by auto
             moreover
             have "is_real ?y" "Re ?y > 0"
               using \<psi>pos
               using \<open>y \<in> unit_disc\<close> \<open>\<phi> x \<and> \<psi> y\<close> by auto
             ultimately
             have "Re ?x \<le> Re ?y"
               using \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close>
-              by (metis Re_complex_of_real arg_0_iff le_less of_complex_zero poincare_between_0uv rcis_cmod_arg rcis_zero_arg to_complex_of_complex)
+              by (metis Re_complex_of_real arg_0_iff le_less of_complex_zero poincare_between_0uv rcis_cmod_Arg rcis_zero_arg to_complex_of_complex)
 
             have "Re ?x \<noteq> Re ?y"
               using \<open>\<phi> x \<and> \<psi> y\<close> \<open>is_real ?x\<close> \<open>is_real ?y\<close>
               using \<open>\<not> (\<exists>B\<in>unit_disc. \<phi> B \<and> \<psi> B)\<close> \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close>
               by (metis complex.expand unit_disc_to_complex_inj)
 
             thus "Re ?x < Re ?y"
               using \<open>Re ?x \<le> Re ?y\<close> by auto
           qed
 
           have "\<exists> b \<in> unit_disc. \<forall> x \<in> unit_disc. \<forall> y \<in> unit_disc. 
                     is_real (to_complex b) \<and> 
                     (\<phi> x \<and> \<psi> y \<longrightarrow> (Re (to_complex x) \<le> Re (to_complex b) \<and> Re (to_complex b) \<le> Re (to_complex y)))"
           proof-
             let ?Phi = "{x. (of_complex (cor x)) \<in> unit_disc \<and> \<phi> (of_complex (cor x))}"
 
             have "\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> Re (to_complex x) \<le> Sup ?Phi"
             proof(safe)
               fix x
               let ?x = "to_complex x"
               assume "x \<in> unit_disc" "\<phi> x"
               hence "is_real ?x" "Re ?x \<ge> 0"
                 using \<phi>noneg
                 by auto
               hence "cor (Re ?x) = ?x"
                  using complex_of_real_Re by blast
               hence "of_complex (cor (Re ?x)) \<in> unit_disc"
                 using \<open>x \<in> unit_disc\<close> 
                 by (metis inf_notin_unit_disc of_complex_to_complex)
               moreover
               have "\<phi> (of_complex (cor (Re ?x)))"
                 using \<open>cor (Re ?x) = ?x\<close> \<open>\<phi> x\<close> \<open>x \<in> unit_disc\<close>
                 by (metis inf_notin_unit_disc of_complex_to_complex)
               ultimately
               have "Re ?x \<in> ?Phi"
                 by auto
 
               have "\<exists>M. \<forall>x \<in> ?Phi. x \<le> M"
                 using \<phi>less\<psi>
                 using \<open>\<exists> y \<in> unit_disc. \<psi> y\<close>
                 by (metis (mono_tags, lifting) Re_complex_of_real le_less mem_Collect_eq to_complex_of_complex)
 
               thus "Re ?x \<le> Sup ?Phi"
                 using cSup_upper[of "Re ?x" ?Phi]
                 unfolding bdd_above_def
                 using \<open>Re ?x \<in> ?Phi\<close>
                 by auto                
             qed
 
             have "\<forall> y \<in> unit_disc. \<psi> y \<longrightarrow> Sup ?Phi \<le> Re (to_complex y)"
             proof (safe)
               fix y
               let ?y = "to_complex y"
               assume "\<psi> y" "y \<in> unit_disc"
               show "Sup ?Phi \<le> Re ?y"
               proof (rule ccontr)
                 assume "\<not> ?thesis"
                 hence "Re ?y < Sup ?Phi"
                   by auto
 
                 have "\<exists> x. \<phi> (of_complex (cor x)) \<and> (of_complex (cor x)) \<in> unit_disc"
                 proof -
                   obtain x' where "x' \<in> unit_disc" "\<phi> x'"
                     using \<open>\<exists> x \<in> unit_disc. \<phi> x\<close> by blast
                   let ?x' = "to_complex x'"
                   have "is_real ?x'"
                     using \<open>x' \<in> unit_disc\<close> \<open>\<phi> x'\<close>
                     using \<phi>noneg
                     by auto
                   hence "cor (Re ?x') = ?x'"
                     using complex_of_real_Re by blast
                   hence "x' = of_complex (cor (Re ?x'))"
                     using \<open>x' \<in> unit_disc\<close>
                     by (metis inf_notin_unit_disc of_complex_to_complex)
                   show ?thesis
                     apply (rule_tac x="Re ?x'" in exI)
                     using \<open>x' \<in> unit_disc\<close> 
                     apply (subst (asm) \<open>x' = of_complex (cor (Re ?x'))\<close>, simp)
                     using \<open>\<phi> x'\<close>
                     by (subst (asm) (2) \<open>x' = of_complex (cor (Re ?x'))\<close>, simp)               
                 qed
 
                 hence "?Phi \<noteq> {}"
                   by auto
 
                 then obtain x where "\<phi> (of_complex (cor x))" "Re ?y < x"
                                     "(of_complex (cor x)) \<in> unit_disc"
                   using \<open>Re ?y < Sup ?Phi\<close>
                   using less_cSupE[of "Re ?y" ?Phi]
                   by auto
                 moreover
                 have "Re ?y < Re (to_complex (of_complex (cor x)))"
                   using \<open>Re ?y < x\<close> 
                   by simp
                 ultimately
                 show False
                   using \<phi>less\<psi>
                   using \<open>\<psi> y\<close> \<open>y \<in> unit_disc\<close>
                   by (metis less_not_sym)
               qed
             qed
 
             thus ?thesis
               using \<open>\<forall> x \<in> unit_disc. \<phi> x \<longrightarrow> Re (to_complex x) \<le> Sup ?Phi\<close>
               apply (rule_tac x="(of_complex (cor (Sup ?Phi)))" in bexI, simp)
               using \<open>\<exists>y\<in>unit_disc. \<psi> y\<close> \<open>\<phi> ?X\<close> \<open>?X \<in> unit_disc\<close>
               using \<open>\<forall>y\<in>unit_disc. \<psi> y \<longrightarrow> is_real (to_complex y) \<and> 0 < Re (to_complex y)\<close>
               by (smt complex_of_real_Re inf_notin_unit_disc norm_of_real of_complex_to_complex to_complex_of_complex unit_disc_iff_cmod_lt_1 xx(2))
           qed
 
           then obtain B where "B \<in> unit_disc" "is_real (to_complex B)"
             "\<forall>x\<in>unit_disc. \<forall>y\<in>unit_disc. \<phi> x \<and> \<psi> y \<longrightarrow> Re (to_complex x) \<le> Re (to_complex B) \<and>
              Re (to_complex B) \<le> Re (to_complex y)"
             by blast
 
           show "\<exists> b \<in> unit_disc. point_between_sets \<phi> b \<psi>"
           proof (rule_tac x="B" in bexI)
             show "B \<in> unit_disc"
               by fact
           next
             show "point_between_sets \<phi> B \<psi>"
             proof ((rule ballI)+, rule impI)
               fix x y 
               let ?x = "to_complex x" and ?y = "to_complex y" and ?B = "to_complex B"
               assume "x \<in> unit_disc" "y \<in> unit_disc" "\<phi> x \<and> \<psi> y"
 
               hence "Re ?x \<le> Re ?B \<and> Re ?B \<le> Re ?y"
                 using \<open>\<forall>x\<in>unit_disc. \<forall>y\<in>unit_disc. \<phi> x \<and> \<psi> y \<longrightarrow> Re (to_complex x) \<le> Re ?B \<and>
                        Re (to_complex B) \<le> Re (to_complex y)\<close>
                 by auto
               moreover
               have "is_real ?x" "Re ?x \<ge> 0"
                 using \<phi>noneg
                 using \<open>x \<in> unit_disc\<close> \<open>\<phi> x \<and> \<psi> y\<close>
                 by auto
               moreover
               have "is_real ?y" "Re ?y > 0"
                 using \<psi>pos
                 using \<open>y \<in> unit_disc\<close> \<open>\<phi> x \<and> \<psi> y\<close>
                 by auto
               moreover
               have "cor (Re ?x) = ?x"
                 using complex_of_real_Re \<open>is_real ?x\<close> by blast
               hence "x = of_complex (cor (Re ?x))"
                 using \<open>x \<in> unit_disc\<close>
                 by (metis inf_notin_unit_disc of_complex_to_complex)
               moreover
               have "cor (Re ?y) = ?y"
                 using complex_of_real_Re \<open>is_real ?y\<close> by blast
               hence "y = of_complex (cor (Re ?y))"
                 using \<open>y \<in> unit_disc\<close>
                 by (metis inf_notin_unit_disc of_complex_to_complex)
               moreover
               have "cor (Re ?B) = ?B"
                 using complex_of_real_Re \<open>is_real (to_complex  B)\<close> by blast
               hence "B = of_complex (cor (Re ?B))"
                 using \<open>B \<in> unit_disc\<close>
                 by (metis inf_notin_unit_disc of_complex_to_complex)
               ultimately
               show "poincare_between x B y"
                 using \<open>is_real (to_complex B)\<close> \<open>x \<in> unit_disc\<close> \<open>y \<in> unit_disc\<close> \<open>B \<in> unit_disc\<close>
                 using poincare_between_x_axis_uvw[of "Re (to_complex x)" "Re (to_complex B)" "Re (to_complex y)"]
-                by (smt Re_complex_of_real arg_0_iff poincare_between_nonstrict(1) rcis_cmod_arg rcis_zero_arg unit_disc_iff_cmod_lt_1)
+                by (smt Re_complex_of_real arg_0_iff poincare_between_nonstrict(1) rcis_cmod_Arg rcis_zero_arg unit_disc_iff_cmod_lt_1)
             qed
           qed            
         qed
       qed 
       thus ?thesis
         using False \<open>\<phi> X0\<close> \<open>\<psi> Y0\<close> * \<open>Y0 \<in> unit_disc\<close> \<open>X0 \<in> unit_disc\<close>
         by auto
     qed      
   qed
 qed
 
 
 (* ------------------------------------------------------------------ *)
 subsection\<open>Limiting parallels axiom\<close>
 (* ------------------------------------------------------------------ *)
 
 text \<open>Auxiliary definitions\<close>
 
 definition poincare_on_line where
   "poincare_on_line p a b \<longleftrightarrow> poincare_collinear {p, a, b}"
 
 definition poincare_on_ray where 
   "poincare_on_ray p a b \<longleftrightarrow> poincare_between a p b \<or> poincare_between a b p"
 
 definition poincare_in_angle where
   "poincare_in_angle p a b c \<longleftrightarrow>
       b \<noteq> a \<and> b \<noteq> c \<and> p \<noteq> b \<and> (\<exists> x \<in> unit_disc. poincare_between a x c \<and> x \<noteq> a \<and> x \<noteq> c \<and> poincare_on_ray p b x)"
 
 definition poincare_ray_meets_line where
   "poincare_ray_meets_line a b c d \<longleftrightarrow> (\<exists> x \<in> unit_disc. poincare_on_ray x a b \<and> poincare_on_line x c d)"
 
 text \<open>All points on ray are collinear\<close>
 lemma poincare_on_ray_poincare_collinear:
   assumes "p \<in> unit_disc" and "a \<in> unit_disc" and "b \<in> unit_disc" and "poincare_on_ray p a b"
   shows "poincare_collinear {p, a, b}"
   using assms poincare_between_poincare_collinear
   unfolding poincare_on_ray_def
   by (metis insert_commute)
 
 text \<open>H-isometries preserve all defined auxiliary relations\<close>
 
 lemma unit_disc_fix_preserves_poincare_on_line [simp]:
   assumes "unit_disc_fix M" and "p \<in> unit_disc" "a \<in> unit_disc" "b \<in> unit_disc"
   shows "poincare_on_line (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) \<longleftrightarrow> poincare_on_line p a b"
   using assms
   unfolding poincare_on_line_def
   by auto
 
 lemma unit_disc_fix_preserves_poincare_on_ray [simp]:
   assumes "unit_disc_fix M" "p \<in> unit_disc" "a \<in> unit_disc" "b \<in> unit_disc"
   shows "poincare_on_ray (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) \<longleftrightarrow> poincare_on_ray p a b"
   using assms
   unfolding poincare_on_ray_def
   by auto
 
 lemma unit_disc_fix_preserves_poincare_in_angle [simp]:
   assumes "unit_disc_fix M" "p \<in> unit_disc" "a \<in> unit_disc" "b \<in> unit_disc" "c \<in> unit_disc"
   shows "poincare_in_angle (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) (moebius_pt M c) \<longleftrightarrow> poincare_in_angle p a b c" (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume "?lhs"
   then obtain Mx where *: "Mx \<in> unit_disc"
       "poincare_between (moebius_pt M a) Mx (moebius_pt M c)"
       "Mx \<noteq> moebius_pt M a" "Mx \<noteq> moebius_pt M c"  "poincare_on_ray (moebius_pt M p) (moebius_pt M b) Mx"
       "moebius_pt M b \<noteq> moebius_pt M a" "moebius_pt M b \<noteq> moebius_pt M c" "moebius_pt M p \<noteq> moebius_pt M b"
     unfolding poincare_in_angle_def
     by auto
   obtain x where "Mx = moebius_pt M x" "x \<in> unit_disc"
     by (metis "*"(1) assms(1) image_iff unit_disc_fix_iff)
   thus ?rhs
     using * assms
     unfolding poincare_in_angle_def
     by auto
 next
   assume ?rhs
   then obtain x where *: "x \<in> unit_disc"
       "poincare_between a x c"
       "x \<noteq> a" "x \<noteq> c"  "poincare_on_ray p b x"
       "b \<noteq> a" "b \<noteq> c" "p \<noteq> b"
     unfolding poincare_in_angle_def
     by auto
   thus ?lhs
     using assms
     unfolding poincare_in_angle_def
     by auto (rule_tac x="moebius_pt M x" in bexI, auto)
 qed
 
 lemma unit_disc_fix_preserves_poincare_ray_meets_line [simp]:
   assumes "unit_disc_fix M" "a \<in> unit_disc" "b \<in> unit_disc" "c \<in> unit_disc" "d \<in> unit_disc"
   shows "poincare_ray_meets_line (moebius_pt M a) (moebius_pt M b) (moebius_pt M c) (moebius_pt M d) \<longleftrightarrow> poincare_ray_meets_line a b c d" (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then obtain Mx where *: "Mx \<in> unit_disc" "poincare_on_ray Mx (moebius_pt M a) (moebius_pt M b)" 
     "poincare_on_line Mx (moebius_pt M c) (moebius_pt M d)"
     unfolding poincare_ray_meets_line_def
     by auto
   obtain x where "Mx = moebius_pt M x" "x \<in> unit_disc"
     by (metis "*"(1) assms(1) image_iff unit_disc_fix_iff)
   thus ?rhs
     using assms *
     unfolding poincare_ray_meets_line_def poincare_on_line_def
     by auto
 next
   assume ?rhs
   then obtain x where *: "x \<in> unit_disc" "poincare_on_ray x a b" 
     "poincare_on_line x c d"
     unfolding poincare_ray_meets_line_def
     by auto
   thus ?lhs
     using assms *
     unfolding poincare_ray_meets_line_def poincare_on_line_def
     by auto (rule_tac x="moebius_pt M x" in bexI, auto)
 qed
 
 text \<open>H-lines that intersect on the absolute do not meet (they do not share a common h-point)\<close>
 lemma tangent_not_meet:
   assumes "x1 \<in> unit_disc" and "x2 \<in> unit_disc" and "x1 \<noteq> x2" and "\<not> poincare_collinear {0\<^sub>h, x1, x2}"
   assumes "i \<in> ideal_points (poincare_line x1 x2)" "a \<in> unit_disc" "a \<noteq> 0\<^sub>h" "poincare_collinear {0\<^sub>h, a, i}"
   shows "\<not> poincare_ray_meets_line 0\<^sub>h a x1 x2"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then obtain x where "x \<in> unit_disc" "poincare_on_ray x 0\<^sub>h a" "poincare_collinear {x, x1, x2}"
     unfolding poincare_ray_meets_line_def poincare_on_line_def
     by auto
 
   have "poincare_collinear {0\<^sub>h, a, x}"
     using \<open>poincare_on_ray x 0\<^sub>h a\<close> \<open>x \<in> unit_disc\<close> \<open>a \<in> unit_disc\<close>
     by (meson poincare_between_poincare_collinear poincare_between_rev poincare_on_ray_def poincare_on_ray_poincare_collinear zero_in_unit_disc)
 
   have "x \<noteq> 0\<^sub>h"
     using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close> \<open>poincare_collinear {x, x1, x2}\<close>
     unfolding poincare_collinear_def
     by (auto simp add: assms(2) assms(3) poincare_between_rev)
 
   let ?l1 = "poincare_line 0\<^sub>h a"
   let ?l2 = "poincare_line x1 x2"
 
   have "i \<in> circline_set unit_circle"
     using \<open>i \<in> ideal_points (poincare_line x1 x2)\<close>
     using assms(3) ideal_points_on_unit_circle is_poincare_line_poincare_line by blast
 
   have "i \<in> circline_set ?l1"
     using \<open>poincare_collinear {0\<^sub>h, a, i}\<close>
     unfolding poincare_collinear_def
     using \<open>a \<in> unit_disc\<close> \<open>a \<noteq> 0\<^sub>h\<close>
     by (metis insert_subset unique_poincare_line zero_in_unit_disc)
 
   moreover
 
   have "x \<in> circline_set ?l1"
     using \<open>a \<in> unit_disc\<close> \<open>a \<noteq> 0\<^sub>h\<close> \<open>poincare_collinear {0\<^sub>h, a, x}\<close> \<open>x \<in> unit_disc\<close>
     by (metis poincare_collinear3_between poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_line_sym zero_in_unit_disc)
 
   moreover
 
   have "inversion x \<in> circline_set ?l1"
     using \<open>poincare_collinear {0\<^sub>h, a, x}\<close>
     using poincare_line_inversion_full[of "0\<^sub>h" a x] \<open>a \<in> unit_disc\<close> \<open>a \<noteq> 0\<^sub>h\<close> \<open>x \<in> unit_disc\<close>
     by (metis poincare_collinear3_between is_poincare_line_inverse_point is_poincare_line_poincare_line poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_line_sym zero_in_unit_disc)
 
   moreover
 
   have "x \<in> circline_set ?l2"
     using \<open>poincare_collinear {x, x1, x2}\<close> \<open>x1 \<noteq> x2\<close> \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>x \<in> unit_disc\<close>
     by (metis insert_commute inversion_noteq_unit_disc poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_collinear3_iff poincare_line_sym_general)
 
   moreover
 
   hence "inversion x \<in> circline_set ?l2"
     using  \<open>x1 \<noteq> x2\<close> \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>x \<in> unit_disc\<close>
     using poincare_line_inversion_full[of x1 x2 x]
     unfolding circline_set_def
     by auto
 
   moreover
 
   have "i \<in> circline_set ?l2"
     using \<open>x1 \<noteq> x2\<close> \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close>
     using \<open>i \<in> ideal_points ?l2\<close>
     by (simp add: ideal_points_on_circline)
 
   moreover
 
   have "x \<noteq> inversion x"
     using \<open>x \<in> unit_disc\<close>
     using inversion_noteq_unit_disc by fastforce
 
   moreover
 
   have "x \<noteq> i"
     using \<open>x \<in> unit_disc\<close>
     using \<open>i \<in> circline_set unit_circle\<close> circline_set_def inversion_noteq_unit_disc 
     by fastforce+
 
   moreover
 
   have "inversion x \<noteq> i"
     using \<open>i \<in> circline_set unit_circle\<close> \<open>x \<noteq> i\<close> circline_set_def inversion_unit_circle 
     by fastforce
 
   ultimately
           
   have "?l1 = ?l2"
     using unique_circline_set[of x "inversion x" i]
     by blast
 
   hence "0\<^sub>h \<in> circline_set ?l2"
     by (metis \<open>a \<noteq> 0\<^sub>h\<close> poincare_line_circline_set(1))
 
   thus False
     using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close>
     unfolding poincare_collinear_def
     using \<open>poincare_collinear {x, x1, x2}\<close> \<open>x1 \<noteq> x2\<close> \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> poincare_collinear_def unique_poincare_line
     by auto
 qed 
 
 lemma limiting_parallels:
   assumes "a \<in> unit_disc" and "x1 \<in> unit_disc" and "x2 \<in> unit_disc" and "\<not> poincare_on_line a x1 x2"
   shows "\<exists>a1\<in>unit_disc. \<exists>a2\<in>unit_disc.
           \<not> poincare_on_line a a1 a2 \<and>
           \<not> poincare_ray_meets_line a a1 x1 x2 \<and> \<not> poincare_ray_meets_line a a2 x1 x2 \<and>
           (\<forall>a'\<in>unit_disc. poincare_in_angle a' a1 a a2 \<longrightarrow> poincare_ray_meets_line a a' x1 x2)" (is "?P a x1 x2")
 proof-
   have "\<not> poincare_collinear {a, x1, x2}"
     using \<open>\<not> poincare_on_line a x1 x2\<close>
     unfolding poincare_on_line_def
     by simp
 
   have "\<forall> x1 x2. x1 \<in> unit_disc \<and> x2 \<in> unit_disc \<and> \<not> poincare_collinear {a, x1, x2} \<longrightarrow> ?P a x1 x2" (is "?Q a")
   proof (rule wlog_zero[OF \<open>a \<in> unit_disc\<close>])
     fix a u
     assume *: "u \<in> unit_disc" "cmod a < 1"
     hence uf: "unit_disc_fix (blaschke a)"
       by simp
     assume **: "?Q (moebius_pt (blaschke a) u)"
     show "?Q u"
     proof safe
       fix x1 x2
       let ?M = "moebius_pt (blaschke a)"
       assume xx: "x1 \<in> unit_disc" "x2 \<in> unit_disc" "\<not> poincare_collinear {u, x1, x2}"
       hence MM: "?M x1 \<in> unit_disc \<and> ?M x2\<in> unit_disc \<and> \<not> poincare_collinear {?M u, ?M x1, ?M x2}"   
         using *
         by auto
       show "?P u x1 x2" (is "\<exists>a1\<in>unit_disc. \<exists>a2\<in>unit_disc. ?P' a1 a2 u x1 x2")
       proof-
         obtain Ma1 Ma2 where MM: "Ma1 \<in> unit_disc" "Ma2 \<in> unit_disc" "?P' Ma1 Ma2 (?M u) (?M x1) (?M x2)"   
           using **[rule_format, OF MM]
           by blast
         hence MM': "\<forall>a'\<in>unit_disc. poincare_in_angle a' Ma1 (?M u) Ma2 \<longrightarrow> poincare_ray_meets_line (?M u) a' (?M x1) (?M x2)"
           by auto
         obtain a1 a2 where a: "a1 \<in> unit_disc" "a2 \<in> unit_disc" "?M a1 = Ma1" "?M a2 = Ma2"
           using uf
           by (metis \<open>Ma1 \<in> unit_disc\<close> \<open>Ma2 \<in> unit_disc\<close> image_iff unit_disc_fix_iff)
 
         have "\<forall>a'\<in>unit_disc. poincare_in_angle a' a1 u a2 \<longrightarrow> poincare_ray_meets_line u a' x1 x2"
         proof safe
           fix a'
           assume "a' \<in> unit_disc" "poincare_in_angle a' a1 u a2"
           thus "poincare_ray_meets_line u a' x1 x2"
             using MM(1-2) MM'[rule_format, of "?M a'"] * uf a xx
             by (meson unit_disc_fix_discI unit_disc_fix_preserves_poincare_in_angle unit_disc_fix_preserves_poincare_ray_meets_line)
         qed
 
         hence "?P' a1 a2 u x1 x2"
           using MM * uf xx a
           by auto
           
         thus ?thesis
           using \<open>a1 \<in> unit_disc\<close> \<open>a2 \<in> unit_disc\<close>
           by blast
       qed
     qed
   next
     show "?Q 0\<^sub>h"
     proof safe
       fix x1 x2
       assume "x1 \<in> unit_disc" "x2 \<in> unit_disc"
       assume "\<not> poincare_collinear {0\<^sub>h, x1, x2}"
       show "?P 0\<^sub>h x1 x2"
       proof-
         let ?lx = "poincare_line x1 x2"
 
         have "x1 \<noteq> x2"
           using \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close>\<open>\<not> poincare_collinear  {0\<^sub>h, x1, x2}\<close>
           using poincare_collinear3_between                  
           by auto
 
         have lx: "is_poincare_line ?lx"
           using is_poincare_line_poincare_line[OF \<open>x1 \<noteq> x2\<close>]
           by simp
 
         obtain i1 i2 where "ideal_points ?lx = {i1, i2}"
           by (meson \<open>x1 \<noteq> x2\<close> is_poincare_line_poincare_line obtain_ideal_points)
       
         let ?li = "poincare_line i1 i2"
         let ?i1 = "to_complex i1"
         let ?i2 = "to_complex i2"
 
         have "i1 \<in> unit_circle_set" "i2 \<in> unit_circle_set"
           using lx \<open>ideal_points ?lx = {i1, i2}\<close>
           unfolding unit_circle_set_def
           by (metis ideal_points_on_unit_circle insertI1, metis ideal_points_on_unit_circle insertI1 insertI2)
                                                                
         have "i1 \<noteq> i2"
           using \<open>ideal_points ?lx = {i1, i2}\<close> \<open>x1 \<in> unit_disc\<close> \<open>x1 \<noteq> x2\<close> \<open>x2 \<in> unit_disc\<close> ideal_points_different(1) 
           by blast
 
         let ?a1 = "of_complex (?i1 / 2)"
         let ?a2 = "of_complex (?i2 / 2)"
         let ?la = "poincare_line ?a1 ?a2"
 
         have "?a1 \<in> unit_disc" "?a2 \<in> unit_disc"
           using \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close>
           unfolding unit_circle_set_def unit_disc_def disc_def circline_set_def
           by auto (transfer, transfer, case_tac i1, case_tac i2, simp add: vec_cnj_def)+
 
         have "?a1 \<noteq> 0\<^sub>h" "?a2 \<noteq> 0\<^sub>h" 
           using \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close>
           unfolding unit_circle_set_def
           by auto
 
         have "?a1 \<noteq> ?a2"
           using \<open>i1 \<noteq> i2\<close>
           by (metis \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close> circline_set_def divide_cancel_right inversion_infty inversion_unit_circle mem_Collect_eq of_complex_to_complex of_complex_zero to_complex_of_complex unit_circle_set_def zero_neq_numeral)
 
         have "poincare_collinear {0\<^sub>h, ?a1, i1}"
           unfolding poincare_collinear_def
           using \<open>?a1 \<noteq> 0\<^sub>h\<close>[symmetric] is_poincare_line_poincare_line[of "0\<^sub>h" ?a1]
           unfolding circline_set_def
           apply (rule_tac x="poincare_line 0\<^sub>h ?a1" in exI, auto)
           apply (transfer, transfer, auto simp add: vec_cnj_def)
           done                                                               
 
         have "poincare_collinear {0\<^sub>h, ?a2, i2}"
           unfolding poincare_collinear_def
           using \<open>?a2 \<noteq> 0\<^sub>h\<close>[symmetric] is_poincare_line_poincare_line[of "0\<^sub>h" ?a2]
           unfolding circline_set_def
           apply (rule_tac x="poincare_line 0\<^sub>h ?a2" in exI, auto)
           apply (transfer, transfer, auto simp add: vec_cnj_def)
           done                                                               
 
         have "\<not> poincare_ray_meets_line 0\<^sub>h ?a1 x1 x2"
           using tangent_not_meet[of x1 x2 i1 ?a1]
           using \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>?a1 \<in> unit_disc\<close> \<open>x1 \<noteq> x2\<close> \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close>
           using \<open>ideal_points ?lx = {i1, i2}\<close> \<open>?a1 \<noteq> 0\<^sub>h\<close> \<open>poincare_collinear {0\<^sub>h, ?a1, i1}\<close>
           by simp
 
         moreover
 
         have "\<not> poincare_ray_meets_line 0\<^sub>h ?a2 x1 x2"
           using tangent_not_meet[of x1 x2 i2 ?a2]
           using \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> \<open>x1 \<noteq> x2\<close> \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close>
           using \<open>ideal_points ?lx = {i1, i2}\<close> \<open>?a2 \<noteq> 0\<^sub>h\<close> \<open>poincare_collinear {0\<^sub>h, ?a2, i2}\<close>
           by simp
 
         moreover
 
         have "\<forall>a' \<in> unit_disc. poincare_in_angle a' ?a1 0\<^sub>h ?a2 \<longrightarrow> poincare_ray_meets_line 0\<^sub>h a' x1 x2"
           unfolding poincare_in_angle_def
         proof safe
           fix a' a
           assume *: "a' \<in> unit_disc" "a \<in> unit_disc" "poincare_on_ray a' 0\<^sub>h a" "a' \<noteq> 0\<^sub>h"
                     "poincare_between ?a1 a ?a2" "a \<noteq> ?a1" "a \<noteq> ?a2"
           show "poincare_ray_meets_line 0\<^sub>h a' x1 x2"
           proof-
             have "\<forall> a' a1 a2 x1 x2 i1 i2.
                   a' \<in> unit_disc \<and> x1 \<in> unit_disc \<and> x2 \<in> unit_disc \<and> x1 \<noteq> x2 \<and>
                   \<not> poincare_collinear {0\<^sub>h, x1, x2} \<and> ideal_points (poincare_line x1 x2) = {i1, i2} \<and>
                   a1 = of_complex (to_complex i1 / 2) \<and> a2 = of_complex (to_complex i2 / 2) \<and>
                   i1 \<noteq> i2 \<and> a1 \<noteq> a2 \<and> poincare_collinear {0\<^sub>h, a1, i1} \<and> poincare_collinear {0\<^sub>h, a2, i2} \<and>
                   a1 \<in> unit_disc \<and> a2 \<in> unit_disc \<and> i1 \<in> unit_circle_set \<and> i2 \<in> unit_circle_set \<and>
                   poincare_on_ray a' 0\<^sub>h a \<and> a' \<noteq> 0\<^sub>h \<and> poincare_between a1 a a2 \<and> a \<noteq> a1 \<and> a \<noteq> a2 \<longrightarrow>
                   poincare_ray_meets_line 0\<^sub>h a' x1 x2" (is "\<forall> a' a1 a2 x1 x2 i1 i2. ?R 0\<^sub>h a' a1 a2 x1 x2 i1 i2 a")
             proof (rule wlog_rotation_to_positive_x_axis[OF \<open>a \<in> unit_disc\<close>])
               let ?R' = "\<lambda> a zero. \<forall> a' a1 a2 x1 x2 i1 i2. ?R zero a' a1 a2 x1 x2 i1 i2 a"
               fix xa
               assume xa: "is_real xa" "0 < Re xa" "Re xa < 1"
               let ?a = "of_complex xa"
               show "?R' ?a 0\<^sub>h"
               proof safe
                 fix a' a1 a2 x1 x2 i1 i2
                 let ?i1 = "to_complex i1" and ?i2 = "to_complex i2"
                 let ?a1 = "of_complex (?i1 / 2)" and ?a2 = "of_complex (?i2 / 2)"
                 let ?la = "poincare_line ?a1 ?a2" and ?lx = "poincare_line x1 x2" and ?li = "poincare_line i1 i2"
                 assume "a' \<in> unit_disc" "x1 \<in> unit_disc" "x2 \<in> unit_disc" "x1 \<noteq> x2"
                 assume "\<not> poincare_collinear {0\<^sub>h, x1, x2}" "ideal_points ?lx = {i1, i2}"
                 assume "poincare_on_ray a' 0\<^sub>h ?a" "a' \<noteq> 0\<^sub>h"
                 assume "poincare_between ?a1 ?a ?a2"  "?a \<noteq> ?a1" "?a \<noteq> ?a2"
                 assume "i1 \<noteq> i2" "?a1 \<noteq> ?a2" "poincare_collinear {0\<^sub>h, ?a1, i1}"  "poincare_collinear {0\<^sub>h, ?a2, i2}"
                 assume "?a1 \<in> unit_disc"  "?a2 \<in> unit_disc"
                 assume "i1 \<in> unit_circle_set" "i2 \<in> unit_circle_set"
                 show "poincare_ray_meets_line 0\<^sub>h a' x1 x2"
                 proof-   
                   have "?lx = ?li"
                     using \<open>ideal_points ?lx = {i1, i2}\<close> \<open>x1 \<noteq> x2\<close> ideal_points_line_unique
                     by auto
 
                   have lx: "is_poincare_line ?lx"
                     using is_poincare_line_poincare_line[OF \<open>x1 \<noteq> x2\<close>]
                     by simp
 
                   have "x1 \<in> circline_set ?lx" "x2 \<in> circline_set ?lx"
                     using lx \<open>x1 \<noteq> x2\<close>
                     by auto
 
                   have "?lx \<noteq> x_axis"
                     using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close> \<open>x1 \<in> circline_set ?lx\<close> \<open>x2 \<in> circline_set ?lx\<close> lx
                     unfolding poincare_collinear_def 
                     by auto
 
                   have "0\<^sub>h \<notin> circline_set ?lx"
                     using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close> lx \<open>x1 \<in> circline_set ?lx\<close> \<open>x2 \<in> circline_set ?lx\<close>
                     unfolding poincare_collinear_def
                     by auto
 
                   have "xa \<noteq> 0" "?a \<noteq> 0\<^sub>h" 
                     using xa
                     by auto
                   hence "0\<^sub>h \<noteq> ?a"
                     by metis
 
                   have "?a \<in> positive_x_axis"
                     using xa
                     unfolding positive_x_axis_def 
                     by simp
 
                   have "?a \<in> unit_disc"
                     using xa
                     by (auto simp add: cmod_eq_Re)
 
                   have "?a \<in> circline_set ?la"
                     using \<open>poincare_between ?a1 ?a ?a2\<close>
                     using \<open>?a1 \<noteq> ?a2\<close> \<open>?a \<in> unit_disc\<close> \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> poincare_between_poincare_line_uzv 
                     by blast
                                                 
                   have "?a1 \<in> circline_set ?la" "?a2 \<in> circline_set ?la"
                     by (auto simp add: \<open>?a1 \<noteq> ?a2\<close>)
 
                   have la: "is_poincare_line ?la"
                     using is_poincare_line_poincare_line[OF \<open>?a1 \<noteq> ?a2\<close>]
                     by  simp
 
                   have inv: "inversion i1 = i1" "inversion i2 = i2"
                     using \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close>
                     by (auto simp add: circline_set_def unit_circle_set_def)
 
                   have  "i1 \<noteq> \<infinity>\<^sub>h" "i2 \<noteq> \<infinity>\<^sub>h"
                     using inv
                     by auto
 
                   have "?a1 \<notin> circline_set x_axis \<and> ?a2 \<notin> circline_set x_axis"
                   proof (rule ccontr)
                     assume "\<not> ?thesis"
                     hence "?a1 \<in> circline_set x_axis \<or> ?a2 \<in> circline_set x_axis"
                       by auto
                     hence "?la = x_axis"
                     proof
                       assume "?a1 \<in> circline_set x_axis"
                       hence "{?a, ?a1} \<subseteq> circline_set ?la \<inter> circline_set x_axis"
                         using \<open>?a \<in> circline_set ?la\<close> \<open>?a1 \<in> circline_set ?la\<close>\<open>?a \<in> positive_x_axis\<close>
                         using circline_set_x_axis_I xa(1) 
                         by blast
                       thus "?la = x_axis"
                         using unique_is_poincare_line[of ?a ?a1 ?la x_axis]
                         using \<open>?a1 \<in> unit_disc\<close> \<open>?a \<in> unit_disc\<close> la \<open>?a \<noteq> ?a1\<close>
                         by auto
                     next
                       assume "?a2 \<in> circline_set x_axis"
                       hence "{?a, ?a2} \<subseteq> circline_set ?la \<inter> circline_set x_axis"
                         using \<open>?a \<in> circline_set ?la\<close> \<open>?a2 \<in> circline_set ?la\<close> \<open>?a \<in> positive_x_axis\<close>
                         using circline_set_x_axis_I xa(1) 
                         by blast
                       thus "?la = x_axis"
                         using unique_is_poincare_line[of ?a ?a2 ?la x_axis]
                         using \<open>?a2 \<in> unit_disc\<close> \<open>?a \<in> unit_disc\<close> la \<open>?a \<noteq> ?a2\<close>
                         by auto
                     qed
 
                     hence "i1 \<in> circline_set x_axis \<and> i2 \<in> circline_set x_axis"
                       using \<open>?a1 \<in> circline_set ?la\<close> \<open>?a2 \<in> circline_set ?la\<close>
                       by (metis \<open>i1 \<noteq> \<infinity>\<^sub>h\<close> \<open>i2 \<noteq> \<infinity>\<^sub>h\<close> \<open>of_complex (to_complex i1 / 2) \<in> unit_disc\<close> \<open>of_complex (to_complex i2 / 2) \<in> unit_disc\<close> \<open>poincare_collinear {0\<^sub>h, of_complex (to_complex i1 / 2), i1}\<close> \<open>poincare_collinear {0\<^sub>h, of_complex (to_complex i2 / 2), i2}\<close> divide_eq_0_iff inf_not_of_complex inv(1) inv(2) inversion_noteq_unit_disc of_complex_to_complex of_complex_zero_iff poincare_collinear3_poincare_lines_equal_general poincare_line_0_real_is_x_axis poincare_line_circline_set(2) zero_in_unit_disc zero_neq_numeral)
 
                     thus False
                       using \<open>?lx \<noteq> x_axis\<close> unique_is_poincare_line_general[of i1 i2 ?li x_axis] \<open>i1 \<noteq> i2\<close> inv \<open>?lx = ?li\<close>
                       by auto
                   qed
 
                   hence "?la \<noteq> x_axis"
                     using \<open>?a1 \<noteq> ?a2\<close> poincare_line_circline_set(1)      
                     by fastforce
 
                   have "intersects_x_axis_positive ?la"
                     using intersects_x_axis_positive_iff[of ?la] \<open>?la \<noteq> x_axis\<close> \<open>?a \<in> circline_set ?la\<close> la
                     using \<open>?a \<in> unit_disc\<close> \<open>?a \<in> positive_x_axis\<close>
                     by auto
 
                   have "intersects_x_axis ?lx"
                   proof-
                     have "arg (to_complex ?a1) * arg (to_complex ?a2) < 0"
                       using \<open>poincare_between ?a1 ?a ?a2\<close> \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close>
                       using poincare_between_x_axis_intersection[of ?a1 ?a2 "of_complex xa"]
                       using \<open>?a1 \<noteq> ?a2\<close> \<open>?a \<in> unit_disc\<close> \<open>?a1 \<notin> circline_set x_axis \<and> ?a2 \<notin> circline_set x_axis\<close> \<open>?a \<in> positive_x_axis\<close>
                       using \<open>?a \<in> circline_set ?la\<close>                                                                                         
                       unfolding positive_x_axis_def
                       by simp
 
                     moreover
 
                     have "\<And> x y x' y' :: real. \<lbrakk>sgn x' = sgn x; sgn y' = sgn y\<rbrakk> \<Longrightarrow> x*y < 0 \<longleftrightarrow> x'*y' < 0"
                       by (metis sgn_less sgn_mult)
 
                     ultimately
 
                     have "Im (to_complex ?a1) * Im (to_complex ?a2) < 0"
                       using arg_Im_sgn[of "to_complex ?a1"] arg_Im_sgn[of "to_complex ?a2"]
                       using \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> \<open>?a1 \<notin> circline_set x_axis \<and> ?a2 \<notin> circline_set x_axis\<close> 
                       using inf_or_of_complex[of ?a1] inf_or_of_complex[of ?a2] circline_set_x_axis
                       by (metis circline_set_x_axis_I to_complex_of_complex)
 
                     thus ?thesis
                       using ideal_points_intersects_x_axis[of ?lx i1 i2]
                       using \<open>ideal_points ?lx = {i1, i2}\<close> lx \<open>?lx \<noteq> x_axis\<close>
                       by simp
                   qed
 
                   have "intersects_x_axis_positive ?lx"
                   proof-
                     have "cmod ?i1 = 1" "cmod ?i2 = 1"                
                       using \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close> 
                       unfolding unit_circle_set_def 
                       by auto
 
                     let ?a1' = "?i1 / 2" and ?a2' = "?i2 / 2"
                     let ?Aa1 = "\<i> * (?a1' * cnj ?a2' - ?a2' * cnj ?a1')" and 
                         ?Ba1 = "\<i> * (?a2' * cor ((cmod ?a1')\<^sup>2 + 1) - ?a1' * cor ((cmod ?a2')\<^sup>2 + 1))"
 
                     have "?Aa1 \<noteq> 0 \<or> ?Ba1 \<noteq> 0"
                       using \<open>cmod (to_complex i1) = 1\<close>  \<open>cmod (to_complex i2) = 1\<close> \<open>?a1 \<noteq> ?a2\<close>              
                       by (auto simp add: power_divide complex_mult_cnj_cmod)
 
                     have "is_real ?Aa1"
                       by simp
 
                     have "?a1 \<noteq> inversion ?a2"
                       using \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> inversion_noteq_unit_disc by fastforce
 
                     hence "Re ?Ba1 / Re ?Aa1 < -1"
                       using \<open>intersects_x_axis_positive ?la\<close> \<open>?a1 \<noteq> ?a2\<close>
                       using intersects_x_axis_positive_mk_circline[of ?Aa1 ?Ba1] \<open>?Aa1 \<noteq> 0 \<or> ?Ba1 \<noteq> 0\<close> \<open>is_real ?Aa1\<close>
                       using poincare_line_non_homogenous[of ?a1 ?a2]
                       by (simp add: Let_def)
 
                     moreover
 
                     let ?i1' = "to_complex i1" and ?i2' = "to_complex i2"
                     let ?Ai1 = "\<i> * (?i1' * cnj ?i2' - ?i2' * cnj ?i1')" and 
                         ?Bi1 = "\<i> * (?i2' * cor ((cmod ?i1')\<^sup>2 + 1) - ?i1' * cor ((cmod ?i2')\<^sup>2 + 1))"
 
                     have "?Ai1 \<noteq> 0 \<or> ?Bi1 \<noteq> 0"
                       using \<open>cmod (to_complex i1) = 1\<close>  \<open>cmod (to_complex i2) = 1\<close> \<open>?a1 \<noteq> ?a2\<close>              
                       by (auto simp add: power_divide complex_mult_cnj_cmod)
 
                     have "is_real ?Ai1"
                       by simp
 
                     have "sgn (Re ?Bi1 / Re ?Ai1) = sgn (Re ?Ba1 / Re ?Aa1)"  
                     proof-
                       have "Re ?Bi1 / Re ?Ai1 = (Im ?i1 * 2 - Im ?i2 * 2) /
                                                 (Im ?i2 * (Re ?i1 * 2) - Im ?i1 * (Re ?i2 * 2))"
                         using \<open>cmod ?i1 = 1\<close>  \<open>cmod ?i2 = 1\<close>
                         by (auto simp add: complex_mult_cnj_cmod field_simps)
                       also have "... =  (Im ?i1 - Im ?i2) /
                                         (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2))" (is "... = ?expr")
                         apply (subst left_diff_distrib[symmetric])
                         apply (subst semiring_normalization_rules(18))+
                         apply (subst left_diff_distrib[symmetric])
                         by (metis mult.commute mult_divide_mult_cancel_left_if zero_neq_numeral)
                       finally have 1: "Re ?Bi1 / Re ?Ai1 = (Im ?i1 - Im ?i2) / (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2))"
                         .
 
                 
                       have "Re ?Ba1 / Re ?Aa1 = (Im ?i1 * 20 - Im ?i2 * 20) /
                                                 (Im ?i2 * (Re ?i1 * 16) - Im ?i1 * (Re ?i2 * 16))"
                         using \<open>cmod (to_complex i1) = 1\<close>  \<open>cmod (to_complex i2) = 1\<close>
                         by (auto simp add: complex_mult_cnj_cmod field_simps)
                       also have "... = (20 / 16) * ((Im ?i1 - Im ?i2) /
                                        (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2)))"
                         apply (subst left_diff_distrib[symmetric])+
                         apply (subst semiring_normalization_rules(18))+
                         apply (subst left_diff_distrib[symmetric])+
                         by (metis (no_types, hide_lams)  field_class.field_divide_inverse mult.commute times_divide_times_eq)
                       finally have 2: "Re ?Ba1 / Re ?Aa1 = (5 / 4) * ((Im ?i1 - Im ?i2) / (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2)))"
                         by simp
 
                       have "?expr \<noteq> 0"
                         using \<open>Re ?Ba1 / Re ?Aa1 < -1\<close>
                         apply  (subst (asm) 2)
                         by linarith
                       thus ?thesis
                         apply (subst 1, subst 2)
                         apply (simp only: sgn_mult)
                         by simp
                     qed
                       
 
                     moreover
 
                     have "i1 \<noteq> inversion i2"
                       by (simp add: \<open>i1 \<noteq> i2\<close> inv(2))
 
                     have "(Re ?Bi1 / Re ?Ai1)\<^sup>2 > 1"
                     proof-
                       have "?Ai1 = 0 \<or> (Re ?Bi1)\<^sup>2 > (Re ?Ai1)\<^sup>2"
                         using \<open>intersects_x_axis ?lx\<close>
                         using \<open>i1 \<noteq> i2\<close> \<open>i1 \<noteq> \<infinity>\<^sub>h\<close> \<open>i2 \<noteq> \<infinity>\<^sub>h\<close> \<open>i1 \<noteq> inversion i2\<close>
                         using intersects_x_axis_mk_circline[of ?Ai1 ?Bi1] \<open>?Ai1 \<noteq> 0 \<or> ?Bi1 \<noteq> 0\<close> \<open>is_real ?Ai1\<close>
                         using poincare_line_non_homogenous[of i1 i2] \<open>?lx = ?li\<close>
                         by metis
                                                   
                       moreover
                       have "?Ai1 \<noteq> 0"
                       proof (rule ccontr)
                         assume "\<not> ?thesis"
                         hence "0\<^sub>h \<in> circline_set ?li"
                           unfolding circline_set_def
                           apply simp
                           apply (transfer, transfer, case_tac i1, case_tac i2)
                           by (auto simp add: vec_cnj_def field_simps)
                         thus False
                           using \<open>0\<^sub>h \<notin> circline_set ?lx\<close> \<open>?lx = ?li\<close>
                           by simp
                       qed
 
                       ultimately
 
                       have "(Re ?Bi1)\<^sup>2 > (Re ?Ai1)\<^sup>2"    
                         by auto
 
                       moreover
 
                       have "Re ?Ai1 \<noteq> 0"
                         using \<open>is_real ?Ai1\<close> \<open>?Ai1 \<noteq> 0\<close>
                         by (simp add: complex_eq_iff)
 
                       ultimately
 
                       show ?thesis
                         by (simp add: power_divide)
                     qed
 
                     moreover
 
                     {
                       fix x1 x2 :: real
                       assume "sgn x1 = sgn x2" "x1 < -1" "x2\<^sup>2 > 1"
                       hence "x2 < -1"
                         by (smt one_power2 real_sqrt_abs real_sqrt_less_iff sgn_neg sgn_pos)
                     }
 
                     ultimately
 
                     have "Re ?Bi1 / Re ?Ai1 < -1"
                       by metis
 
                     thus ?thesis
                       using \<open>i1 \<noteq> i2\<close> \<open>i1 \<noteq> \<infinity>\<^sub>h\<close> \<open>i2 \<noteq> \<infinity>\<^sub>h\<close> \<open>i1 \<noteq> inversion i2\<close>
                       using intersects_x_axis_positive_mk_circline[of ?Ai1 ?Bi1] \<open>?Ai1 \<noteq> 0 \<or> ?Bi1 \<noteq> 0\<close> \<open>is_real ?Ai1\<close>
                       using poincare_line_non_homogenous[of i1 i2] \<open>?lx = ?li\<close>
                       by (simp add: Let_def)
                   qed
 
                   then obtain x where x: "x \<in> unit_disc" "x \<in> circline_set ?lx \<inter> positive_x_axis"
                     using intersects_x_axis_positive_iff[OF lx \<open>?lx \<noteq> x_axis\<close>]
                     by auto
 
                   have "poincare_on_ray x 0\<^sub>h a' \<and> poincare_collinear {x1, x2, x}"
                   proof
                     show "poincare_collinear {x1, x2, x}"
                       using x lx \<open>x1 \<in> circline_set ?lx\<close> \<open>x2 \<in> circline_set ?lx\<close>
                       unfolding poincare_collinear_def
                       by auto
                   next
                     show "poincare_on_ray x 0\<^sub>h a'"
                       unfolding poincare_on_ray_def
                     proof-
                       have  "a' \<in> circline_set x_axis"
                         using \<open>poincare_on_ray a' 0\<^sub>h ?a\<close> xa \<open>0\<^sub>h \<noteq> ?a\<close> \<open>xa \<noteq> 0\<close> \<open>a' \<in> unit_disc\<close>
                         unfolding poincare_on_ray_def 
                         using poincare_line_0_real_is_x_axis[of "of_complex xa"]
                         using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex xa" a']
                         using poincare_between_poincare_line_uzv[of "0\<^sub>h" "of_complex xa" a']
                         by (auto simp  add: cmod_eq_Re)
 
                       then obtain xa' where xa': "a' = of_complex xa'" "is_real xa'"
                         using \<open>a' \<in> unit_disc\<close>
                         using circline_set_def on_circline_x_axis 
                         by auto
 
                       hence "-1 < Re xa'" "Re xa' < 1" "xa' \<noteq> 0"
                         using \<open>a' \<in> unit_disc\<close> \<open>a' \<noteq> 0\<^sub>h\<close>
                         by (auto simp add: cmod_eq_Re)
 
                       hence "Re xa' > 0" "Re xa' < 1" "is_real xa'"
                         using \<open>poincare_on_ray a' 0\<^sub>h (of_complex xa)\<close>
                         using poincare_between_x_axis_0uv[of "Re xa'" "Re xa"]
                         using poincare_between_x_axis_0uv[of "Re xa" "Re xa'"]
                         using circline_set_positive_x_axis_I[of "Re xa'"]
                         using xa xa' complex_of_real_Re
                         unfolding poincare_on_ray_def
                         by (smt of_real_0, linarith, blast)
 
                       moreover
 
                       obtain xx where "is_real xx" "Re xx > 0" "Re xx < 1" "x = of_complex xx"
                         using x
                         unfolding positive_x_axis_def
                         using circline_set_def cmod_eq_Re on_circline_x_axis
                         by auto
 
                       ultimately
 
                       show "poincare_between 0\<^sub>h x a' \<or> poincare_between 0\<^sub>h a' x"
                         using \<open>a' = of_complex xa'\<close>
                         by (smt \<open>a' \<in> unit_disc\<close> arg_0_iff poincare_between_0uv poincare_between_def to_complex_of_complex x(1))
                     qed
 
                   qed
 
                   thus ?thesis               
                     using \<open>x \<in> unit_disc\<close>
                     unfolding poincare_ray_meets_line_def poincare_on_line_def
                     by (metis insert_commute)
                 qed
               qed
             next
               show "a \<noteq> 0\<^sub>h"
               proof (rule ccontr)
                 assume "\<not> ?thesis"
                 then obtain k where "k<0" "to_complex ?a1 = cor k * to_complex ?a2"
                   using poincare_between_u0v[OF \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> \<open>?a1 \<noteq> 0\<^sub>h\<close> \<open>?a2 \<noteq> 0\<^sub>h\<close>]
                   using \<open>poincare_between ?a1 a ?a2\<close>
                   by auto
                 hence "to_complex i1 = cor k * to_complex i2" "k < 0"
                   by auto
                 hence "0\<^sub>h \<in> circline_set (poincare_line x1 x2)"
                   using ideal_points_proportional[of "poincare_line x1 x2" i1 i2 k] \<open>ideal_points (poincare_line x1 x2) = {i1, i2}\<close>
                   using is_poincare_line_poincare_line[OF \<open>x1 \<noteq> x2\<close>]
                   by simp
                 thus False
                   using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close>
                   using is_poincare_line_poincare_line[OF \<open>x1 \<noteq> x2\<close>]
                   unfolding poincare_collinear_def
                   by (meson \<open>x1 \<noteq> x2\<close> empty_subsetI insert_subset poincare_line_circline_set(1) poincare_line_circline_set(2))
               qed
             next
               fix \<phi> u
               let ?R' = "\<lambda> a zero. \<forall> a' a1 a2 x1 x2 i1 i2. ?R zero a' a1 a2 x1 x2 i1 i2 a"
               let ?M = "moebius_pt (moebius_rotation \<phi>)"
               assume *: "u \<in> unit_disc" "u \<noteq> 0\<^sub>h" and **: "?R' (?M u) 0\<^sub>h"
               have uf: "unit_disc_fix (moebius_rotation \<phi>)"
                 by simp
               have "?M 0\<^sub>h = 0\<^sub>h"
                 by auto
               hence **: "?R' (?M u) (?M 0\<^sub>h)"
                 using **
                 by simp
               show "?R' u 0\<^sub>h"
               proof (rule allI)+
                 fix a' a1 a2 x1 x2 i1 i2
                 have i1: "i1 \<in> unit_circle_set \<longrightarrow> moebius_pt (moebius_rotation \<phi>) (of_complex (to_complex i1 / 2)) = of_complex (to_complex (moebius_pt (moebius_rotation \<phi>) i1) / 2)"
                   using unit_circle_set_def by force
                 
                 have i2: "i2 \<in> unit_circle_set \<longrightarrow> moebius_pt (moebius_rotation \<phi>) (of_complex (to_complex i2 / 2)) = of_complex (to_complex (moebius_pt (moebius_rotation \<phi>) i2) / 2)"
                   using unit_circle_set_def by force
                 
                 show "?R 0\<^sub>h a' a1 a2 x1 x2 i1 i2 u"
                   using **[rule_format, of "?M a'" "?M x1" "?M x2" "?M i1" "?M i2" "?M a1" "?M a2"] uf * 
                   apply (auto simp del:  moebius_pt_moebius_rotation_zero moebius_pt_moebius_rotation)
                   using i1 i2
                   by simp
               qed
             qed
             thus ?thesis                                                                  
               using \<open>a' \<in> unit_disc\<close> \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>x1 \<noteq> x2\<close> 
               using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close> \<open>ideal_points ?lx = {i1, i2}\<close> \<open>i1 \<noteq> i2\<close>
               using \<open>?a1 \<noteq> ?a2\<close> \<open>poincare_collinear {0\<^sub>h, ?a1, i1}\<close> \<open>poincare_collinear {0\<^sub>h, ?a2, i2}\<close>
               using \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close> \<open>i1 \<in> unit_circle_set\<close> \<open>i2 \<in> unit_circle_set\<close>
               using \<open>poincare_on_ray a' 0\<^sub>h a\<close> \<open>a' \<noteq> 0\<^sub>h\<close> \<open>poincare_between ?a1 a ?a2\<close> \<open>a \<noteq> ?a1\<close> \<open>a \<noteq> ?a2\<close>
               by blast
           qed
         qed
 
         moreover
 
         have "\<not> poincare_on_line 0\<^sub>h ?a1 ?a2"
         proof
           assume *: "poincare_on_line 0\<^sub>h ?a1 ?a2"
           hence "poincare_collinear {0\<^sub>h, ?a1, ?a2}"
             unfolding poincare_on_line_def
             by simp
           hence "poincare_line 0\<^sub>h ?a1 = poincare_line 0\<^sub>h ?a2"
             using poincare_collinear3_poincare_lines_equal_general[of "0\<^sub>h" ?a1 ?a2]
             using \<open>?a1 \<in> unit_disc\<close> \<open>?a1 \<noteq> 0\<^sub>h\<close> \<open>?a2 \<in> unit_disc\<close> \<open>?a2 \<noteq> 0\<^sub>h\<close> 
             by (metis inversion_noteq_unit_disc zero_in_unit_disc)
 
           have "i1 \<in> circline_set (poincare_line 0\<^sub>h ?a1)"
             using \<open>poincare_collinear {0\<^sub>h, ?a1, i1}\<close>
             using poincare_collinear3_poincare_line_general[of i1 "0\<^sub>h" ?a1]
             using \<open>?a1 \<in> unit_disc\<close> \<open>?a1 \<noteq> 0\<^sub>h\<close>
             by (metis insert_commute inversion_noteq_unit_disc zero_in_unit_disc)
           moreover
           have "i2 \<in> circline_set (poincare_line 0\<^sub>h ?a1)"
             using \<open>poincare_collinear {0\<^sub>h, ?a2, i2}\<close>
             using poincare_collinear3_poincare_line_general[of i2 "0\<^sub>h" ?a2]
             using \<open>?a2 \<in> unit_disc\<close> \<open>?a2 \<noteq> 0\<^sub>h\<close> \<open>poincare_line 0\<^sub>h ?a1 = poincare_line 0\<^sub>h ?a2\<close>
             by (metis insert_commute inversion_noteq_unit_disc zero_in_unit_disc)
 
           ultimately
 
           have "poincare_collinear {0\<^sub>h, i1, i2}"
             using \<open>?a1 \<in> unit_disc\<close> \<open>?a1 \<noteq> 0\<^sub>h\<close> \<open>poincare_collinear {0\<^sub>h, ?a1, i1}\<close>
             by (smt insert_subset poincare_collinear_def unique_poincare_line zero_in_unit_disc)
           hence "0\<^sub>h \<in> circline_set (poincare_line i1 i2)"
             using poincare_collinear3_poincare_line_general[of "0\<^sub>h" i1 i2]
             using \<open>i1 \<noteq> i2\<close> \<open>i2 \<in> unit_circle_set\<close> unit_circle_set_def
             by force
 
           moreover
 
           have "?lx = ?li"
             using \<open>ideal_points ?lx = {i1, i2}\<close> \<open>x1 \<noteq> x2\<close> ideal_points_line_unique
             by auto
 
           ultimately
 
           show False
             using \<open>\<not> poincare_collinear {0\<^sub>h, x1, x2}\<close>
             using \<open>x1 \<noteq> x2\<close> poincare_line_poincare_collinear3_general
             by auto
         qed          
 
         ultimately
 
         show ?thesis
           using \<open>?a1 \<in> unit_disc\<close> \<open>?a2 \<in> unit_disc\<close>
           by blast
       qed
     qed
   qed
   thus ?thesis
     using \<open>x1 \<in> unit_disc\<close> \<open>x2 \<in> unit_disc\<close> \<open>\<not> poincare_collinear {a, x1, x2}\<close>
     by blast
 qed                                                                        
 
 subsection\<open>Interpretation of locales\<close>
 
 global_interpretation PoincareTarskiAbsolute: TarskiAbsolute where cong  = p_congruent and betw = p_between
   defines p_on_line = PoincareTarskiAbsolute.on_line and
           p_on_ray = PoincareTarskiAbsolute.on_ray and
           p_in_angle = PoincareTarskiAbsolute.in_angle and
           p_ray_meets_line = PoincareTarskiAbsolute.ray_meets_line
 proof-
   show "TarskiAbsolute p_congruent p_between"
   proof
     text\<open> 1. Reflexivity of congruence \<close>
     fix x y
     show "p_congruent x y y x"
       unfolding p_congruent_def
       by transfer (simp add: poincare_distance_sym)
   next
     text\<open> 2. Transitivity of congruence \<close>
     fix x y z u v w
     show "p_congruent x y z u \<and> p_congruent x y v w \<longrightarrow> p_congruent z u v w"
       by (transfer, simp)
   next
     text\<open> 3. Identity of congruence \<close>
     fix x y z
     show "p_congruent x y z z \<longrightarrow> x = y"
       unfolding p_congruent_def
       by transfer (simp add: poincare_distance_eq_0_iff)
   next
     text\<open> 4. Segment construction \<close>
     fix x y a b
     show "\<exists> z. p_between x y z \<and> p_congruent y z a b"
       using segment_construction
       unfolding p_congruent_def
       by transfer (simp, blast)
   next
     text\<open> 5. Five segment \<close>
     fix x y z x' y' z' u u'
     show "x \<noteq> y \<and> p_between x y z \<and> p_between x' y' z' \<and>
       p_congruent x y x' y' \<and> p_congruent y z y' z' \<and>
       p_congruent x u x' u' \<and> p_congruent y u y' u' \<longrightarrow>
       p_congruent z u z' u'"
       unfolding p_congruent_def
       apply transfer
       using five_segment_axiom                                             
       by meson
   next
     text\<open> 6. Identity of betweeness \<close>
     fix x y
     show "p_between x y x \<longrightarrow> x = y"
       by transfer (simp add: poincare_between_sum_distances poincare_distance_eq_0_iff poincare_distance_sym)
   next
     text\<open> 7. Pasch \<close>
     fix x y z u v
     show "p_between x u z \<and> p_between y v z \<longrightarrow> (\<exists> a. p_between u a y \<and> p_between x a v)"
       apply transfer
       using Pasch
       by blast
   next
     text\<open> 8. Lower dimension \<close>
     show "\<exists> a. \<exists> b. \<exists> c. \<not> p_between a b c \<and> \<not> p_between b c a \<and> \<not> p_between c a b"
       apply (transfer)
       using lower_dimension_axiom
       by simp
   next
     text\<open> 9. Upper dimension \<close>
     fix x y z u v
     show "p_congruent x u x v \<and> p_congruent y u y v \<and> p_congruent z u z v \<and> u \<noteq> v \<longrightarrow>
           p_between x y z \<or> p_between y z x \<or> p_between z x y"
       unfolding p_congruent_def
       by (transfer, simp add: upper_dimension_axiom)
   qed
 qed 
 
 
 interpretation PoincareTarskiHyperbolic: TarskiHyperbolic
   where cong = p_congruent and betw = p_between
 proof
   text\<open> 10. Euclid negation \<close>
   show "\<exists> a b c d t. p_between a d t \<and> p_between b d c \<and> a \<noteq> d \<and>
                    (\<forall> x y. p_between a b x \<and> p_between a c y \<longrightarrow> \<not> p_between x t y)"
     using negated_euclidean_axiom
     by transfer (auto, blast)
 next
   fix a x1  x2
   assume "\<not> TarskiAbsolute.on_line p_between a x1 x2"
   hence "\<not> p_on_line a x1 x2"
     using TarskiAbsolute.on_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     using PoincareTarskiAbsolute.on_line_def
     by simp
   text\<open> 11. Limiting parallels  \<close>
   thus "\<exists>a1 a2.
           \<not> TarskiAbsolute.on_line p_between a a1 a2 \<and>
           \<not> TarskiAbsolute.ray_meets_line p_between a a1 x1 x2 \<and>
           \<not> TarskiAbsolute.ray_meets_line p_between a a2 x1 x2 \<and>
           (\<forall>a'. TarskiAbsolute.in_angle p_between a' a1 a a2 \<longrightarrow> TarskiAbsolute.ray_meets_line p_between a a' x1 x2)"
     unfolding TarskiAbsolute.in_angle_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     unfolding TarskiAbsolute.on_ray_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     unfolding TarskiAbsolute.ray_meets_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     unfolding TarskiAbsolute.on_ray_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     unfolding TarskiAbsolute.on_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms]
     unfolding PoincareTarskiAbsolute.on_line_def
     apply transfer
   proof- 
     fix a x1 x2
     assume *: "a \<in> unit_disc" "x1 \<in> unit_disc" "x2 \<in> unit_disc"
               "\<not> (poincare_between a x1 x2 \<or> poincare_between x1 a x2 \<or> poincare_between x1 x2 a)"
     hence "\<not> poincare_on_line a x1 x2"
       using poincare_collinear3_iff[of a x1 x2]
       using poincare_between_rev poincare_on_line_def by blast
     hence "\<exists>a1\<in>unit_disc.
             \<exists>a2\<in>unit_disc.
             \<not> poincare_on_line a a1 a2 \<and>
             \<not> poincare_ray_meets_line a a1 x1 x2 \<and>
             \<not> poincare_ray_meets_line a a2 x1 x2 \<and>
             (\<forall>a'\<in>unit_disc.
                 poincare_in_angle a' a1 a a2 \<longrightarrow>
                 poincare_ray_meets_line a a' x1 x2)"
       using limiting_parallels[of a x1 x2] *
       by blast
     then obtain a1 a2 where **: "a1\<in>unit_disc" "a2\<in>unit_disc" "\<not> poincare_on_line a a1 a2"
                             "\<not> poincare_ray_meets_line a a2 x1 x2"
                             "\<not> poincare_ray_meets_line a a1 x1 x2"
                             "\<forall>a'\<in>unit_disc.
                                   poincare_in_angle a' a1 a a2 \<longrightarrow>
                                   poincare_ray_meets_line a a' x1 x2"
       by blast
     have "\<not> (\<exists>x\<in>{z. z \<in> unit_disc}.
                     (poincare_between a x a1 \<or>
                      poincare_between a a1 x) \<and>
                     (poincare_between x x1 x2 \<or>
                      poincare_between x1 x x2 \<or>
                      poincare_between x1 x2 x))"
       using \<open>\<not> poincare_ray_meets_line a a1 x1 x2\<close>
       unfolding poincare_on_line_def poincare_ray_meets_line_def poincare_on_ray_def
       using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3)
       by auto
     moreover
     have "\<not> (\<exists>x\<in>{z. z \<in> unit_disc}.
                     (poincare_between a x a2 \<or>
                      poincare_between a a2 x) \<and>
                     (poincare_between x x1 x2 \<or>
                      poincare_between x1 x x2 \<or>
                      poincare_between x1 x2 x))"
       using \<open>\<not> poincare_ray_meets_line a a2 x1 x2\<close>
       unfolding poincare_on_line_def poincare_ray_meets_line_def poincare_on_ray_def
       using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3)
       by auto
     moreover
     have "\<not> (poincare_between a a1 a2 \<or> poincare_between a1 a a2 \<or> poincare_between a1 a2 a)"
       using \<open>\<not> poincare_on_line a a1 a2\<close> poincare_collinear3_iff[of a a1 a2]
       using *(1) **(1-2)
       unfolding poincare_on_line_def
       by simp
     moreover 
     have "(\<forall>a'\<in>{z. z \<in> unit_disc}.
                  a \<noteq> a1 \<and>
                  a \<noteq> a2 \<and>
                  a' \<noteq> a \<and>
                  (\<exists>x\<in>{z. z \<in> unit_disc}.
                      poincare_between a1 x a2 \<and>
                      x \<noteq> a1 \<and>
                      x \<noteq> a2 \<and>
                      (poincare_between a a' x \<or>
                       poincare_between a x a')) \<longrightarrow>
                  (\<exists>x\<in>{z. z \<in> unit_disc}.
                      (poincare_between a x a' \<or>
                       poincare_between a a' x) \<and>
                      (poincare_between x x1 x2 \<or>
                       poincare_between x1 x x2 \<or>
                       poincare_between x1 x2 x)))"
       using **(6)
       unfolding poincare_on_line_def poincare_in_angle_def poincare_ray_meets_line_def poincare_on_ray_def
       using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3)
       by auto
     ultimately
     show "\<exists>a1\<in>{z. z \<in> unit_disc}.
            \<exists>a2\<in>{z. z \<in> unit_disc}.
              \<not> (poincare_between a a1 a2 \<or> poincare_between a1 a a2 \<or> poincare_between a1 a2 a) \<and>
              \<not> (\<exists>x\<in>{z. z \<in> unit_disc}.
                     (poincare_between a x a1 \<or>
                      poincare_between a a1 x) \<and>
                     (poincare_between x x1 x2 \<or>
                      poincare_between x1 x x2 \<or>
                      poincare_between x1 x2 x)) \<and>
              \<not> (\<exists>x\<in>{z. z \<in> unit_disc}.
                     (poincare_between a x a2 \<or>
                      poincare_between a a2 x) \<and>
                     (poincare_between x x1 x2 \<or>
                      poincare_between x1 x x2 \<or>
                      poincare_between x1 x2 x)) \<and>
              (\<forall>a'\<in>{z. z \<in> unit_disc}.
                  a \<noteq> a1 \<and>
                  a \<noteq> a2 \<and>
                  a' \<noteq> a \<and>
                  (\<exists>x\<in>{z. z \<in> unit_disc}.
                      poincare_between a1 x a2 \<and>
                      x \<noteq> a1 \<and>
                      x \<noteq> a2 \<and>
                      (poincare_between a a' x \<or>
                       poincare_between a x a')) \<longrightarrow>
                  (\<exists>x\<in>{z. z \<in> unit_disc}.
                      (poincare_between a x a' \<or>
                       poincare_between a a' x) \<and>
                      (poincare_between x x1 x2 \<or>
                       poincare_between x1 x x2 \<or>
                       poincare_between x1 x2 x)))" 
       using **(1, 2)
       by auto
    qed
 qed
 
 interpretation PoincareElementaryTarskiHyperbolic: ElementaryTarskiHyperbolic p_congruent p_between
 proof
   text\<open> 12.  Continuity \<close>
   fix \<phi> \<psi>
   assume "\<exists> a. \<forall> x. \<forall> y. \<phi> x \<and> \<psi> y \<longrightarrow> p_between a x y"
   thus "\<exists> b. \<forall> x. \<forall> y. \<phi> x \<and> \<psi> y \<longrightarrow> p_between x b y"
     apply transfer
     using continuity
     by auto
 qed
 
 end
diff --git a/thys/Stirling_Formula/Gamma_Asymptotics.thy b/thys/Stirling_Formula/Gamma_Asymptotics.thy
--- a/thys/Stirling_Formula/Gamma_Asymptotics.thy
+++ b/thys/Stirling_Formula/Gamma_Asymptotics.thy
@@ -1,2105 +1,2105 @@
 (*
   File:    Gamma_Asymptotics.thy
   Author:  Manuel Eberl
 
   The complete asymptotics of the real and complex logarithmic Gamma functions.
   Also of the real Polygamma functions (could be extended to the complex ones fairly easily
   if needed).
 *)
 section \<open>Complete asymptotics of the logarithmic Gamma function\<close>
 theory Gamma_Asymptotics
 imports 
   "HOL-Complex_Analysis.Complex_Analysis"
   "HOL-Real_Asymp.Real_Asymp"
   Bernoulli.Bernoulli_FPS 
   Bernoulli.Periodic_Bernpoly 
   Stirling_Formula
 begin
 
 subsection \<open>Auxiliary Facts\<close>
   
 (* TODO Move *)
 lemma arg_of_real [simp]:
-  "x > 0 \<Longrightarrow> arg (complex_of_real x) = 0"
-  "x < 0 \<Longrightarrow> arg (complex_of_real x) = pi"
-  by (rule arg_unique; simp add: complex_sgn_def scaleR_conv_of_real)+
+  "x > 0 \<Longrightarrow> Arg (complex_of_real x) = 0"
+  "x < 0 \<Longrightarrow> Arg (complex_of_real x) = pi"
+  by (auto simp add: Arg_of_real)
   
 lemma arg_conv_arctan:
   assumes "Re z > 0"
-  shows   "arg z = arctan (Im z / Re z)"
+  shows   "Arg z = arctan (Im z / Re z)"
 proof (rule arg_unique)
   show "sgn z = cis (arctan (Im z / Re z))"
   proof (rule complex_eqI)
     have "Re (cis (arctan (Im z / Re z))) = 1 / sqrt (1 + (Im z)\<^sup>2 / (Re z)\<^sup>2)"
       by (simp add: cos_arctan power_divide)
     also have "1 + Im z ^ 2 / Re z ^ 2 = norm z ^ 2 / Re z ^ 2"
       using assms by (simp add: cmod_def field_simps)
     also have "1 / sqrt \<dots> = Re z / norm z"
       using assms by (simp add: real_sqrt_divide)
     finally show "Re (sgn z) = Re (cis (arctan (Im z / Re z)))"
       by simp
   next
     have "Im (cis (arctan (Im z / Re z))) = Im z / (Re z * sqrt (1 + (Im z)\<^sup>2 / (Re z)\<^sup>2))"
       by (simp add: sin_arctan field_simps)
     also have "1 + Im z ^ 2 / Re z ^ 2 = norm z ^ 2 / Re z ^ 2"
       using assms by (simp add: cmod_def field_simps)
     also have "Im z / (Re z * sqrt \<dots>) = Im z / norm z"
       using assms by (simp add: real_sqrt_divide)
     finally show "Im (sgn z) = Im (cis (arctan (Im z / Re z)))"
       by simp
   qed
 next
   show "arctan (Im z / Re z) > -pi"
     by (rule le_less_trans[OF _ arctan_lbound]) auto
 next
   have "arctan (Im z / Re z) < pi / 2"
     by (rule arctan_ubound)
   also have "\<dots> \<le> pi" by simp
   finally show "arctan (Im z / Re z) \<le> pi"
     by simp
 qed
 
 lemma mult_indicator_cong:
   fixes f g :: "_ \<Rightarrow> 'a :: semiring_1"
   shows "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> indicator A x * f x = indicator A x * g x"
   by (auto simp: indicator_def)
   
 lemma has_absolute_integral_change_of_variables_1':
   fixes f :: "real \<Rightarrow> real" and g :: "real \<Rightarrow> real"
   assumes S: "S \<in> sets lebesgue"
     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)"
     and inj: "inj_on g S"
   shows "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) = b
      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
 proof -
   have "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R vec (f(g x)) :: real ^ 1) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R vec (f(g x))) = (vec b :: real ^ 1)
          \<longleftrightarrow> (\<lambda>x. vec (f x) :: real ^ 1) absolutely_integrable_on (g ` S) \<and>
            integral (g ` S) (\<lambda>x. vec (f x)) = (vec b :: real ^ 1)"
     using assms unfolding has_field_derivative_iff_has_vector_derivative
     by (intro has_absolute_integral_change_of_variables_1 assms) auto
   thus ?thesis
     by (simp add: absolutely_integrable_on_1_iff integral_on_1_eq)
 qed
 
 corollary Ln_times_of_nat:
     "\<lbrakk>r > 0; z \<noteq> 0\<rbrakk> \<Longrightarrow> Ln(of_nat r * z :: complex) = ln (of_nat r) + Ln(z)"
   using Ln_times_of_real[of "of_nat r" z] by simp
 
 lemma tendsto_of_real_0_I: 
   "(f \<longlongrightarrow> 0) G \<Longrightarrow> ((\<lambda>x. (of_real (f x))) \<longlongrightarrow> (0 ::'a::real_normed_div_algebra)) G"
   by (subst (asm) tendsto_of_real_iff [symmetric]) simp  
 
 lemma negligible_atLeastAtMostI: "b \<le> a \<Longrightarrow> negligible {a..(b::real)}"
   by (cases "b < a") auto
     
 lemma vector_derivative_cong_eq:
   assumes "eventually (\<lambda>x. x \<in> A \<longrightarrow> f x = g x) (nhds x)" "x = y" "A = B" "x \<in> A"
   shows   "vector_derivative f (at x within A) = vector_derivative g (at y within B)"
 proof -
   from eventually_nhds_x_imp_x[OF assms(1)] assms(4) have "f x = g x" by blast
   hence "(\<lambda>D. (f has_vector_derivative D) (at x within A)) = 
            (\<lambda>D. (g has_vector_derivative D) (at x within A))" using assms
     by (intro ext has_vector_derivative_cong_ev refl assms) simp_all
   thus ?thesis by (simp add: vector_derivative_def assms)
 qed
 
 lemma differentiable_of_real [simp]: "of_real differentiable at x within A"
 proof -
   have "(of_real has_vector_derivative 1) (at x within A)"
     by (auto intro!: derivative_eq_intros)
   thus ?thesis by (rule differentiableI_vector)
 qed
   
 lemma higher_deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "(deriv ^^ n) f x = (deriv ^^ n) g y"
 proof -
   from assms(1) have "eventually (\<lambda>x. (deriv ^^ n) f x = (deriv ^^ n) g x) (nhds x)"
   proof (induction n arbitrary: f g)
     case (Suc n)
     from Suc.prems have "eventually (\<lambda>y. eventually (\<lambda>z. f z = g z) (nhds y)) (nhds x)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>x. deriv f x = deriv g x) (nhds x)"
       by eventually_elim (rule deriv_cong_ev, simp_all)
     thus ?case by (auto intro!: deriv_cong_ev Suc simp: funpow_Suc_right simp del: funpow.simps)
   qed auto
   from eventually_nhds_x_imp_x[OF this] assms(2) show ?thesis by simp
 qed
 
 lemma deriv_of_real [simp]: 
   "at x within A \<noteq> bot \<Longrightarrow> vector_derivative of_real (at x within A) = 1"
   by (auto intro!: vector_derivative_within derivative_eq_intros)
 
 lemma deriv_Re [simp]: "deriv Re = (\<lambda>_. 1)"
-  by (auto intro!: DERIV_imp_deriv simp: fun_eq_iff)
+  by simp
     
 lemma vector_derivative_of_real_left:
   assumes "f differentiable at x"
   shows   "vector_derivative (\<lambda>x. of_real (f x)) (at x) = of_real (deriv f x)"
 proof -
   have "vector_derivative (of_real \<circ> f) (at x) = (of_real (deriv f x))"
     by (subst vector_derivative_chain_at)
        (simp_all add: scaleR_conv_of_real field_derivative_eq_vector_derivative assms)
   thus ?thesis by (simp add: o_def)
 qed
   
 lemma vector_derivative_of_real_right:
   assumes "f field_differentiable at (of_real x)"
   shows   "vector_derivative (\<lambda>x. f (of_real x)) (at x) = deriv f (of_real x)"
 proof -
   have "vector_derivative (f \<circ> of_real) (at x) = deriv f (of_real x)"
     using assms by (subst vector_derivative_chain_at_general) simp_all
   thus ?thesis by (simp add: o_def)
 qed
   
 lemma Ln_holomorphic [holomorphic_intros]:
   assumes "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {}"
   shows   "Ln holomorphic_on (A :: complex set)"
 proof (intro holomorphic_onI)
   fix z assume "z \<in> A"
   with assms have "(Ln has_field_derivative inverse z) (at z within A)"
     by (auto intro!: derivative_eq_intros)
   thus "Ln field_differentiable at z within A" by (auto simp: field_differentiable_def)
 qed
 
 lemma higher_deriv_Polygamma:
   assumes "z \<notin> \<int>\<^sub>\<le>\<^sub>0"
   shows   "(deriv ^^ n) (Polygamma m) z = 
              Polygamma (m + n) (z :: 'a :: {real_normed_field,euclidean_space})"
 proof -
   have "eventually (\<lambda>u. (deriv ^^ n) (Polygamma m) u = Polygamma (m + n) u) (nhds z)"
   proof (induction n)
     case (Suc n)
     from Suc.IH have "eventually (\<lambda>z. eventually (\<lambda>u. (deriv ^^ n) (Polygamma m) u = Polygamma (m + n) u) (nhds z)) (nhds z)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>z. deriv ((deriv ^^ n) (Polygamma m)) z = 
              deriv (Polygamma (m + n)) z) (nhds z)"
       by eventually_elim (intro deriv_cong_ev refl)
     moreover have "eventually (\<lambda>z. z \<in> UNIV - \<int>\<^sub>\<le>\<^sub>0) (nhds z)" using assms
       by (intro eventually_nhds_in_open open_Diff open_UNIV) auto
     ultimately show ?case by eventually_elim (simp_all add: deriv_Polygamma)
   qed simp_all
   thus ?thesis by (rule eventually_nhds_x_imp_x)
 qed
   
 lemma higher_deriv_cmult:
   assumes "f holomorphic_on A" "x \<in> A" "open A"
   shows   "(deriv ^^ j) (\<lambda>x. c * f x) x = c * (deriv ^^ j) f x"
   using assms
 proof (induction j arbitrary: f x)
   case (Suc j f x)
   have "deriv ((deriv ^^ j) (\<lambda>x. c * f x)) x = deriv (\<lambda>x. c * (deriv ^^ j) f x) x"
     using eventually_nhds_in_open[of A x] assms(2,3) Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: Suc.IH)
   also have "\<dots> = c * deriv ((deriv ^^ j) f) x" using Suc.prems assms(2,3)
     by (intro deriv_cmult holomorphic_on_imp_differentiable_at holomorphic_higher_deriv) auto
   finally show ?case by simp
 qed simp_all
 
 lemma higher_deriv_ln_Gamma_complex:
   assumes "(x::complex) \<notin> \<real>\<^sub>\<le>\<^sub>0"
   shows   "(deriv ^^ j) ln_Gamma x = (if j = 0 then ln_Gamma x else Polygamma (j - 1) x)"
 proof (cases j)
   case (Suc j')
   have "(deriv ^^ j') (deriv ln_Gamma) x = (deriv ^^ j') Digamma x"
     using eventually_nhds_in_open[of "UNIV - \<real>\<^sub>\<le>\<^sub>0" x] assms
     by (intro higher_deriv_cong_ev refl)
        (auto elim!: eventually_mono simp: open_Diff deriv_ln_Gamma_complex)
   also have "\<dots> = Polygamma j' x" using assms
     by (subst higher_deriv_Polygamma)
        (auto elim!: nonpos_Ints_cases simp: complex_nonpos_Reals_iff)
   finally show ?thesis using Suc by (simp del: funpow.simps add: funpow_Suc_right)
 qed simp_all
 
 lemma higher_deriv_ln_Gamma_real:
   assumes "(x::real) > 0"
   shows   "(deriv ^^ j) ln_Gamma x = (if j = 0 then ln_Gamma x else Polygamma (j - 1) x)"
 proof (cases j)
   case (Suc j')
   have "(deriv ^^ j') (deriv ln_Gamma) x = (deriv ^^ j') Digamma x"
     using eventually_nhds_in_open[of "{0<..}" x] assms
     by (intro higher_deriv_cong_ev refl)
        (auto elim!: eventually_mono simp: open_Diff deriv_ln_Gamma_real)
   also have "\<dots> = Polygamma j' x" using assms
     by (subst higher_deriv_Polygamma)
        (auto elim!: nonpos_Ints_cases simp: complex_nonpos_Reals_iff)
   finally show ?thesis using Suc by (simp del: funpow.simps add: funpow_Suc_right)
 qed simp_all
   
 lemma higher_deriv_ln_Gamma_complex_of_real:
   assumes "(x :: real) > 0"
   shows   "(deriv ^^ j) ln_Gamma (complex_of_real x) = of_real ((deriv ^^ j) ln_Gamma x)"
     using assms
     by (auto simp: higher_deriv_ln_Gamma_real higher_deriv_ln_Gamma_complex
                    ln_Gamma_complex_of_real Polygamma_of_real)
 (* END TODO *)
 
 (* TODO: could be automated with Laurent series expansions in the future *)
 lemma stirling_limit_aux1: 
   "((\<lambda>y. Ln (1 + z * of_real y) / of_real y) \<longlongrightarrow> z) (at_right 0)" for z :: complex
 proof (cases "z = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "((\<lambda>y. ln (1 + z * of_real y)) has_vector_derivative 1 * z) (at 0)"
     by (rule has_vector_derivative_real_field) (auto intro!: derivative_eq_intros)
   then have "(\<lambda>y. (Ln (1 + z * of_real y) - of_real y * z) / of_real \<bar>y\<bar>) \<midarrow>0\<rightarrow> 0"
     by (auto simp add: has_vector_derivative_def has_derivative_def netlimit_at 
           scaleR_conv_of_real field_simps)
   then have "((\<lambda>y. (Ln (1 + z * of_real y) - of_real y * z) / of_real \<bar>y\<bar>) \<longlongrightarrow> 0) (at_right 0)"
     by (rule filterlim_mono[OF _ _ at_le]) simp_all
   also have "?this \<longleftrightarrow> ((\<lambda>y. Ln (1 + z * of_real y) / (of_real y) - z) \<longlongrightarrow> 0) (at_right 0)"
     using eventually_at_right_less[of "0::real"]
     by (intro filterlim_cong refl) (auto elim!: eventually_mono simp: field_simps)
   finally show ?thesis by (simp only: LIM_zero_iff)
 qed
   
 lemma stirling_limit_aux2: 
   "((\<lambda>y. y * Ln (1 + z / of_real y)) \<longlongrightarrow> z) at_top" for z :: complex
   using stirling_limit_aux1[of z] by (subst filterlim_at_top_to_right) (simp add: field_simps)
 
 lemma Union_atLeastAtMost: 
   assumes "N > 0" 
   shows   "(\<Union>n\<in>{0..<N}. {real n..real (n + 1)}) = {0..real N}"
 proof (intro equalityI subsetI)
   fix x assume x: "x \<in> {0..real N}"
   thus "x \<in> (\<Union>n\<in>{0..<N}. {real n..real (n + 1)})"
   proof (cases "x = real N")
     case True
     with assms show ?thesis by (auto intro!: bexI[of _ "N - 1"])
   next
     case False
     with x have x: "x \<ge> 0" "x < real N" by simp_all
     hence "x \<ge> real (nat \<lfloor>x\<rfloor>)" "x \<le> real (nat \<lfloor>x\<rfloor> + 1)" by linarith+
     moreover from x have "nat \<lfloor>x\<rfloor> < N" by linarith
     ultimately have "\<exists>n\<in>{0..<N}. x \<in> {real n..real (n + 1)}"
       by (intro bexI[of _ "nat \<lfloor>x\<rfloor>"]) simp_all
     thus ?thesis by blast
   qed
 qed auto
 
 
 subsection \<open>Cones in the complex plane\<close>
 
 definition complex_cone :: "real \<Rightarrow> real \<Rightarrow> complex set" where
   "complex_cone a b = {z. \<exists>y\<in>{a..b}. z = rcis (norm z) y}"
 
 abbreviation complex_cone' :: "real \<Rightarrow> complex set" where
   "complex_cone' a \<equiv> complex_cone (-a) a"
 
 lemma zero_in_complex_cone [simp, intro]: "a \<le> b \<Longrightarrow> 0 \<in> complex_cone a b"
   by (auto simp: complex_cone_def)
 
 lemma complex_coneE:
   assumes "z \<in> complex_cone a b"
   obtains r \<alpha> where "r \<ge> 0" "\<alpha> \<in> {a..b}" "z = rcis r \<alpha>"
 proof -
   from assms obtain y where "y \<in> {a..b}" "z = rcis (norm z) y"
     unfolding complex_cone_def by auto
   thus ?thesis using that[of "norm z" y] by auto
 qed
 
 lemma arg_cis [simp]:
   assumes "x \<in> {-pi<..pi}"
-  shows   "arg (cis x) = x"
+  shows   "Arg (cis x) = x"
   using assms by (intro arg_unique) auto
 
 lemma arg_mult_of_real_left [simp]:
   assumes "r > 0"
-  shows   "arg (of_real r * z) = arg z"
+  shows   "Arg (of_real r * z) = Arg z"
 proof (cases "z = 0")
   case False
   thus ?thesis
-    using arg_bounded[of z] assms
-    by (intro arg_unique) (auto simp: sgn_mult sgn_of_real cis_arg)
+    using Arg_bounded[of z] assms
+    by (intro arg_unique) (auto simp: sgn_mult sgn_of_real cis_Arg)
 qed auto
 
 lemma arg_mult_of_real_right [simp]:
   assumes "r > 0"
-  shows   "arg (z * of_real r) = arg z"
+  shows   "Arg (z * of_real r) = Arg z"
   by (subst mult.commute, subst arg_mult_of_real_left) (simp_all add: assms)
 
 lemma arg_rcis [simp]:
   assumes "x \<in> {-pi<..pi}" "r > 0"
-  shows   "arg (rcis r x) = x"
+  shows   "Arg (rcis r x) = x"
   using assms by (simp add: rcis_def)
 
 lemma rcis_in_complex_cone [intro]: 
   assumes "\<alpha> \<in> {a..b}" "r \<ge> 0"
   shows   "rcis r \<alpha> \<in> complex_cone a b"
   using assms by (auto simp: complex_cone_def)  
 
 lemma arg_imp_in_complex_cone:
-  assumes "arg z \<in> {a..b}"
+  assumes "Arg z \<in> {a..b}"
   shows   "z \<in> complex_cone a b"
 proof -
-  have "z = rcis (norm z) (arg z)"
-    by (simp add: rcis_cmod_arg)
+  have "z = rcis (norm z) (Arg z)"
+    by (simp add: rcis_cmod_Arg)
   also have "\<dots> \<in> complex_cone a b"
     using assms by auto
   finally show ?thesis .
 qed
 
 lemma complex_cone_altdef:
   assumes "-pi < a" "a \<le> b" "b \<le> pi"
-  shows   "complex_cone a b = insert 0 {z. arg z \<in> {a..b}}"
+  shows   "complex_cone a b = insert 0 {z. Arg z \<in> {a..b}}"
 proof (intro equalityI subsetI)
   fix z assume "z \<in> complex_cone a b"
   then obtain r \<alpha> where *: "r \<ge> 0" "\<alpha> \<in> {a..b}" "z = rcis r \<alpha>"
     by (auto elim: complex_coneE)
-  have "arg z \<in> {a..b}" if [simp]: "z \<noteq> 0"
+  have "Arg z \<in> {a..b}" if [simp]: "z \<noteq> 0"
   proof -
     have "r > 0" using that * by (subst (asm) *) auto
     hence "\<alpha> \<in> {a..b}"
       using *(1,2) assms by (auto simp: *(1))
     moreover from assms *(2) have "\<alpha> \<in> {-pi<..pi}"
       by auto
     ultimately show ?thesis using *(3) \<open>r > 0\<close>
       by (subst *) auto
   qed
-  thus "z \<in> insert 0 {z. arg z \<in> {a..b}}"
+  thus "z \<in> insert 0 {z. Arg z \<in> {a..b}}"
     by auto
 qed (use assms in \<open>auto intro: arg_imp_in_complex_cone\<close>)
 
 lemma nonneg_of_real_in_complex_cone [simp, intro]:
   assumes "x \<ge> 0" "a \<le> 0" "0 \<le> b"
   shows   "of_real x \<in> complex_cone a b"
 proof -
   from assms have "rcis x 0 \<in> complex_cone a b"
     by (intro rcis_in_complex_cone) auto
   thus ?thesis by simp
 qed
 
 lemma one_in_complex_cone [simp, intro]: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> 1 \<in> complex_cone a b"
   using nonneg_of_real_in_complex_cone[of 1] by (simp del: nonneg_of_real_in_complex_cone)
 
 lemma of_nat_in_complex_cone [simp, intro]: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> of_nat n \<in> complex_cone a b"
   using nonneg_of_real_in_complex_cone[of "real n"] by (simp del: nonneg_of_real_in_complex_cone)
 
 
 subsection \<open>Another integral representation of the Beta function\<close>
 
 lemma complex_cone_inter_nonpos_Reals:
   assumes "-pi < a" "a \<le> b" "b < pi"
   shows   "complex_cone a b \<inter> \<real>\<^sub>\<le>\<^sub>0 = {0}"
 proof (safe elim!: nonpos_Reals_cases)
   fix x :: real
   assume "complex_of_real x \<in> complex_cone a b" "x \<le> 0"
   hence "\<not>(x < 0)"
     using assms by (intro notI) (auto simp: complex_cone_altdef)
   with \<open>x \<le> 0\<close> show "complex_of_real x = 0" by auto  
 qed (use assms in auto)
 
 theorem 
   assumes a: "a > 0" and b: "b > (0 :: real)"
   shows has_integral_Beta_real': 
           "((\<lambda>u. u powr (b - 1) / (1 + u) powr (a + b)) has_integral Beta a b) {0<..}"
     and Beta_conv_nn_integral:
           "Beta a b = (\<integral>\<^sup>+u. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) \<partial>lborel)"
 proof -
   define I where 
     "I = (\<integral>\<^sup>+u. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) \<partial>lborel)"
   have "Gamma (a + b) > 0" "Beta a b > 0"
     using assms by (simp_all add: add_pos_pos Beta_def)
   from a b have "ennreal (Gamma a * Gamma b) =
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (a - 1) / exp t) \<partial>lborel) *
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (b - 1) / exp t) \<partial>lborel)"
     by (subst ennreal_mult') (simp_all add: Gamma_conv_nn_integral_real)
   also have "\<dots> = (\<integral>\<^sup>+t. \<integral>\<^sup>+u. ennreal (indicator {0..} t * t powr (a - 1) / exp t) *
                             ennreal (indicator {0..} u * u powr (b - 1) / exp u) \<partial>lborel \<partial>lborel)"
     by (simp add: nn_integral_cmult nn_integral_multc)
   also have "\<dots> = (\<integral>\<^sup>+t. indicator {0<..} t * (\<integral>\<^sup>+u. indicator {0..} u * t powr (a - 1) * u powr (b - 1)
                             / exp (t + u) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"])
        (auto simp: indicator_def divide_ennreal ennreal_mult' [symmetric] exp_add mult_ac)
   also have "\<dots> = (\<integral>\<^sup>+t. indicator {0<..} t * (\<integral>\<^sup>+u. indicator {0..} u * t powr (a - 1) * u powr (b - 1)
                             / exp (t + u) 
                     \<partial>(density (distr lborel borel ((*) t)) (\<lambda>x. ennreal \<bar>t\<bar>))) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong, subst lborel_distr_mult' [symmetric]) auto
   also have "\<dots> = (\<integral>\<^sup>+(t::real). indicator {0<..} t * (\<integral>\<^sup>+u. 
                      indicator {0..} (u * t) * t powr a *
                      (u * t) powr (b - 1) / exp (t + t * u) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong)
        (auto simp: nn_integral_density nn_integral_distr algebra_simps powr_diff
              simp flip: ennreal_mult)
   also have "\<dots> = (\<integral>\<^sup>+(t::real). \<integral>\<^sup>+u. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr a * (u * t) powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (subst nn_integral_cmult [symmetric], simp, intro nn_integral_cong)
        (auto simp: indicator_def zero_le_mult_iff algebra_simps)
   also have "\<dots> = (\<integral>\<^sup>+(t::real). \<integral>\<^sup>+u. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong) (auto simp: powr_add powr_diff indicator_def powr_mult field_simps)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). \<integral>\<^sup>+t. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (rule lborel_pair.Fubini') auto
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong) (auto simp: indicator_def)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"]) (auto simp: indicator_def)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) 
                     \<partial>(density (distr lborel borel ((*) (1/(1+u)))) (\<lambda>x. ennreal \<bar>1/(1+u)\<bar>))) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong, subst lborel_distr_mult' [symmetric]) auto
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * 
                     (\<integral>\<^sup>+t. ennreal (1 / (u + 1)) * ennreal (indicator {0<..} (t / (u + 1)) *
                      (t / (1+u)) powr (a + b - 1) * u powr (b - 1) / exp t)
                     \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong)
        (auto simp: nn_integral_distr nn_integral_density add_ac)
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. indicator ({0<..}\<times>{0<..}) (u, t) * 
                     1/(u+1) * (t / (u+1)) powr (a + b - 1) * u powr (b - 1) / exp t
                     \<partial>lborel \<partial>lborel)"
     by (subst nn_integral_cmult [symmetric], simp, intro nn_integral_cong)
        (auto simp: indicator_def field_simps divide_ennreal simp flip: ennreal_mult ennreal_mult')
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) *
                             ennreal (indicator {0<..} t * t powr (a + b - 1) / exp t)
                     \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong)
        (auto simp: indicator_def powr_add powr_diff powr_divide powr_minus divide_simps add_ac
              simp flip: ennreal_mult)
   also have "\<dots> = I * (\<integral>\<^sup>+t. indicator {0<..} t * t powr (a + b - 1) / exp t \<partial>lborel)"
     by (simp add: nn_integral_cmult nn_integral_multc I_def)
   also have "(\<integral>\<^sup>+t. indicator {0<..} t * t powr (a + b - 1) / exp t \<partial>lborel) =
                ennreal (Gamma (a + b))"
     using assms
     by (subst Gamma_conv_nn_integral_real)
        (auto intro!: nn_integral_cong_AE[OF AE_I[of _ _ "{0}"]] 
              simp: indicator_def split: if_splits)
   finally have "ennreal (Gamma a * Gamma b) = I * ennreal (Gamma (a + b))" .
   hence "ennreal (Gamma a * Gamma b) / ennreal (Gamma (a + b)) =
            I * ennreal (Gamma (a + b)) / ennreal (Gamma (a + b))" by simp
   also have "\<dots> = I"
     using \<open>Gamma (a + b) > 0\<close> by (intro ennreal_mult_divide_eq) (auto simp: )
   also have "ennreal (Gamma a * Gamma b) / ennreal (Gamma (a + b)) =
                ennreal (Gamma a * Gamma b / Gamma (a + b))"
     using assms by (intro divide_ennreal) auto
   also have "\<dots> = ennreal (Beta a b)"
     by (simp add: Beta_def)
   finally show *: "ennreal (Beta a b) = I" .
 
   define f where "f = (\<lambda>u. u powr (b - 1) / (1 + u) powr (a + b))"
   have "((\<lambda>u. indicator {0<..} u * f u) has_integral Beta a b) UNIV"
     using * \<open>Beta a b > 0\<close>
     by (subst has_integral_iff_nn_integral_lebesgue)
        (auto simp: f_def measurable_completion nn_integral_completion I_def mult_ac)
   also have "(\<lambda>u. indicator {0<..} u * f u) = (\<lambda>u. if u \<in> {0<..} then f u else 0)"
     by (auto simp: fun_eq_iff)
   also have "(\<dots> has_integral Beta a b) UNIV \<longleftrightarrow> (f has_integral Beta a b) {0<..}"
     by (rule has_integral_restrict_UNIV)
   finally show \<dots> by (simp add: f_def)
 qed
 
 lemma has_integral_Beta2:
   fixes a :: real
   assumes "a < -1/2"
   shows   "((\<lambda>x. (1 + x ^ 2) powr a) has_integral Beta (- a - 1 / 2) (1 / 2) / 2) {0<..}"
 proof -
   define f where "f = (\<lambda>u. u powr (-1/2) / (1 + u) powr (-a))"
   define C where "C = Beta (-a-1/2) (1/2)"
   have I: "(f has_integral C) {0<..}"
     using has_integral_Beta_real'[of "-a-1/2" "1/2"] assms
     by (simp_all add: diff_divide_distrib f_def C_def)
 
   define g where "g = (\<lambda>x. x ^ 2 :: real)"
   have bij: "bij_betw g {0<..} {0<..}"
     by (intro bij_betwI[of _ _ _ sqrt]) (auto simp: g_def)
 
   have "(f absolutely_integrable_on g ` {0<..} \<and> integral (g ` {0<..}) f = C)"
     using I bij by (simp add: bij_betw_def has_integral_iff absolutely_integrable_on_def f_def)
   also have "?this \<longleftrightarrow> ((\<lambda>x. \<bar>2 * x\<bar> *\<^sub>R f (g x)) absolutely_integrable_on {0<..} \<and>
                          integral {0<..} (\<lambda>x. \<bar>2 * x\<bar> *\<^sub>R f (g x)) = C)"
     using bij by (intro has_absolute_integral_change_of_variables_1' [symmetric])
                  (auto intro!: derivative_eq_intros simp: g_def bij_betw_def)
   finally have "((\<lambda>x. \<bar>2 * x\<bar> * f (g x)) has_integral C) {0<..}"
     by (simp add: absolutely_integrable_on_def f_def has_integral_iff)
   also have "?this \<longleftrightarrow> ((\<lambda>x::real. 2 * (1 + x\<^sup>2) powr a) has_integral C) {0<..}"
     by (intro has_integral_cong) (auto simp: f_def g_def powr_def exp_minus ln_realpow field_simps)
   finally have "((\<lambda>x::real. 1/2 * (2 * (1 + x\<^sup>2) powr a)) has_integral 1/2 * C) {0<..}"
     by (intro has_integral_mult_right)
   thus ?thesis by (simp add: C_def)
 qed
 
 lemma has_integral_Beta3:
   fixes a b :: real
   assumes "a < -1/2" and "b > 0"
   shows   "((\<lambda>x. (b + x ^ 2) powr a) has_integral
              Beta (-a - 1/2) (1/2) / 2 * b powr (a + 1/2)) {0<..}"
 proof -
   define C where "C = Beta (- a - 1 / 2) (1 / 2) / 2"
   have int: "nn_integral lborel (\<lambda>x. indicator {0<..} x * (1 + x ^ 2) powr a) = C"
     using nn_integral_has_integral_lebesgue[OF _ has_integral_Beta2[OF assms(1)]]
     by (auto simp: C_def)
   have "nn_integral lborel (\<lambda>x. indicator {0<..} x * (b + x ^ 2) powr a) =
         (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} (x * sqrt b) * (b + (x * sqrt b)\<^sup>2) powr a * sqrt b) \<partial>lborel)"
     using assms
     by (subst lborel_distr_mult'[of "sqrt b"])
        (auto simp: nn_integral_density nn_integral_distr mult_ac simp flip: ennreal_mult)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (b * (1 + x ^ 2)) powr a * sqrt b) \<partial>lborel)"
     using assms
     by (intro nn_integral_cong) (auto simp: indicator_def field_simps zero_less_mult_iff)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * b powr (a + 1/2) * (1 + x ^ 2) powr a) \<partial>lborel)"
     using assms
     by (intro nn_integral_cong) (auto simp: indicator_def powr_add powr_half_sqrt powr_mult)    
   also have "\<dots> = b powr (a + 1/2) * (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (1 + x ^ 2) powr a) \<partial>lborel)"
     using assms by (subst nn_integral_cmult [symmetric]) (simp_all add: mult_ac flip: ennreal_mult)
   also have "(\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (1 + x ^ 2) powr a) \<partial>lborel) = C"
     using int by simp
   also have "ennreal (b powr (a + 1/2)) * ennreal C = ennreal (C * b powr (a + 1/2))"
     using assms by (subst ennreal_mult) (auto simp: C_def mult_ac Beta_def)
   finally have *: "(\<integral>\<^sup>+ x. ennreal (indicat_real {0<..} x * (b + x\<^sup>2) powr a) \<partial>lborel) = \<dots>" .
   hence "((\<lambda>x. indicator {0<..} x * (b + x^2) powr a) has_integral C * b powr (a + 1/2)) UNIV"
     using assms
     by (subst has_integral_iff_nn_integral_lebesgue)
        (auto simp: C_def measurable_completion nn_integral_completion Beta_def)
   also have "(\<lambda>x. indicator {0<..} x * (b + x^2) powr a) =
              (\<lambda>x. if x \<in> {0<..} then (b + x^2) powr a else 0)"
     by (auto simp: fun_eq_iff)
   finally show ?thesis
     by (subst (asm) has_integral_restrict_UNIV) (auto simp: C_def)
 qed
 
   
 subsection \<open>Asymptotics of the real $\log\Gamma$ function and its derivatives\<close>
 
 text \<open>
   This is the error term that occurs in the expansion of @{term ln_Gamma}. It can be shown to 
   be of order $O(s^{-n})$.
 \<close>
 definition stirling_integral :: "nat \<Rightarrow> 'a :: {real_normed_div_algebra, banach} \<Rightarrow> 'a" where
   "stirling_integral n s = 
      lim (\<lambda>N. integral {0..N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))"
 
 context
   fixes s :: complex assumes s: "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
   fixes approx :: "nat \<Rightarrow> complex"
   defines "approx \<equiv> (\<lambda>N. 
     (\<Sum>n = 1..<N. s / of_nat n - ln (1 + s / of_nat n)) - (euler_mascheroni * s + ln s) - \<comment> \<open>\<open>\<longrightarrow> ln_Gamma s\<close>\<close>
     (ln_Gamma (of_nat N) - ln (2 * pi / of_nat N) / 2 - of_nat N * ln (of_nat N) + of_nat N) - \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     s * (harm (N - 1) - ln (of_nat (N - 1)) - euler_mascheroni) + \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     s * (ln (of_nat N + s) - ln (of_nat (N - 1))) - \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     (1/2) * (ln (of_nat N + s) - ln (of_nat N)) +       \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     of_nat N * (ln (of_nat N + s) - ln (of_nat N)) -  \<comment> \<open>\<open>\<longrightarrow> s\<close>\<close>
     (s - 1/2) * ln s - ln (2 * pi) / 2)"
 begin       
   
 qualified lemma
   assumes N: "N > 0"
   shows   integrable_pbernpoly_1:
             "(\<lambda>x. of_real (-pbernpoly 1 x) / (of_real x + s)) integrable_on {0..real N}"
   and     integral_pbernpoly_1_aux:
             "integral {0..real N} (\<lambda>x. -of_real (pbernpoly 1 x) / (of_real x + s)) = approx N"
   and     has_integral_pbernpoly_1:
             "((\<lambda>x. pbernpoly 1 x /(x + s)) has_integral 
               (\<Sum>m<N. (of_nat m + 1 / 2 + s) * (ln (of_nat m + s) - 
                         ln (of_nat m + 1 + s)) + 1)) {0..real N}"
 proof -
   let ?A = "(\<lambda>n. {of_nat n..of_nat (n+1)}) ` {0..<N}"
   have has_integral: 
     "((\<lambda>x. -pbernpoly 1 x / (x + s)) has_integral 
              (of_nat n + 1/2 + s) * (ln (of_nat (n + 1) + s) - ln (of_nat n + s)) - 1) 
            {of_nat n..of_nat (n + 1)}" for n
   proof (rule has_integral_spike)      
     have "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (x + s)) - 1) has_integral 
               (of_nat n + 1/2 + s) * (ln (of_real (real (n + 1)) + s) - ln (of_real (real n) + s)) - 1) 
             {of_nat n..of_nat (n + 1)}" 
       using s has_integral_const_real[of 1 "of_nat n" "of_nat (n + 1)"]
       by (intro has_integral_diff has_integral_mult_right fundamental_theorem_of_calculus)
          (auto intro!: derivative_eq_intros has_vector_derivative_real_field
                simp: has_field_derivative_iff_has_vector_derivative [symmetric] field_simps
                      complex_nonpos_Reals_iff)
     thus "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (x + s)) - 1) has_integral 
               (of_nat n + 1/2 + s) * (ln (of_nat (n + 1) + s) - ln (of_nat n + s)) - 1) 
             {of_nat n..of_nat (n + 1)}" by simp
              
     show "-pbernpoly 1 x / (x + s) = (of_nat n + 1/2 + s) * (1 / (x + s)) - 1"
          if "x \<in> {of_nat n..of_nat (n + 1)} - {of_nat (n + 1)}" for x
     proof -
       have x: "x \<ge> real n" "x < real (n + 1)" using that by simp_all
       hence "floor x = int n" by linarith
       moreover from s x have "complex_of_real x \<noteq> -s" 
         by (auto simp add: complex_eq_iff complex_nonpos_Reals_iff simp del: of_nat_Suc)
       ultimately show "-pbernpoly 1 x / (x + s) = (of_nat n + 1/2 + s) * (1 / (x + s)) - 1"
         by (auto simp: pbernpoly_def bernpoly_def frac_def divide_simps add_eq_0_iff2)
     qed
   qed simp_all
   hence *: "\<And>I. I\<in>?A \<Longrightarrow> ((\<lambda>x. -pbernpoly 1 x / (x + s)) has_integral 
               (Inf I + 1/2 + s) * (ln (Inf I + 1 + s) - ln (Inf I + s)) - 1) I"
     by (auto simp: add_ac)
   have "((\<lambda>x. - pbernpoly 1 x / (x + s)) has_integral
           (\<Sum>I\<in>?A. (Inf I + 1 / 2 + s) * (ln (Inf I + 1 + s) - ln (Inf I + s)) - 1))
           (\<Union>n\<in>{0..<N}. {real n..real (n + 1)})" (is "(_ has_integral ?i) _")
     apply (intro has_integral_Union * finite_imageI)
       apply (force intro!: negligible_atLeastAtMostI pairwiseI)+
     done
   hence has_integral: "((\<lambda>x. - pbernpoly 1 x / (x + s)) has_integral ?i) {0..real N}"
     by (subst has_integral_spike_set_eq)
        (use Union_atLeastAtMost assms in \<open>auto simp: intro!: empty_imp_negligible\<close>)
   hence "(\<lambda>x. - pbernpoly 1 x / (x + s)) integrable_on {0..real N}"
     and integral:   "integral {0..real N} (\<lambda>x. - pbernpoly 1 x / (x + s)) = ?i"
     by (simp_all add: has_integral_iff)
   show "(\<lambda>x. - pbernpoly 1 x / (x + s)) integrable_on {0..real N}" by fact
 
   note has_integral_neg[OF has_integral]
   also have "-?i = (\<Sum>x<N. (of_nat x + 1 / 2 + s) * (ln (of_nat x + s) - ln (of_nat x + 1 + s)) + 1)" 
     by (subst sum.reindex) 
        (simp_all add: inj_on_def atLeast0LessThan algebra_simps sum_negf [symmetric])
   finally show has_integral: 
     "((\<lambda>x. of_real (pbernpoly 1 x) / (of_real x + s)) has_integral \<dots>) {0..real N}" by simp
       
   note integral
   also have "?i = (\<Sum>n<N. (of_nat n + 1 / 2 + s) * 
                     (ln (of_nat n + 1 + s) - ln (of_nat n + s))) - N" (is "_ = ?S - _")
     by (subst sum.reindex) (simp_all add: inj_on_def sum_subtractf atLeast0LessThan)
   also have "?S = (\<Sum>n<N. of_nat n * (ln (of_nat n + 1 + s) - ln (of_nat n + s))) +
                     (s + 1 / 2) * (\<Sum>n<N. ln (of_nat (Suc n) + s) - ln (of_nat n + s))" 
     (is "_ = ?S1 + _ * ?S2") by (simp add: algebra_simps sum.distrib sum_subtractf sum_distrib_left)
   also have "?S2 = ln (of_nat N + s) - ln s" by (subst sum_lessThan_telescope) simp
   also have "?S1 = (\<Sum>n=1..<N. of_nat n * (ln (of_nat n + 1 + s) - ln (of_nat n + s)))"
     by (intro sum.mono_neutral_right) auto
   also have "\<dots> = (\<Sum>n=1..<N. of_nat n * ln (of_nat n + 1 + s)) - (\<Sum>n=1..<N. of_nat n * ln (of_nat n + s))"
     by (simp add: algebra_simps sum_subtractf)
   also have "(\<Sum>n=1..<N. of_nat n * ln (of_nat n + 1 + s)) = 
                (\<Sum>n=1..<N. (of_nat n - 1) * ln (of_nat n + s)) + (N - 1) * ln (of_nat N + s)"
     by (induction N) (simp_all add: add_ac of_nat_diff)
   also have "\<dots> - (\<Sum>n = 1..<N. of_nat n * ln (of_nat n + s)) =
                -(\<Sum>n=1..<N. ln (of_nat n + s)) + (N - 1) * ln (of_nat N + s)"
     by (induction N) (simp_all add: algebra_simps)
   also from s have neq: "s + of_nat x \<noteq> 0" for x
     by (auto simp:  complex_nonpos_Reals_iff complex_eq_iff)
   hence "(\<Sum>n=1..<N. ln (of_nat n + s)) = (\<Sum>n=1..<N. ln (of_nat n) + ln (1 + s/n))"
     by (intro sum.cong refl, subst Ln_times_of_nat [symmetric]) (auto simp: divide_simps add_ac)
   also have "\<dots> = ln (fact (N - 1)) + (\<Sum>n=1..<N. ln (1 + s/n))"
     by (induction N) (simp_all add: Ln_times_of_nat fact_reduce add_ac)
   also have "(\<Sum>n=1..<N. ln (1 + s/n)) = -(\<Sum>n=1..<N. s / n - ln (1 + s/n)) + s * (\<Sum>n=1..<N. 1 / of_nat n)"
     by (simp add: sum_distrib_left sum_subtractf) 
   also from N have "ln (fact (N - 1)) = ln_Gamma (of_nat N :: complex)" 
     by (simp add: ln_Gamma_complex_conv_fact)
   also have "{1..<N} = {1..N - 1}" by auto
   hence "(\<Sum>n = 1..<N. 1 / of_nat n) = (harm (N - 1) :: complex)" 
     by (simp add: harm_def divide_simps)
   also have "- (ln_Gamma (of_nat N) + (- (\<Sum>n = 1..<N. s / of_nat n - ln (1 + s / of_nat n)) +
                  s * harm (N - 1))) + of_nat (N - 1) * ln (of_nat N + s) +
                 (s + 1 / 2) * (ln (of_nat N + s) - ln s) - of_nat N = approx N"
     using N by (simp add: field_simps of_nat_diff ln_div approx_def Ln_of_nat 
                           ln_Gamma_complex_of_real [symmetric])
   finally show "integral {0..of_nat N} (\<lambda>x. -of_real (pbernpoly 1 x) / (of_real x + s)) = \<dots>" 
     by simp
 qed
   
 lemma integrable_ln_Gamma_aux:
   shows   "(\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n) integrable_on {0..real N}"
 proof (cases "n = 1")
   case True
   with s show ?thesis using integrable_neg[OF integrable_pbernpoly_1[of N]] 
     by (cases "N = 0") (simp_all add: integrable_negligible)
 next
   case False
   from s have "of_real x + s \<noteq> 0" if "x \<ge> 0" for x using that 
     by (auto simp: complex_eq_iff add_eq_0_iff2 complex_nonpos_Reals_iff)
   with False s show ?thesis
     by (auto intro!: integrable_continuous_real continuous_intros)
 qed
   
 text \<open>
   This following proof is based on ``Rudiments of the theory of the gamma function'' 
   by Bruce Berndt~\cite{berndt}.
 \<close>
 qualified lemma integral_pbernpoly_1: 
   "(\<lambda>N. integral {0..real N} (\<lambda>x. pbernpoly 1 x / (x + s)))
      \<longlonglongrightarrow> -ln_Gamma s - s + (s - 1 / 2) * ln s + ln (2 * pi) / 2"
 proof -  
   have neq: "s + of_real x \<noteq> 0" if "x \<ge> 0" for x :: real
     using that s by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
   have "(approx \<longlongrightarrow> ln_Gamma s - 0 - 0 + 0 - 0 + s - (s - 1/2) * ln s - ln (2 * pi) / 2) at_top"
     unfolding approx_def
   proof (intro tendsto_add tendsto_diff)
     from s have s': "s \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto simp: complex_nonpos_Reals_iff elim!: nonpos_Ints_cases)
     have "(\<lambda>n. \<Sum>i=1..<n. s / of_nat i - ln (1 + s / of_nat i)) \<longlonglongrightarrow> 
              ln_Gamma s + euler_mascheroni * s + ln s" (is "?f \<longlonglongrightarrow> _")
       using ln_Gamma_series'_aux[OF s'] unfolding sums_def 
       by (subst filterlim_sequentially_Suc [symmetric], subst (asm) sum.atLeast1_atMost_eq [symmetric]) 
          (simp add: atLeastLessThanSuc_atLeastAtMost)
     thus "((\<lambda>n. ?f n - (euler_mascheroni * s + ln s)) \<longlongrightarrow> ln_Gamma s) at_top"
       by (auto intro: tendsto_eq_intros)
   next
     show "(\<lambda>x. complex_of_real (ln_Gamma (real x) - ln (2 * pi / real x) / 2 - 
                  real x * ln (real x) + real x)) \<longlonglongrightarrow> 0"
     proof (intro tendsto_of_real_0_I 
              filterlim_compose[OF tendsto_sandwich filterlim_real_sequentially])
       show "eventually (\<lambda>x::real. ln_Gamma x - ln (2 * pi / x) / 2 - x * ln x + x \<ge> 0) at_top"
         using eventually_ge_at_top[of "1::real"] 
         by eventually_elim (insert ln_Gamma_bounds(1), simp add: algebra_simps)
       show "eventually (\<lambda>x::real. ln_Gamma x - ln (2 * pi / x) / 2 - x * ln x + x \<le> 
               1 / 12 * inverse x) at_top"
         using eventually_ge_at_top[of "1::real"] 
         by eventually_elim (insert ln_Gamma_bounds(2), simp add: field_simps)
       show "((\<lambda>x::real. 1 / 12 * inverse x) \<longlongrightarrow> 0) at_top"
         by (intro tendsto_mult_right_zero tendsto_inverse_0_at_top filterlim_ident)
     qed simp_all
   next
     have "(\<lambda>x. s * of_real (harm (x - 1) - ln (real (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 
             s * of_real (euler_mascheroni - euler_mascheroni)"
       by (subst filterlim_sequentially_Suc [symmetric], intro tendsto_intros) 
          (insert euler_mascheroni_LIMSEQ, simp_all)
     also have "?this \<longleftrightarrow> (\<lambda>x. s * (harm (x - 1) - ln (of_nat (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 0"
       by (intro filterlim_cong refl eventually_mono[OF eventually_gt_at_top[of "1::nat"]]) 
          (auto simp: Ln_of_nat of_real_harm)
     finally show "(\<lambda>x. s * (harm (x - 1) - ln (of_nat (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 0"  .
   next
     have "((\<lambda>x. ln (1 + (s + 1) / of_real x)) \<longlongrightarrow> ln (1 + 0)) at_top" (is ?P)
       by (intro tendsto_intros tendsto_divide_0[OF tendsto_const]) 
          (simp_all add: filterlim_ident filterlim_at_infinity_conv_norm_at_top filterlim_abs_real)
     also have "ln (of_real (x + 1) + s) - ln (complex_of_real x) = ln (1 + (s + 1) / of_real x)" 
       if "x > 1" for x using that s
       using Ln_divide_of_real[of x "of_real (x + 1) + s", symmetric] neq[of "x+1"]
       by (simp add: field_simps Ln_of_real)
     hence "?P \<longleftrightarrow> ((\<lambda>x. ln (of_real (x + 1) + s) - ln (of_real x)) \<longlongrightarrow> 0) at_top"
       by (intro filterlim_cong refl) 
          (auto intro: eventually_mono[OF eventually_gt_at_top[of "1::real"]])
     finally have "((\<lambda>n. ln (of_real (real n + 1) + s) - ln (of_real (real n))) \<longlongrightarrow> 0) at_top"
       by (rule filterlim_compose[OF _ filterlim_real_sequentially])
     hence "((\<lambda>n. ln (of_nat n + s) - ln (of_nat (n - 1))) \<longlongrightarrow> 0) at_top"
       by (subst filterlim_sequentially_Suc [symmetric]) (simp add: add_ac)
     thus "(\<lambda>x. s * (ln (of_nat x + s) - ln (of_nat (x - 1)))) \<longlonglongrightarrow> 0"
       by (rule tendsto_mult_right_zero)
   next
     have "((\<lambda>x. ln (1 + s / of_real x)) \<longlongrightarrow> ln (1 + 0)) at_top" (is ?P)
       by (intro tendsto_intros tendsto_divide_0[OF tendsto_const]) 
          (simp_all add: filterlim_ident  filterlim_at_infinity_conv_norm_at_top filterlim_abs_real)
     also have "ln (of_real x + s) - ln (of_real x) = ln (1 + s / of_real x)" if "x > 0" for x
       using Ln_divide_of_real[of x "of_real x + s"] neq[of x] that
       by (auto simp: field_simps Ln_of_real)
     hence "?P \<longleftrightarrow> ((\<lambda>x. ln (of_real x + s) - ln (of_real x)) \<longlongrightarrow> 0) at_top"
       using s by (intro filterlim_cong refl) 
                  (auto intro: eventually_mono [OF eventually_gt_at_top[of "1::real"]])
     finally have "(\<lambda>x. (1/2) * (ln (of_real (real x) + s) - ln (of_real (real x)))) \<longlonglongrightarrow> 0"        
       by (rule tendsto_mult_right_zero[OF filterlim_compose[OF _ filterlim_real_sequentially]])
     thus "(\<lambda>x. (1/2) * (ln (of_nat x + s) - ln (of_nat x))) \<longlonglongrightarrow> 0" by simp
   next
     have "((\<lambda>x. x * (ln (1 + s / of_real x))) \<longlongrightarrow> s) at_top" (is ?P) 
       by (rule stirling_limit_aux2)
     also have "ln (1 + s / of_real x) = ln (of_real x + s) - ln (of_real x)" if "x > 1" for x 
       using that s Ln_divide_of_real [of x "of_real x + s", symmetric] neq[of x]
       by (auto simp: Ln_of_real field_simps)
     hence "?P \<longleftrightarrow> ((\<lambda>x. of_real x * (ln (of_real x + s) - ln (of_real x))) \<longlongrightarrow> s) at_top"
       by (intro filterlim_cong refl) 
          (auto intro: eventually_mono[OF eventually_gt_at_top[of "1::real"]])
     finally have "(\<lambda>n. of_real (real n) * (ln (of_real (real n) + s) - ln (of_real (real n)))) \<longlonglongrightarrow> s"
       by (rule filterlim_compose[OF _ filterlim_real_sequentially])
     thus "(\<lambda>n. of_nat n * (ln (of_nat n + s) - ln (of_nat n))) \<longlonglongrightarrow> s" by simp
   qed simp_all
   also have "?this \<longleftrightarrow> ((\<lambda>N. integral {0..real N} (\<lambda>x. -pbernpoly 1 x / (x + s))) \<longlongrightarrow>
                          ln_Gamma s + s - (s - 1/2) * ln s - ln (2 * pi) / 2) at_top"
     using integral_pbernpoly_1_aux
     by (intro filterlim_cong refl) 
        (auto intro: eventually_mono[OF eventually_gt_at_top[of "0::nat"]])
   also have "(\<lambda>N. integral {0..real N} (\<lambda>x. -pbernpoly 1 x / (x + s))) =
                (\<lambda>N. -integral {0..real N} (\<lambda>x. pbernpoly 1 x / (x + s)))"
     by (simp add: fun_eq_iff)
   finally show ?thesis by (simp add: tendsto_minus_cancel_left [symmetric] algebra_simps)
 qed
 
 
 qualified lemma pbernpoly_integral_conv_pbernpoly_integral_Suc:
   assumes "n \<ge> 1"
   shows   "integral {0..real N} (\<lambda>x. pbernpoly n x / (x + s) ^ n) =
              of_real (pbernpoly (Suc n) (real N)) / (of_nat (Suc n) * (s + of_nat N) ^ n) -
              of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n) + of_nat n / of_nat (Suc n) * 
                integral {0..real N} (\<lambda>x. of_real (pbernpoly (Suc n) x) / (of_real x + s) ^ Suc n)"
 proof - 
   note [derivative_intros] = has_field_derivative_pbernpoly_Suc'
   define I where "I = -of_real (pbernpoly (Suc n) (of_nat N)) / (of_nat (Suc n) * (of_nat N + s) ^ n) +
             of_real (bernoulli (Suc n) / real (Suc n)) / s ^ n +
             integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)"
   have "((\<lambda>x. (-of_nat n * inverse (of_real x + s) ^ Suc n) * 
           (of_real (pbernpoly (Suc n) x) / (of_nat (Suc n))))
           has_integral -I) {0..real N}"
   proof (rule integration_by_parts_interior_strong[OF bounded_bilinear_mult])
     fix x :: real assume x: "x \<in> {0<..<real N} - real ` {0..N}"
     have "x \<notin> \<int>"
     proof
       assume "x \<in> \<int>"
       then obtain n where "x = of_int n" by (auto elim!: Ints_cases)
       with x have x': "x = of_nat (nat n)" by simp
       from x show False by (auto simp: x')
     qed
     hence "((\<lambda>x. of_real (pbernpoly (Suc n) x / of_nat (Suc n))) has_vector_derivative
         complex_of_real (pbernpoly n x)) (at x)"
       by (intro has_vector_derivative_of_real) (auto intro!: derivative_eq_intros)
     thus "((\<lambda>x. of_real (pbernpoly (Suc n) x) / of_nat (Suc n)) has_vector_derivative
             complex_of_real (pbernpoly n x)) (at x)" by simp
     from x s have "complex_of_real x + s \<noteq> 0"
       by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
     thus "((\<lambda>x. inverse (of_real x + s) ^ n) has_vector_derivative 
              - of_nat n * inverse (of_real x + s) ^ Suc n) (at x)" using x s assms
       by (auto intro!: derivative_eq_intros has_vector_derivative_real_field simp: divide_simps power_add [symmetric]
                simp del: power_Suc)
   next
     have "complex_of_real x + s \<noteq> 0" if "x \<ge> 0" for x 
       using that s by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
     thus "continuous_on {0..real N} (\<lambda>x. inverse (of_real x + s) ^ n)" 
          "continuous_on {0..real N} (\<lambda>x. complex_of_real (pbernpoly (Suc n) x) / of_nat (Suc n))"
       using assms s by (auto intro!: continuous_intros simp del: of_nat_Suc)
   next
     have "((\<lambda>x. inverse (of_real x + s) ^ n * of_real (pbernpoly n x)) has_integral
             pbernpoly (Suc n) (of_nat N) / (of_nat (Suc n) * (of_nat N + s) ^ n) -
             of_real (bernoulli (Suc n) / real (Suc n)) / s ^ n - -I) {0..real N}" 
       using integrable_ln_Gamma_aux[of n N] assms
       by (auto simp: I_def has_integral_integral divide_simps)
     thus "((\<lambda>x. inverse (of_real x + s) ^ n * of_real (pbernpoly n x)) has_integral
               inverse (of_real (real N) + s) ^ n * (of_real (pbernpoly (Suc n) (real N)) / 
                   of_nat (Suc n)) -
               inverse (of_real 0 + s) ^ n * (of_real (pbernpoly (Suc n) 0) / of_nat (Suc n)) - - I)
             {0..real N}" by (simp_all add: field_simps)
   qed simp_all
   also have "(\<lambda>x. - of_nat n * inverse (of_real x + s) ^ Suc n * (of_real (pbernpoly (Suc n) x) /
                          of_nat (Suc n))) =
              (\<lambda>x. - (of_nat n / of_nat (Suc n) * of_real (pbernpoly (Suc n) x) / 
                          (of_real x + s) ^ Suc n))"
     by (simp add: divide_simps fun_eq_iff)
   finally have "((\<lambda>x. - (of_nat n / of_nat (Suc n) * of_real (pbernpoly (Suc n) x) /
                             (of_real x + s) ^ Suc n)) has_integral - I) {0..real N}" .
   from has_integral_neg[OF this] show ?thesis
     by (auto simp add: I_def has_integral_iff algebra_simps integral_mult_right [symmetric] 
              simp del: power_Suc of_nat_Suc )
 qed
 
 lemma pbernpoly_over_power_tendsto_0: 
   assumes "n > 0"
   shows   "(\<lambda>x. of_real (pbernpoly (Suc n) (real x)) / (of_nat (Suc n) * (s + of_nat x) ^ n)) \<longlonglongrightarrow> 0"
 proof -
   from s have neq: "s + of_nat n \<noteq> 0" for n
     by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
   from bounded_pbernpoly[of "Suc n"] guess c . note c = this
   have "eventually (\<lambda>x. real x + Re s > 0) at_top"
     by real_asymp
   hence "eventually (\<lambda>x. norm (of_real (pbernpoly (Suc n) (real x)) / 
                                     (of_nat (Suc n) * (s + of_nat x) ^ n)) \<le>
                           (c / real (Suc n)) / (real x + Re s) ^ n) at_top"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     case (elim x)
     have "norm (of_real (pbernpoly (Suc n) (real x)) / 
                                     (of_nat (Suc n) * (s + of_nat x) ^ n)) \<le>
             (c / real (Suc n)) / norm (s + of_nat x) ^ n" (is "_ \<le> ?rhs") using c[of x]
       by (auto simp: norm_divide norm_mult norm_power neq field_simps simp del: of_nat_Suc)
     also have "(real x + Re s) \<le> cmod (s + of_nat x)"
       using complex_Re_le_cmod[of "s + of_nat x"] s by (auto simp add: complex_nonpos_Reals_iff)
     hence "?rhs \<le> (c / real (Suc n)) / (real x + Re s) ^ n" using s elim c[of 0] neq[of x]
       by (intro divide_left_mono power_mono mult_pos_pos divide_nonneg_pos zero_less_power) auto
     finally show ?case .
   qed 
   moreover have "(\<lambda>x. (c / real (Suc n)) / (real x + Re s) ^ n) \<longlonglongrightarrow> 0"
     using \<open>n > 0\<close> by real_asymp
   ultimately show ?thesis by (rule Lim_null_comparison)
 qed
 
 lemma convergent_stirling_integral:
   assumes "n > 0"
   shows   "convergent (\<lambda>N. integral {0..real N} 
              (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))" (is "convergent (?f n)")
 proof -
   have "convergent (?f (Suc n))" for n
   proof (induction n)
     case 0
     thus ?case using integral_pbernpoly_1 by (auto intro!: convergentI)
   next
     case (Suc n)
     have "convergent (\<lambda>N. ?f (Suc n) N -
             of_real (pbernpoly (Suc (Suc n)) (real N)) / 
                 (of_nat (Suc (Suc n)) * (s + of_nat N) ^ Suc n) +
             of_real (bernoulli (Suc (Suc n)) / (real (Suc (Suc n)))) / s ^ Suc n)" 
       (is "convergent ?g")
       by (intro convergent_add convergent_diff Suc 
             convergent_const convergentI[OF pbernpoly_over_power_tendsto_0]) simp_all
     also have "?g = (\<lambda>N. of_nat (Suc n) / of_nat (Suc (Suc n)) * ?f (Suc (Suc n)) N)" using s
       by (subst pbernpoly_integral_conv_pbernpoly_integral_Suc) 
          (auto simp: fun_eq_iff field_simps simp del: of_nat_Suc power_Suc)
     also have "convergent \<dots> \<longleftrightarrow> convergent (?f (Suc (Suc n)))"
       by (intro convergent_mult_const_iff) (simp_all del: of_nat_Suc)
     finally show ?case .
   qed
   from this[of "n - 1"] assms show ?thesis by simp
 qed
 
 lemma stirling_integral_conv_stirling_integral_Suc:
   assumes "n > 0"
   shows   "stirling_integral n s =
              of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
              of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
 proof -
   have "(\<lambda>N. of_real (pbernpoly (Suc n) (real N)) / (of_nat (Suc n) * (s + of_nat N) ^ n) -
              of_real (bernoulli (Suc n)) / (real (Suc n) * s ^ n) +
              integral {0..real N} (\<lambda>x. of_nat n / of_nat (Suc n) * 
                 (of_real (pbernpoly (Suc n) x) / (of_real x + s) ^ Suc n)))
            \<longlonglongrightarrow> 0 - of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n) +
                    of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s" (is "?f \<longlonglongrightarrow> _")
     unfolding stirling_integral_def integral_mult_right
     using convergent_stirling_integral[of "Suc n"] assms s
     by (intro tendsto_intros pbernpoly_over_power_tendsto_0)
        (auto simp: convergent_LIMSEQ_iff simp del: of_nat_Suc)
   also have "?this \<longleftrightarrow> (\<lambda>N. integral {0..real N} 
                (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<longlonglongrightarrow>
                of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                  of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)" 
     using eventually_gt_at_top[of "0::nat"] pbernpoly_integral_conv_pbernpoly_integral_Suc[of n] 
           assms unfolding integral_mult_right
     by (intro filterlim_cong refl) (auto elim!: eventually_mono simp del: power_Suc)
   finally show ?thesis unfolding stirling_integral_def[of n] by (rule limI)
 qed
 
 lemma stirling_integral_1_unfold:
   assumes "m > 0"
   shows   "stirling_integral 1 s = stirling_integral m s / of_nat m - 
              (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
 proof -
   have "stirling_integral 1 s = stirling_integral (Suc m) s / of_nat (Suc m) -
           (\<Sum>k=1..<Suc m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))" for m
   proof (induction m)
     case (Suc m)
     let ?C = "(\<Sum>k = 1..<Suc m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
     note Suc.IH
     also have "stirling_integral (Suc m) s / of_nat (Suc m) = 
                  stirling_integral (Suc (Suc m)) s / of_nat (Suc (Suc m)) -
                  of_real (bernoulli (Suc (Suc m))) / 
                    (of_nat (Suc m) * of_nat (Suc (Suc m)) * s ^ Suc m)"
       (is "_ = ?A - ?B") by (subst stirling_integral_conv_stirling_integral_Suc)
                             (simp_all del: of_nat_Suc power_Suc add: divide_simps)
     also have "?A - ?B - ?C = ?A - (?B + ?C)" by (rule diff_diff_eq)
     also have "?B + ?C = (\<Sum>k = 1..<Suc (Suc m). of_real (bernoulli (Suc k)) /
                              (of_nat k * of_nat (Suc k) * s ^ k))" 
       using s by (simp add: divide_simps)
     finally show ?case .
   qed simp_all
   note this[of "m - 1"]
   also from assms have "Suc (m - 1) = m" by simp
   finally show ?thesis .
 qed
   
 lemma ln_Gamma_stirling_complex:
   assumes "m > 0"
   shows   "ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 +
              (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k)) - 
              stirling_integral m s / of_nat m"
 proof -
   have "ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 - stirling_integral 1 s"
     using limI[OF integral_pbernpoly_1] by (simp add: stirling_integral_def algebra_simps)
   also have "stirling_integral 1 s = stirling_integral m s / of_nat m -
                (\<Sum>k = 1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
     using assms by (rule stirling_integral_1_unfold)
   finally show ?thesis by simp
 qed
 
 lemma LIMSEQ_stirling_integral:
   "n > 0 \<Longrightarrow> (\<lambda>x. integral {0..real x} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))
      \<longlonglongrightarrow> stirling_integral n s" unfolding stirling_integral_def 
   using convergent_stirling_integral[of n] by (simp only: convergent_LIMSEQ_iff)
 
 end
 
 lemmas has_integral_of_real = has_integral_linear[OF _ bounded_linear_of_real, unfolded o_def]
 lemmas integral_of_real = integral_linear[OF _ bounded_linear_of_real, unfolded o_def]
 
 lemma integrable_ln_Gamma_aux_real:
   assumes "0 < s"
   shows   "(\<lambda>x. pbernpoly n x / (x + s) ^ n) integrable_on {0..real N}"
 proof -
   have "(\<lambda>x. complex_of_real (pbernpoly n x / (x + s) ^ n)) integrable_on {0..real N}"
     using integrable_ln_Gamma_aux[of "of_real s" n N] assms by simp
   from integrable_linear[OF this bounded_linear_Re] show ?thesis 
     by (simp only: o_def Re_complex_of_real) 
 qed
   
 lemma  
   assumes "x > 0" "n > 0"
   shows   stirling_integral_complex_of_real:
             "stirling_integral n (complex_of_real x) = of_real (stirling_integral n x)"
     and   LIMSEQ_stirling_integral_real:
             "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
             \<longlonglongrightarrow> stirling_integral n x"
     and   stirling_integral_real_convergent:
             "convergent (\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))"
 proof -
   have "(\<lambda>N. integral {0..real N} (\<lambda>t. of_real (pbernpoly n t / (t + x) ^ n)))
            \<longlonglongrightarrow> stirling_integral n (complex_of_real x)"
     using LIMSEQ_stirling_integral[of "complex_of_real x" n] assms by simp
   hence "(\<lambda>N. of_real (integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n)))
            \<longlonglongrightarrow> stirling_integral n (complex_of_real x)"
     using integrable_ln_Gamma_aux_real[OF assms(1), of n] 
     by (subst (asm) integral_of_real) simp
   from tendsto_Re[OF this] 
     have "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
            \<longlonglongrightarrow> Re (stirling_integral n (complex_of_real x))" by simp
   thus "convergent (\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))"
     by (rule convergentI)
   thus "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
           \<longlonglongrightarrow> stirling_integral n x" unfolding stirling_integral_def
     by (simp add: convergent_LIMSEQ_iff)
   from tendsto_of_real[OF this, where 'a = complex] 
        integrable_ln_Gamma_aux_real[OF assms(1), of n]
     have "(\<lambda>xa. integral {0..real xa} 
                     (\<lambda>xa. complex_of_real (pbernpoly n xa) / (complex_of_real xa + x) ^ n))
              \<longlonglongrightarrow> complex_of_real (stirling_integral n x)"
     by (subst (asm) integral_of_real [symmetric]) simp_all
   from LIMSEQ_unique[OF this LIMSEQ_stirling_integral[of "complex_of_real x" n]] assms
     show "stirling_integral n (complex_of_real x) = of_real (stirling_integral n x)" by simp
 qed
 
 lemma ln_Gamma_stirling_real:
   assumes "x > (0 :: real)" "m > (0::nat)"
   shows   "ln_Gamma x = (x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
               (\<Sum>k = 1..<m. bernoulli (Suc k) / (of_nat k * of_nat (Suc k) * x ^ k)) -
               stirling_integral m x / of_nat m"
 proof -
   from assms have "complex_of_real (ln_Gamma x) = ln_Gamma (complex_of_real x)"
     by (simp add: ln_Gamma_complex_of_real)
   also have "ln_Gamma (complex_of_real x) = complex_of_real (
                 (x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
                 (\<Sum>k = 1..<m. bernoulli (Suc k) / (of_nat k * of_nat (Suc k) * x ^ k)) -
                 stirling_integral m x / of_nat m)" using assms
     by (subst ln_Gamma_stirling_complex[of _ m])
        (simp_all add: Ln_of_real stirling_integral_complex_of_real)
   finally show ?thesis by (subst (asm) of_real_eq_iff)
 qed
 
 
 lemma stirling_integral_bound_aux:
   assumes n: "n > (1::nat)"
   obtains c where "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral n s) \<le>  c / Re s ^ (n - 1)"
 proof -
   obtain c where c: "norm (pbernpoly n x) \<le> c" for x by (rule bounded_pbernpoly[of n]) blast
   have c': "pbernpoly n x \<le> c" for x using c[of x] by (simp add: abs_real_def split: if_splits)
   from c[of 0] have c_nonneg: "c \<ge> 0" by simp
   have "norm (stirling_integral n s) \<le> c / (real n - 1) / Re s ^ (n - 1)" if s: "Re s > 0" for s
   proof (rule Lim_norm_ubound[OF _ LIMSEQ_stirling_integral])
     have pos: "x + norm s > 0" if "x \<ge> 0" for x using s that by (intro add_nonneg_pos) auto
     have nz: "of_real x + s \<noteq> 0" if "x \<ge> 0" for x using s that by (auto simp: complex_eq_iff)
     let ?bound = "\<lambda>N. c / (Re s ^ (n - 1) * (real n - 1)) - 
                         c / ((real N + Re s) ^ (n - 1) * (real n - 1))"
     show "eventually (\<lambda>N. norm (integral {0..real N} 
               (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> 
             c / (real n - 1) / Re s ^ (n - 1)) at_top"
       using eventually_gt_at_top[of "0::nat"]
     proof eventually_elim
       case (elim N)
       let ?F = "\<lambda>x. -c / ((x + Re s) ^ (n - 1) * (real n - 1))"
       from n s have "((\<lambda>x. c / (x + Re s) ^ n) has_integral (?F (real N) - ?F 0)) {0..real N}"
         by (intro fundamental_theorem_of_calculus)
            (auto intro!: derivative_eq_intros simp: divide_simps power_diff add_eq_0_iff2
                    has_field_derivative_iff_has_vector_derivative [symmetric])      
       also have "?F (real N) - ?F 0 = ?bound N" by simp
       finally have *: "((\<lambda>x. c / (x + Re s) ^ n) has_integral ?bound N) {0..real N}" .
       have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
               integral {0..real N} (\<lambda>x. c / (x + Re s) ^ n)"
       proof (intro integral_norm_bound_integral integrable_ln_Gamma_aux s ballI)
         fix x assume x: "x \<in> {0..real N}"
         have "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> c / norm (of_real x + s) ^ n"
           unfolding norm_divide norm_power using c by (intro divide_right_mono) simp_all
         also have "\<dots> \<le> c / (x + Re s) ^ n" 
           using x c c_nonneg s nz[of x] complex_Re_le_cmod[of "of_real x + s"]
           by (intro divide_left_mono power_mono mult_pos_pos zero_less_power add_nonneg_pos) auto
         finally show "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> \<dots>" .
       qed (insert n s * pos nz c, auto simp: complex_nonpos_Reals_iff)
       also have "\<dots> = ?bound N" using * by (simp add: has_integral_iff)
       also have "\<dots> \<le> c / (Re s ^ (n - 1) * (real n - 1))" using c_nonneg elim s n by simp
       also have "\<dots> = c / (real n - 1) / (Re s ^ (n - 1))" by simp
       finally show "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) /
                       (of_real x + s) ^ n)) \<le> c / (real n - 1) / Re s ^ (n - 1)" .
     qed
   qed (insert s n, simp_all add: complex_nonpos_Reals_iff)
   thus ?thesis by (rule that)
 qed
 
 lemma stirling_integral_bound_aux_integral1:
   fixes a b c :: real and n :: nat
   assumes "a \<ge> 0" "b > 0" "c \<ge> 0" "n > 1" "l < a - b" "r > a + b"
   shows "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral
            2*c*(n / (n - 1))/b^(n-1) - c/(n-1) * (1/(a-l)^(n-1) + 1/(r-a)^(n-1))) {l..r}"
 proof -
   define x1 x2 where "x1 = a - b" and "x2 = a + b"
   define F1 where "F1 = (\<lambda>x::real. c / (a - x) ^ (n - 1) / (n - 1))"
   define F3 where "F3 = (\<lambda>x::real. -c / (x - a) ^ (n - 1) / (n - 1))"
   have deriv: "(F1 has_vector_derivative (c / (a - x) ^ n)) (at x within A)"
               "(F3 has_vector_derivative (c / (x - a) ^ n)) (at x within A)"
     if "x \<noteq> a" for x :: real and A
     unfolding F1_def F3_def using assms that
     by (auto intro!: derivative_eq_intros simp: divide_simps power_diff add_eq_0_iff2
              simp flip: has_field_derivative_iff_has_vector_derivative)
 
   from assms have "((\<lambda>x. c / (a - x) ^ n) has_integral (F1 x1 - F1 l)) {l..x1}"
     by (intro fundamental_theorem_of_calculus deriv) (auto simp: x1_def max_def split: if_splits)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l)) {l..x1}"
     using assms
     by (intro has_integral_spike_finite_eq[of "{l}"]) (auto simp: x1_def max_def split: if_splits)
   finally have I1: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l)) {l..x1}" .
 
   have "((\<lambda>x. c / b ^ n) has_integral (x2 - x1) * c / b ^ n) {x1..x2}"
     using has_integral_const_real[of "c / b ^ n" x1 x2] assms by (simp add: x1_def x2_def)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral ((x2 - x1) * c / b ^ n)) {x1..x2}"
     by (intro has_integral_spike_finite_eq[of "{x1, x2}"])
        (auto simp: x1_def x2_def split: if_splits)
   finally have I2: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral ((x2 - x1) * c / b ^ n)) {x1..x2}" .
 
   from assms have I3: "((\<lambda>x. c / (x - a) ^ n) has_integral (F3 r - F3 x2)) {x2..r}"
     by (intro fundamental_theorem_of_calculus deriv) (auto simp: x2_def min_def split: if_splits)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F3 r - F3 x2)) {x2..r}"
     using assms
     by (intro has_integral_spike_finite_eq[of "{r}"]) (auto simp: x2_def min_def split: if_splits)
   finally have I3: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F3 r - F3 x2)) {x2..r}" .
 
   have "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l) + ((x2 - x1) * c / b ^ n) + (F3 r - F3 x2)) {l..r}"
     using assms
     by (intro has_integral_combine[OF _ _ has_integral_combine[OF _ _ I1 I2] I3])
        (auto simp: x1_def x2_def)
   also have "(F1 x1 - F1 l) + ((x2 - x1) * c / b ^ n) + (F3 r - F3 x2) =
              F1 x1 - F1 l + F3 r - F3 x2 + (x2 - x1) * c / b ^ n"
     by (simp add: algebra_simps)
   also have "x2 - x1 = 2 * b"
     using assms by (simp add: x2_def x1_def min_def max_def)
   also have "2 * b * c / b ^ n = 2 * c / b ^ (n - 1)"
     using assms by (simp add: power_diff field_simps)
   also have "F1 x1 - F1 l + F3 r - F3 x2 =
                c/(n-1) * (2/b^(n-1) - 1/(a-l)^(n-1) - 1/(r-a)^(n-1))"
     using assms by (simp add: x1_def x2_def F1_def F3_def field_simps)
   also have "\<dots> + 2 * c / b ^ (n - 1) =
              2*c*(1 + 1/(n-1))/b^(n-1) - c/(n-1) * (1/(a-l)^(n-1) + 1/(r-a)^(n-1))"
     using assms by (simp add: field_simps)
   also have "1 + 1 / (n - 1) = n / (n - 1)"
     using assms by (simp add: field_simps)
   finally show ?thesis .
 qed
 
 lemma stirling_integral_bound_aux_integral2:
   fixes a b c :: real and n :: nat
   assumes "a \<ge> 0" "b > 0" "c \<ge> 0" "n > 1"
   obtains I where "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral I) {l..r}"
                   "I \<le> 2 * c * (n / (n - 1)) / b ^ (n-1)"
 proof -
   define l' where "l' = min l (a - b - 1)"
   define r' where "r' = max r (a + b + 1)"
 
   define A where "A = 2 * c * (n / (n - 1)) / b ^ (n - 1)"
   define B where "B = c / real (n - 1) * (1 / (a - l') ^ (n - 1) + 1 / (r' - a) ^ (n - 1))"
 
   have has_int: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (A - B)) {l'..r'}"
     using assms unfolding A_def B_def
     by (intro stirling_integral_bound_aux_integral1) (auto simp: l'_def r'_def)
   have "(\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) integrable_on {l..r}"
     by (rule integrable_on_subinterval[OF has_integral_integrable[OF has_int]])
        (auto simp: l'_def r'_def)
   then obtain I where has_int': "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral I) {l..r}"
     by (auto simp: integrable_on_def)
 
   from assms have "I \<le> A - B"
     by (intro has_integral_subset_le[OF _ has_int' has_int]) (auto simp: l'_def r'_def)
   also have "\<dots> \<le> A"
     using assms by (simp add: B_def l'_def r'_def)
   finally show ?thesis using that[of I] has_int' unfolding A_def by blast
 qed
 
 lemma stirling_integral_bound_aux':
   assumes n: "n > (1::nat)" and \<alpha>: "\<alpha> \<in> {0<..<pi}"
   obtains c where "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow>
                      norm (stirling_integral n s) \<le> c / norm s ^ (n - 1)"
 proof -
   obtain c where c: "norm (pbernpoly n x) \<le> c" for x by (rule bounded_pbernpoly[of n]) blast
   have c': "pbernpoly n x \<le> c" for x using c[of x] by (simp add: abs_real_def split: if_splits)
   from c[of 0] have c_nonneg: "c \<ge> 0" by simp
 
   define D where "D = c * Beta (- (real_of_int (- int n) / 2) - 1 / 2) (1 / 2) / 2"
   define C where "C = max D (2*c*(n/(n-1))/sin \<alpha>^(n-1))"
 
   have *: "norm (stirling_integral n s) \<le> C / norm s ^ (n - 1)"
     if s: "s \<in> complex_cone' \<alpha> - {0}" for s :: complex
   proof (rule Lim_norm_ubound[OF _ LIMSEQ_stirling_integral])
-    from s \<alpha> have arg: "\<bar>arg s\<bar> \<le> \<alpha>" by (auto simp: complex_cone_altdef)
+    from s \<alpha> have Arg: "\<bar>Arg s\<bar> \<le> \<alpha>" by (auto simp: complex_cone_altdef)
     have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> s  by auto
     from s have [simp]: "s \<noteq> 0" by auto
 
     show "eventually (\<lambda>N. norm (integral {0..real N}
               (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> 
             C / norm s ^ (n - 1)) at_top"
       using eventually_gt_at_top[of "0::nat"]
     proof eventually_elim
       case (elim N)
       show ?case
       proof (cases "Re s > 0")
         case True
         have int: "((\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) has_integral
                   D * (norm s ^ 2) powr (-n / 2 + 1 / 2)) {0<..}"
           using has_integral_mult_left[OF has_integral_Beta3[of "-n/2" "norm s ^ 2"], of c] assms True
           unfolding D_def by (simp add: algebra_simps)
         hence int': "((\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) has_integral
                   D * (norm s ^ 2) powr (-n / 2 + 1 / 2)) {0..}"
           by (subst has_integral_interior [symmetric]) simp_all
         hence integrable: "(\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) integrable_on {0..}"
           by (simp add: has_integral_iff)
 
         have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
                 integral {0..real N} (\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2))"
         proof (intro integral_norm_bound_integral s ballI integrable_ln_Gamma_aux)
           have [simp]: "{0<..} - {0::real..} = {}" "{0..} - {0<..} = {0::real}"
             by auto
           have "(\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on {0<..}"
             using int by (simp add: has_integral_iff)
           also have "?this \<longleftrightarrow> (\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on {0..}"
             by (intro integrable_spike_set_eq) auto
           finally show "(\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on
                    {0..real N}" by (rule integrable_on_subinterval) auto
         next
           fix x assume x: "x \<in> {0..real N}"
           have nz: "complex_of_real x + s \<noteq> 0"
             using True x by (auto simp: complex_eq_iff)
           have "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> c / norm (of_real x + s) ^ n"
             unfolding norm_divide norm_power using c by (intro divide_right_mono) simp_all
           also have "\<dots> \<le> c / sqrt (x ^ 2 + norm s ^ 2) ^ n"
           proof (intro divide_left_mono mult_pos_pos zero_less_power power_mono)
             show "sqrt (x\<^sup>2 + (cmod s)\<^sup>2) \<le> cmod (complex_of_real x + s)"
               using x True by (simp add: cmod_def algebra_simps power2_eq_square)
           qed (use x True c_nonneg assms nz in \<open>auto simp: add_nonneg_pos\<close>)
           also have "sqrt (x ^ 2 + norm s ^ 2) ^ n = (x ^ 2 + norm s ^ 2) powr (1/2 * n)"
             by (subst powr_powr [symmetric], subst powr_realpow)
                (auto simp: powr_half_sqrt add_nonneg_pos)
           also have "c / \<dots> = c * (x^2 + norm s^2) powr (-n / 2)"
             by (simp add: powr_minus field_simps)
           finally show "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le> \<dots>" .
         qed fact+
         also have "\<dots> \<le> integral {0..} (\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2))"
           using c_nonneg
           by (intro integral_subset_le integrable integrable_on_subinterval[OF integrable]) auto
         also have "\<dots> = D * (norm s ^ 2) powr (-n / 2 + 1 / 2)"
           using int' by (simp add: has_integral_iff)
         also have "(norm s ^ 2) powr (-n / 2 + 1 / 2) = norm s powr (2 * (-n / 2 + 1 / 2))"
           by (subst powr_powr [symmetric]) auto
         also have "\<dots> = norm s powr (-real (n - 1))"
           using assms by (simp add: of_nat_diff)
         also have "D * \<dots> = D / norm s ^ (n - 1)"
           by (auto simp: powr_minus powr_realpow field_simps)
         also have "\<dots> \<le> C / norm s ^ (n - 1)"
           by (intro divide_right_mono) (auto simp: C_def)
         finally show "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> \<dots>" .
 
       next
 
         case False
-        have "cos \<bar>arg s\<bar> = cos (arg s)"
+        have "cos \<bar>Arg s\<bar> = cos (Arg s)"
           by (simp add: abs_if)
-        also have "cos (arg s) = Re (rcis (norm s) (arg s)) / norm s"
+        also have "cos (Arg s) = Re (rcis (norm s) (Arg s)) / norm s"
           by (subst Re_rcis) auto
         also have "\<dots> = Re s / norm s"
-          by (subst rcis_cmod_arg) auto
+          by (subst rcis_cmod_Arg) auto
         also have "\<dots> \<le> cos (pi / 2)"
           using False by (auto simp: field_simps)
-        finally have "\<bar>arg s\<bar> \<ge> pi / 2"
-          using arg \<alpha> by (subst (asm) cos_mono_le_eq) auto
+        finally have "\<bar>Arg s\<bar> \<ge> pi / 2"
+          using Arg \<alpha> by (subst (asm) cos_mono_le_eq) auto
 
         have "sin \<alpha> * norm s = sin (pi - \<alpha>) * norm s"
           by simp
-        also have "\<dots> \<le> sin (pi - \<bar>arg s\<bar>) * norm s"
-          using \<alpha> arg \<open>\<bar>arg s\<bar> \<ge> pi / 2\<close>
+        also have "\<dots> \<le> sin (pi - \<bar>Arg s\<bar>) * norm s"
+          using \<alpha> Arg \<open>\<bar>Arg s\<bar> \<ge> pi / 2\<close>
           by (intro mult_right_mono sin_monotone_2pi_le) auto
-        also have "sin \<bar>arg s\<bar> \<ge> 0"
-          using arg_bounded[of s] by (intro sin_ge_zero) auto
-        hence "sin (pi - \<bar>arg s\<bar>) = \<bar>sin \<bar>arg s\<bar>\<bar>"
+        also have "sin \<bar>Arg s\<bar> \<ge> 0"
+          using Arg_bounded[of s] by (intro sin_ge_zero) auto
+        hence "sin (pi - \<bar>Arg s\<bar>) = \<bar>sin \<bar>Arg s\<bar>\<bar>"
           by simp 
-        also have "\<dots> = \<bar>sin (arg s)\<bar>"
+        also have "\<dots> = \<bar>sin (Arg s)\<bar>"
           by (simp add: abs_if)
-        also have "\<dots> * norm s = \<bar>Im (rcis (norm s) (arg s))\<bar>"
+        also have "\<dots> * norm s = \<bar>Im (rcis (norm s) (Arg s))\<bar>"
           by (simp add: abs_mult)
         also have "\<dots> = \<bar>Im s\<bar>"
-          by (subst rcis_cmod_arg) auto
+          by (subst rcis_cmod_Arg) auto
         finally have abs_Im_ge: "\<bar>Im s\<bar> \<ge> sin \<alpha> * norm s" .
 
         have [simp]: "Im s \<noteq> 0" "s \<noteq> 0"
           using s \<open>s \<notin> \<real>\<^sub>\<le>\<^sub>0\<close> False
           by (auto simp: cmod_def zero_le_mult_iff complex_nonpos_Reals_iff)
         have "sin \<alpha> > 0"
           using assms by (intro sin_gt_zero) auto
   
         obtain I where I: "((\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n) has_integral I) {0..real N}"
                           "I \<le> 2*c*(n/(n-1)) / \<bar>Im s\<bar> ^ (n - 1)"
           using s c_nonneg assms False 
                 stirling_integral_bound_aux_integral2[of "-Re s" "\<bar>Im s\<bar>" c n 0 "real N"] by auto
   
         have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
                 integral {0..real N} (\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n)"
         proof (intro integral_norm_bound_integral integrable_ln_Gamma_aux s ballI)
           show "(\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n) integrable_on {0..real N}"
             using I(1) by (simp add: has_integral_iff)
         next
           fix x assume x: "x \<in> {0..real N}"
           have nz: "complex_of_real x + s \<noteq> 0"
             by (auto simp: complex_eq_iff)
           have "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le>
                   c / norm (complex_of_real x + s) ^ n"
             unfolding norm_divide norm_power using c[of x] by (intro divide_right_mono) simp_all
           also have "\<dots> \<le> c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n"
             using c_nonneg nz abs_Re_le_cmod[of "of_real x + s"] abs_Im_le_cmod[of "of_real x + s"]
             by (intro divide_left_mono power_mono mult_pos_pos zero_less_power)
                (auto simp: less_max_iff_disj)
           finally show "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le> \<dots>" .
         qed (auto simp: complex_nonpos_Reals_iff)
         also have "\<dots> \<le> 2*c*(n/(n-1)) / \<bar>Im s\<bar> ^ (n - 1)"
           using I by (simp add: has_integral_iff)
         also have "\<dots> \<le> 2*c*(n/(n-1)) / (sin \<alpha> * norm s) ^ (n - 1)"
           using \<open>sin \<alpha> > 0\<close> s c_nonneg abs_Im_ge
           by (intro divide_left_mono mult_pos_pos zero_less_power power_mono mult_nonneg_nonneg) auto
         also have "\<dots> = 2*c*(n/(n-1))/sin \<alpha>^(n-1) / norm s ^ (n - 1)"
           by (simp add: field_simps)
         also have "\<dots> \<le> C / norm s ^ (n - 1)"
           by (intro divide_right_mono) (auto simp: C_def)
         finally show ?thesis .
       qed
     qed
   qed (use that assms complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> in auto)
   thus ?thesis by (rule that)
 qed
 
 lemma stirling_integral_bound:
   assumes "n > 0"
   obtains c where 
     "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral n s) \<le> c / Re s ^ n"
 proof -
   let ?f = "\<lambda>s. of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                   of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
   from stirling_integral_bound_aux[of "Suc n"] assms obtain c where 
     c: "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral (Suc n) s) \<le> c / Re s ^ n" by auto
   define c1 where "c1 = real n / real (Suc n) * c"
   define c2 where "c2 = \<bar>bernoulli (Suc n)\<bar> / real (Suc n)"
   have c2_nonneg: "c2 \<ge> 0" by (simp add: c2_def)
   show ?thesis
   proof (rule that)
     fix s :: complex assume s: "Re s > 0"
     hence s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0" by (auto simp: complex_nonpos_Reals_iff)
     have "stirling_integral n s = ?f s" using s' assms 
       by (rule stirling_integral_conv_stirling_integral_Suc)
     also have "norm \<dots> \<le> norm (of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s) +
                            norm (of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n))"
       by (rule norm_triangle_ineq4)
     also have "\<dots> = real n / real (Suc n) * norm (stirling_integral (Suc n) s) +
                       c2 / norm s ^ n" (is "_ = ?A + ?B")
       by (simp add: norm_divide norm_mult norm_power c2_def field_simps del: of_nat_Suc)
     also have "?A \<le> real n / real (Suc n) * (c / Re s ^ n)"
       by (intro mult_left_mono c s) simp_all
     also have "\<dots> = c1 / Re s ^ n" by (simp add: c1_def)
     also have "c2 / norm s ^ n \<le> c2 / Re s ^ n" using s c2_nonneg
       by (intro divide_left_mono power_mono complex_Re_le_cmod mult_pos_pos zero_less_power) auto
     also have "c1 / Re s ^ n + c2 / Re s ^ n = (c1 + c2) / Re s ^ n" 
       using s by (simp add: field_simps)
     finally show "norm (stirling_integral n s) \<le> (c1 + c2) / Re s ^ n" by - simp_all
   qed
 qed
 
 lemma stirling_integral_bound':
   assumes "n > 0" and "\<alpha> \<in> {0<..<pi}"
   obtains c where 
     "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral n s) \<le> c / norm s ^ n"
 proof -
   let ?f = "\<lambda>s. of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                   of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
   from stirling_integral_bound_aux'[of "Suc n"] assms obtain c where 
     c: "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow>
             norm (stirling_integral (Suc n) s) \<le> c / norm s ^ n" by auto
   define c1 where "c1 = real n / real (Suc n) * c"
   define c2 where "c2 = \<bar>bernoulli (Suc n)\<bar> / real (Suc n)"
   have c2_nonneg: "c2 \<ge> 0" by (simp add: c2_def)
   show ?thesis
   proof (rule that)
     fix s :: complex assume s: "s \<in> complex_cone' \<alpha> - {0}"
     have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] assms s by auto
       
     have "stirling_integral n s = ?f s" using s' assms 
       by (intro stirling_integral_conv_stirling_integral_Suc) auto
     also have "norm \<dots> \<le> norm (of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s) +
                            norm (of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n))"
       by (rule norm_triangle_ineq4)
     also have "\<dots> = real n / real (Suc n) * norm (stirling_integral (Suc n) s) +
                       c2 / norm s ^ n" (is "_ = ?A + ?B")
       by (simp add: norm_divide norm_mult norm_power c2_def field_simps del: of_nat_Suc)
     also have "?A \<le> real n / real (Suc n) * (c / norm s ^ n)"
       by (intro mult_left_mono c s) simp_all
     also have "\<dots> = c1 / norm s ^ n" by (simp add: c1_def)
     also have "c1 / norm s ^ n + c2 / norm s ^ n = (c1 + c2) / norm s ^ n" 
       using s by (simp add: divide_simps)
     finally show "norm (stirling_integral n s) \<le> (c1 + c2) / norm s ^ n" by - simp_all
   qed
 qed
 
 
 lemma stirling_integral_holomorphic [holomorphic_intros]:
   assumes m: "m > 0" and "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {}"
   shows   "stirling_integral m holomorphic_on A"  
 proof -
   from assms have [simp]: "z \<notin> \<real>\<^sub>\<le>\<^sub>0" if "z \<in> A" for z
     using that by auto
   let ?f = "\<lambda>s::complex. of_nat m * ((s - 1 / 2) * Ln s - s + of_real (ln (2 * pi) / 2) +
           (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k)) - 
           ln_Gamma s)"
   have "?f holomorphic_on A" using assms
     by (auto intro!: holomorphic_intros simp del: of_nat_Suc elim!: nonpos_Reals_cases)
   also have "?this \<longleftrightarrow> stirling_integral m holomorphic_on A" 
     using assms by (intro holomorphic_cong refl) 
                    (simp_all add: field_simps ln_Gamma_stirling_complex)
   finally show "stirling_integral m holomorphic_on A" .
 qed
 
 lemma stirling_integral_continuous_on_complex [continuous_intros]:
   assumes m: "m > 0" and "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {}"
   shows   "continuous_on A (stirling_integral m :: _ \<Rightarrow> complex)"
   by (intro holomorphic_on_imp_continuous_on stirling_integral_holomorphic assms)
     
 lemma has_field_derivative_stirling_integral_complex:
   fixes x :: complex
   assumes "x \<notin> \<real>\<^sub>\<le>\<^sub>0" "n > 0"
   shows   "(stirling_integral n has_field_derivative deriv (stirling_integral n) x) (at x)"
   using assms
   by (intro holomorphic_derivI[OF stirling_integral_holomorphic, of n  "-\<real>\<^sub>\<le>\<^sub>0"]) auto
 
 
  
 lemma
   assumes n: "n > 0" and "x > 0"
   shows   deriv_stirling_integral_complex_of_real:
             "(deriv ^^ j) (stirling_integral n) (complex_of_real x) =
                complex_of_real ((deriv ^^ j) (stirling_integral n) x)" (is "?lhs x = ?rhs x")
   and     differentiable_stirling_integral_real:
             "(deriv ^^ j) (stirling_integral n) field_differentiable at x" (is ?thesis2)
 proof -
   let ?A = "{s. Re s > 0}"
   let ?f = "\<lambda>j x. (deriv ^^ j) (stirling_integral n) (complex_of_real x)"
   let ?f' = "\<lambda>j x. complex_of_real ((deriv ^^ j) (stirling_integral n) x)"
     
   have [simp]: "open ?A" by (simp add: open_halfspace_Re_gt)      
 
   have "?lhs x = ?rhs x \<and> (deriv ^^ j) (stirling_integral n) field_differentiable at x" 
     if "x > 0" for x using that
   proof (induction j arbitrary: x)
     case 0
     have "((\<lambda>x. Re (stirling_integral n (of_real x))) has_field_derivative 
                   Re (deriv (\<lambda>x. stirling_integral n x) (of_real x))) (at x)" using 0 n
       by (auto intro!: derivative_intros has_vector_derivative_real_field
                  field_differentiable_derivI holomorphic_on_imp_differentiable_at[of _ ?A]
                  stirling_integral_holomorphic simp: complex_nonpos_Reals_iff)
     also have "?this \<longleftrightarrow> (stirling_integral n has_field_derivative 
              Re (deriv (\<lambda>x. stirling_integral n x) (of_real x))) (at x)"
       using eventually_nhds_in_open[of "{0<..}" x] 0 n
       by (intro has_field_derivative_cong_ev refl) 
          (auto elim!: eventually_mono simp: stirling_integral_complex_of_real)
     finally have "stirling_integral n field_differentiable at x"
       by (auto simp: field_differentiable_def)
     with 0 n show ?case by (auto simp: stirling_integral_complex_of_real)
   next
     case (Suc j x)
     note IH = conjunct1[OF Suc.IH] conjunct2[OF Suc.IH]
     have *: "(deriv ^^ Suc j) (stirling_integral n) (complex_of_real x) =
                  of_real ((deriv ^^ Suc j) (stirling_integral n) x)" if x: "x > 0" for x
     proof -
       have "deriv ((deriv ^^ j) (stirling_integral n)) (complex_of_real x) =
               vector_derivative (\<lambda>x. (deriv ^^ j) (stirling_integral n) (of_real x)) (at x)"
         using n x
         by (intro vector_derivative_of_real_right [symmetric] 
                    holomorphic_on_imp_differentiable_at[of _ ?A] holomorphic_higher_deriv
                    stirling_integral_holomorphic) (auto simp: complex_nonpos_Reals_iff)
       also have "\<dots> = vector_derivative (\<lambda>x. of_real ((deriv ^^ j) (stirling_integral n) x)) (at x)"
         using eventually_nhds_in_open[of "{0<..}" x] x
         by (intro vector_derivative_cong_eq) (auto elim!: eventually_mono simp: IH(1))
       also have "\<dots> = of_real (deriv ((deriv ^^ j) (stirling_integral n)) x)"
         by (intro vector_derivative_of_real_left holomorphic_on_imp_differentiable_at[of _ ?A]
               field_differentiable_imp_differentiable IH(2) x)
       finally show ?thesis by simp
     qed
     have "((\<lambda>x. Re ((deriv ^^ Suc j) (stirling_integral n) (of_real x))) has_field_derivative 
              Re (deriv ((deriv ^^ Suc j) (stirling_integral n)) (of_real x))) (at x)"
       using Suc.prems n
       by (intro derivative_intros has_vector_derivative_real_field field_differentiable_derivI
                 holomorphic_on_imp_differentiable_at[of _ ?A] stirling_integral_holomorphic
                 holomorphic_higher_deriv) (auto simp: complex_nonpos_Reals_iff)
     also have "?this \<longleftrightarrow> ((deriv ^^ Suc j) (stirling_integral n) has_field_derivative 
                   Re (deriv ((deriv ^^ Suc j) (stirling_integral n)) (of_real x))) (at x)"  
       using eventually_nhds_in_open[of "{0<..}" x] Suc.prems *
       by (intro has_field_derivative_cong_ev refl) (auto elim!: eventually_mono)
     finally have "(deriv ^^ Suc j) (stirling_integral n) field_differentiable at x"
       by (auto simp: field_differentiable_def)
     with *[OF Suc.prems] show ?case by blast
   qed
   from this[OF assms(2)] show "?lhs x = ?rhs x" ?thesis2 by blast+
 qed
 
 text \<open>
   Unfortunately, asymptotic power series cannot, in general, be differentiated. However, since 
   @{term ln_Gamma} is holomorphic on the entire positive real half-space, we can differentiate 
   its asymptotic expansion after all.
 
   To do this, we use an ad-hoc version of the more general approach outlined in Erdelyi's
   ``Asymptotic Expansions'' for holomorphic functions: We bound the value of the $j$-th derivative 
   of the remainder term at some value $x$ by applying Cauchy's integral formula along a circle 
   centred at $x$ with radius $\frac{1}{2} x$.
 \<close>
 lemma deriv_stirling_integral_real_bound:
   assumes m: "m > 0"
   shows   "(deriv ^^ j) (stirling_integral m) \<in> O(\<lambda>x::real. 1 / x ^ (m + j))"
 proof -
   from stirling_integral_bound[OF m] guess c . note c = this
   have "0 \<le> cmod (stirling_integral m 1)" by simp
   also have "\<dots> \<le> c" using c[of 1] by simp
   finally have c_nonneg: "c \<ge> 0" .
   define B where "B = c * 2 ^ (m + Suc j)"
   define B' where "B' = B * fact j / 2"
 
   have "eventually (\<lambda>x::real. norm ((deriv ^^ j) (stirling_integral m) x) \<le> 
           B' * norm (1 / x ^ (m+ j))) at_top"
     using eventually_gt_at_top[of "0::real"]
   proof eventually_elim
     case (elim x)
     have "s \<notin> \<real>\<^sub>\<le>\<^sub>0" if "s \<in> cball (of_real x) (x/2)" for s :: complex
     proof -
       have "x - Re s \<le> norm (of_real x - s)" using complex_Re_le_cmod[of "of_real x - s"] by simp
       also from that have "\<dots> \<le> x/2" by (simp add: dist_complex_def)
       finally show ?thesis using elim by (auto simp: complex_nonpos_Reals_iff)
     qed
     hence "((\<lambda>u. stirling_integral m u / (u - of_real x) ^ Suc j) has_contour_integral
             complex_of_real (2 * pi) * \<i> / fact j * 
               (deriv ^^ j) (stirling_integral m) (of_real x)) (circlepath (of_real x) (x/2))"
       using m elim
       by (intro Cauchy_has_contour_integral_higher_derivative_circlepath 
                 stirling_integral_continuous_on_complex stirling_integral_holomorphic) auto
     hence "norm (of_real (2 * pi) * \<i> / fact j * (deriv ^^ j) (stirling_integral m) (of_real x)) \<le>
             B / x ^ (m + Suc j) * (2 * pi * (x / 2))"
     proof (rule has_contour_integral_bound_circlepath)
       fix u :: complex assume dist: "norm (u - of_real x) = x / 2"
       have "Re (of_real x - u) \<le> norm (of_real x - u)" by (rule complex_Re_le_cmod)
       also have "\<dots> = x / 2" using dist by (simp add: norm_minus_commute)
       finally have Re_u: "Re u \<ge> x/2" using elim by simp
       have "norm (stirling_integral m u / (u - of_real x) ^ Suc j) \<le> 
               c / Re u ^ m / (x / 2) ^ Suc j" using Re_u elim
         unfolding norm_divide norm_power dist
         by (intro divide_right_mono zero_le_power c) simp_all
       also have "\<dots> \<le> c / (x/2) ^ m / (x / 2) ^ Suc j" using c_nonneg elim Re_u
         by (intro divide_right_mono divide_left_mono power_mono) simp_all
       also have "\<dots> = B / x ^ (m + Suc j)" using elim by (simp add: B_def field_simps power_add)
       finally show "norm (stirling_integral m u / (u - of_real x) ^ Suc j) \<le> B / x ^ (m + Suc j)" .
     qed (insert elim c_nonneg, auto simp: B_def simp del: power_Suc)
     hence "cmod ((deriv ^^ j) (stirling_integral m) (of_real x)) \<le> B' / x ^ (j + m)"
       using elim by (simp add: field_simps norm_divide norm_mult norm_power B'_def)
     with elim m show ?case by (simp_all add: add_ac deriv_stirling_integral_complex_of_real)
   qed
   thus ?thesis by (rule bigoI)
 qed
 
 definition stirling_sum where
   "stirling_sum j m x = 
      (-1) ^ j * (\<Sum>k = 1..<m. (of_real (bernoulli (Suc k)) * pochhammer (of_nat k) j / (of_nat k *
                                  of_nat (Suc k))) * inverse x ^ (k + j))"
   
 definition stirling_sum' where
   "stirling_sum' j m x = 
      (-1) ^ (Suc j) * (\<Sum>k\<le>m. (of_real (bernoulli' k) * 
        pochhammer (of_nat (Suc k)) (j - 1) * inverse x ^ (k + j)))"
 
 lemma stirling_sum_complex_of_real:
   "stirling_sum j m (complex_of_real x) = complex_of_real (stirling_sum j m x)"
   by (simp add: stirling_sum_def pochhammer_of_real [symmetric] del: of_nat_Suc)
 
 lemma stirling_sum'_complex_of_real:
   "stirling_sum' j m (complex_of_real x) = complex_of_real (stirling_sum' j m x)"
   by (simp add: stirling_sum'_def pochhammer_of_real [symmetric] del: of_nat_Suc)
 
 lemma has_field_derivative_stirling_sum_complex [derivative_intros]:
   "Re x > 0 \<Longrightarrow> (stirling_sum j m has_field_derivative stirling_sum (Suc j) m x) (at x)"
     unfolding stirling_sum_def [abs_def] sum_distrib_left
     by (rule DERIV_sum) (auto intro!: derivative_eq_intros simp del: of_nat_Suc 
                               simp: pochhammer_Suc power_diff)
 
 lemma has_field_derivative_stirling_sum_real [derivative_intros]:
   "x > (0::real) \<Longrightarrow> (stirling_sum j m has_field_derivative stirling_sum (Suc j) m x) (at x)"
     unfolding stirling_sum_def [abs_def] sum_distrib_left
     by (rule DERIV_sum) (auto intro!: derivative_eq_intros simp del: of_nat_Suc 
                               simp: pochhammer_Suc power_diff)
 
 lemma has_field_derivative_stirling_sum'_complex [derivative_intros]:
   assumes "j > 0" "Re x > 0"
   shows   "(stirling_sum' j m has_field_derivative stirling_sum' (Suc j) m x) (at x)"
 proof (cases j)
   case (Suc j')
   from assms have [simp]: "x \<noteq> 0" by auto
   define c where "c = (\<lambda>n. (-1) ^ Suc j * complex_of_real (bernoulli' n) * 
                           pochhammer (of_nat (Suc n)) j')"
   define T where "T = (\<lambda>n x. c n * inverse x ^ (j + n))"
   define T' where "T' = (\<lambda>n x. - (of_nat (j + n)) * c n * inverse x ^ (Suc (j + n)))"
   have "((\<lambda>x. \<Sum>k\<le>m. T k x) has_field_derivative (\<Sum>k\<le>m. T' k x)) (at x)" using assms Suc
     by (intro DERIV_sum)
        (auto simp: T_def T'_def intro!: derivative_eq_intros 
              simp: field_simps power_add [symmetric]  simp del: of_nat_Suc power_Suc of_nat_add)
   also have "(\<lambda>x. (\<Sum>k\<le>m. T k x)) = stirling_sum' j m"
     by (simp add: Suc T_def c_def stirling_sum'_def fun_eq_iff add_ac mult.assoc sum_distrib_left)
   also have "(\<Sum>k\<le>m. T' k x) = stirling_sum' (Suc j) m x"
     by (simp add: T'_def c_def Suc stirling_sum'_def sum_distrib_left 
           sum_distrib_right algebra_simps pochhammer_Suc)
   finally show ?thesis .
 qed (insert assms, simp_all)
   
 lemma has_field_derivative_stirling_sum'_real [derivative_intros]:
   assumes "j > 0" "x > (0::real)"
   shows   "(stirling_sum' j m has_field_derivative stirling_sum' (Suc j) m x) (at x)"
 proof (cases j)
   case (Suc j')
   from assms have [simp]: "x \<noteq> 0" by auto
   define c where "c = (\<lambda>n. (-1) ^ Suc j * (bernoulli' n) * pochhammer (of_nat (Suc n)) j')"
   define T where "T = (\<lambda>n x. c n * inverse x ^ (j + n))"
   define T' where "T' = (\<lambda>n x. - (of_nat (j + n)) * c n * inverse x ^ (Suc (j + n)))"
   have "((\<lambda>x. \<Sum>k\<le>m. T k x) has_field_derivative (\<Sum>k\<le>m. T' k x)) (at x)" using assms Suc
     by (intro DERIV_sum)
        (auto simp: T_def T'_def intro!: derivative_eq_intros 
              simp: field_simps power_add [symmetric]  simp del: of_nat_Suc power_Suc of_nat_add)
   also have "(\<lambda>x. (\<Sum>k\<le>m. T k x)) = stirling_sum' j m"
     by (simp add: Suc T_def c_def stirling_sum'_def fun_eq_iff add_ac mult.assoc sum_distrib_left)
   also have "(\<Sum>k\<le>m. T' k x) = stirling_sum' (Suc j) m x"
     by (simp add: T'_def c_def Suc stirling_sum'_def sum_distrib_left 
           sum_distrib_right algebra_simps pochhammer_Suc)
   finally show ?thesis .
 qed (insert assms, simp_all)
 
 lemma higher_deriv_stirling_sum_complex:
   "Re x > 0 \<Longrightarrow> (deriv ^^ i) (stirling_sum j m) x = stirling_sum (i + j) m x"
 proof (induction i arbitrary: x)
   case (Suc i)
   have "deriv ((deriv ^^ i) (stirling_sum j m)) x = deriv (stirling_sum (i + j) m) x"
     using eventually_nhds_in_open[of "{x. Re x > 0}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: open_halfspace_Re_gt Suc.IH)
   also from Suc.prems have "\<dots> = stirling_sum (Suc (i + j)) m x"
     by (intro DERIV_imp_deriv has_field_derivative_stirling_sum_complex)
   finally show ?case by simp
 qed simp_all
   
 
 definition Polygamma_approx :: "nat \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a :: {real_normed_field, ln}" where
   "Polygamma_approx j m = 
      (deriv ^^ j) (\<lambda>x. (x - 1 / 2) * ln x - x + of_real (ln (2 * pi)) / 2 + stirling_sum 0 m x)"
   
 lemma Polygamma_approx_Suc: "Polygamma_approx (Suc j) m = deriv (Polygamma_approx j m)"
   by (simp add: Polygamma_approx_def)  
 
 lemma Polygamma_approx_0: 
   "Polygamma_approx 0 m x = (x - 1/2) * ln x - x + of_real (ln (2*pi)) / 2 + stirling_sum 0 m x"
   by (simp add: Polygamma_approx_def)
     
 lemma Polygamma_approx_1_complex: 
   "Re x > 0 \<Longrightarrow> 
      Polygamma_approx (Suc 0) m x = ln x - 1 / (2*x) + stirling_sum (Suc 0) m x"
   unfolding Polygamma_approx_Suc Polygamma_approx_0
   by (intro DERIV_imp_deriv) 
      (auto intro!: derivative_eq_intros elim!: nonpos_Reals_cases simp: field_simps)
      
 lemma Polygamma_approx_1_real: 
   "x > (0 :: real) \<Longrightarrow> 
      Polygamma_approx (Suc 0) m x = ln x - 1 / (2*x) + stirling_sum (Suc 0) m x"
   unfolding Polygamma_approx_Suc Polygamma_approx_0
   by (intro DERIV_imp_deriv) 
      (auto intro!: derivative_eq_intros elim!: nonpos_Reals_cases simp: field_simps)
  
 lemma stirling_sum_2_conv_stirling_sum'_1:
   fixes x :: "'a :: {real_div_algebra, field_char_0}"
   assumes "m > 0" "x \<noteq> 0"
   shows   "stirling_sum' 1 m x = 1 / x + 1 / (2 * x^2) + stirling_sum 2 m x"
 proof -
   have pochhammer_2: "pochhammer (of_nat k) 2 = of_nat k * of_nat (Suc k)" for k 
     by (simp add: pochhammer_Suc eval_nat_numeral add_ac)
   have "stirling_sum 2 m x = 
           (\<Sum>k = Suc 0..<m. of_real (bernoulli' (Suc k)) * inverse x ^ Suc (Suc k))"
     unfolding stirling_sum_def pochhammer_2 power2_minus power_one mult_1_left
     by (intro sum.cong refl)
        (simp_all add: stirling_sum_def pochhammer_2 power2_eq_square divide_simps bernoulli'_def
                  del: of_nat_Suc power_Suc)
   also have "1 / (2 * x^2) + \<dots> = 
                (\<Sum>k=0..<m. of_real (bernoulli' (Suc k)) * inverse x ^ Suc (Suc k))" using assms
     by (subst (2) sum.atLeast_Suc_lessThan) (simp_all add: power2_eq_square field_simps)
   also have "1 / x + \<dots> = (\<Sum>k=0..<Suc m. of_real (bernoulli' k) * inverse x ^ Suc k)"
     by (subst sum.atLeast0_lessThan_Suc_shift) (simp_all add: bernoulli'_def divide_simps)
   also have "\<dots> = (\<Sum>k\<le>m. of_real (bernoulli' k) * inverse x ^ Suc k)"
     by (intro sum.cong) auto
   also have "\<dots> = stirling_sum' 1 m x" by (simp add: stirling_sum'_def)
   finally show ?thesis by (simp add: add_ac)
 qed
 
 lemma Polygamma_approx_2_real: 
   assumes "x > (0::real)" "m > 0"
   shows   "Polygamma_approx (Suc (Suc 0)) m x = stirling_sum' 1 m x"
 proof -
   have "Polygamma_approx (Suc (Suc 0)) m x = deriv (Polygamma_approx (Suc 0) m) x" 
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (\<lambda>x. ln x - 1 / (2*x) + stirling_sum (Suc 0) m x) x"
     using eventually_nhds_in_open[of "{0<..}" x] assms
     by (intro deriv_cong_ev) (auto elim!: eventually_mono simp: Polygamma_approx_1_real)
   also have "\<dots> = 1 / x + 1 / (2*x^2) + stirling_sum (Suc (Suc 0)) m x" using assms
     by (intro DERIV_imp_deriv) (auto intro!: derivative_eq_intros 
            elim!: nonpos_Reals_cases simp: field_simps power2_eq_square)
   also have "\<dots> = stirling_sum' 1 m x" using stirling_sum_2_conv_stirling_sum'_1[of m x] assms
     by (simp add: eval_nat_numeral)
   finally show ?thesis .
 qed
   
 lemma Polygamma_approx_2_complex: 
   assumes "Re x > 0" "m > 0"
   shows   "Polygamma_approx (Suc (Suc 0)) m x = stirling_sum' 1 m x"
 proof -
   have "Polygamma_approx (Suc (Suc 0)) m x = deriv (Polygamma_approx (Suc 0) m) x" 
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (\<lambda>x. ln x - 1 / (2*x) + stirling_sum (Suc 0) m x) x"
     using eventually_nhds_in_open[of "{s. Re s > 0}" x] assms
     by (intro deriv_cong_ev)
        (auto simp: open_halfspace_Re_gt elim!: eventually_mono simp: Polygamma_approx_1_complex)
   also have "\<dots> = 1 / x + 1 / (2*x^2) + stirling_sum (Suc (Suc 0)) m x" using assms
     by (intro DERIV_imp_deriv) (auto intro!: derivative_eq_intros 
            elim!: nonpos_Reals_cases simp: field_simps power2_eq_square)
   also have "\<dots> = stirling_sum' 1 m x" using stirling_sum_2_conv_stirling_sum'_1[of m x] assms
       by (subst stirling_sum_2_conv_stirling_sum'_1) (auto simp: eval_nat_numeral)
   finally show ?thesis .
 qed
   
 lemma Polygamma_approx_ge_2_real: 
   assumes "x > (0::real)" "m > 0"
   shows   "Polygamma_approx (Suc (Suc j)) m x = stirling_sum' (Suc j) m x"
 using assms(1)
 proof (induction j arbitrary: x)
   case (0 x)
   with assms show ?case by (simp add: Polygamma_approx_2_real)
 next
   case (Suc j x)
   have "Polygamma_approx (Suc (Suc (Suc j))) m x = deriv (Polygamma_approx (Suc (Suc j)) m) x"
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (stirling_sum' (Suc j) m) x"
     using eventually_nhds_in_open[of "{0<..}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: Suc.IH)
   also have "\<dots> = stirling_sum' (Suc (Suc j)) m x" using Suc.prems
     by (intro DERIV_imp_deriv derivative_intros) simp_all
   finally show ?case .
 qed
   
 lemma Polygamma_approx_ge_2_complex:
   assumes "Re x > 0" "m > 0"
   shows   "Polygamma_approx (Suc (Suc j)) m x = stirling_sum' (Suc j) m x"
 using assms(1)
 proof (induction j arbitrary: x)
   case (0 x)
   with assms show ?case by (simp add: Polygamma_approx_2_complex)
 next
   case (Suc j x)
   have "Polygamma_approx (Suc (Suc (Suc j))) m x = deriv (Polygamma_approx (Suc (Suc j)) m) x"
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (stirling_sum' (Suc j) m) x"
     using eventually_nhds_in_open[of "{x. Re x > 0}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: Suc.IH open_halfspace_Re_gt)
   also have "\<dots> = stirling_sum' (Suc (Suc j)) m x" using Suc.prems
     by (intro DERIV_imp_deriv derivative_intros) simp_all
   finally show ?case .
 qed
 
 lemma Polygamma_approx_complex_of_real:
   assumes "x > 0" "m > 0"
   shows   "Polygamma_approx j m (complex_of_real x) = of_real (Polygamma_approx j m x)"
 proof (cases j)
   case 0
   with assms show ?thesis by (simp add: Polygamma_approx_0 Ln_of_real stirling_sum_complex_of_real)
 next
   case [simp]: (Suc j')
   thus ?thesis
   proof (cases j')
     case 0
     with assms show ?thesis 
       by (simp add: Polygamma_approx_1_complex 
                     Polygamma_approx_1_real stirling_sum_complex_of_real Ln_of_real)
   next
     case (Suc j'')
     with assms show ?thesis
       by (simp add: Polygamma_approx_ge_2_complex Polygamma_approx_ge_2_real 
                     stirling_sum'_complex_of_real)
   qed
 qed
   
 lemma higher_deriv_Polygamma_approx [simp]: 
   "(deriv ^^ j) (Polygamma_approx i m) = Polygamma_approx (j + i) m"
   by (simp add: Polygamma_approx_def funpow_add)
   
 lemma stirling_sum_holomorphic [holomorphic_intros]:
   "0 \<notin> A \<Longrightarrow> stirling_sum j m holomorphic_on A"
   unfolding stirling_sum_def by (intro holomorphic_intros) auto
   
 lemma Polygamma_approx_holomorphic [holomorphic_intros]:
   "Polygamma_approx j m holomorphic_on {s. Re s > 0}"
   unfolding Polygamma_approx_def
   by (intro holomorphic_intros) (auto simp: open_halfspace_Re_gt elim!: nonpos_Reals_cases)
   
 lemma higher_deriv_lnGamma_stirling:
   assumes m: "m > 0"
   shows   "(\<lambda>x::real. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x) \<in> O(\<lambda>x. 1 / x ^ (m + j))"
 proof -
   have "eventually (\<lambda>x. \<bar>(deriv ^^ j) ln_Gamma x - Polygamma_approx j m x\<bar> =
                           inverse (real m) * \<bar>(deriv ^^ j) (stirling_integral m) x\<bar>) at_top"
     using eventually_gt_at_top[of "0::real"]
   proof eventually_elim
     case (elim x)
     note x = this
     have "\<forall>\<^sub>F y in nhds (complex_of_real x). y \<in> - \<real>\<^sub>\<le>\<^sub>0"
       using elim by (intro eventually_nhds_in_open) auto
     hence "(deriv ^^ j) (\<lambda>x. ln_Gamma x - Polygamma_approx 0 m x) (complex_of_real x) =
             (deriv ^^ j) (\<lambda>x. (-inverse (of_nat m)) * stirling_integral m x) (complex_of_real x)"
       using x m
       by (intro higher_deriv_cong_ev refl)
          (auto elim!: eventually_mono simp: ln_Gamma_stirling_complex Polygamma_approx_def 
             field_simps open_halfspace_Re_gt stirling_sum_def)
     also have "\<dots> = - inverse (of_nat m) * (deriv ^^ j) (stirling_integral m) (of_real x)" using x m
       by (intro higher_deriv_cmult[of _ "-\<real>\<^sub>\<le>\<^sub>0"] stirling_integral_holomorphic)
          (auto simp: open_halfspace_Re_gt)
     also have "(deriv ^^ j) (\<lambda>x. ln_Gamma x - Polygamma_approx 0 m x) (complex_of_real x) = 
                  (deriv ^^ j) ln_Gamma (of_real x) - (deriv ^^ j) (Polygamma_approx 0 m) (of_real x)"
       using x 
       by (intro higher_deriv_diff[of _ "{s. Re s > 0}"])
          (auto intro!: holomorphic_intros elim!: nonpos_Reals_cases simp: open_halfspace_Re_gt)
     also have "(deriv ^^ j) (Polygamma_approx 0 m) (complex_of_real x) =
                  of_real (Polygamma_approx j m x)" using x m
       by (simp add: Polygamma_approx_complex_of_real)
     also have "norm (- inverse (of_nat m) * (deriv ^^ j) (stirling_integral m) (complex_of_real x)) = 
                  inverse (real m) * \<bar>(deriv ^^ j) (stirling_integral m) x\<bar>"
       using x m by (simp add: norm_mult norm_inverse deriv_stirling_integral_complex_of_real)
     also have "(deriv ^^ j) ln_Gamma (complex_of_real x) = of_real ((deriv ^^ j) ln_Gamma x)" using x
       by (simp add: higher_deriv_ln_Gamma_complex_of_real)
     also have "norm (\<dots> - of_real (Polygamma_approx j m x)) = 
                  \<bar>(deriv ^^ j) ln_Gamma x - Polygamma_approx j m x\<bar>"
       by (simp only: of_real_diff [symmetric] norm_of_real)
     finally show ?case .
   qed
   from bigthetaI_cong[OF this] m
     have "(\<lambda>x::real. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x) \<in> 
              \<Theta>(\<lambda>x. (deriv ^^ j) (stirling_integral m) x)" by simp
   also have "(\<lambda>x::real. (deriv ^^ j) (stirling_integral m) x) \<in> O(\<lambda>x. 1 / x ^ (m + j))" using m
       by (rule deriv_stirling_integral_real_bound)
   finally show ?thesis .
 qed
 
 lemma Polygamma_approx_1_real':
   assumes x: "(x::real) > 0" and m: "m > 0"
   shows   "Polygamma_approx 1 m x = ln x - (\<Sum>k = Suc 0..m. bernoulli' k * inverse x ^ k / real k)"
 proof -
   have "Polygamma_approx 1 m x = ln x - (1 / (2 * x) + 
           (\<Sum>k=Suc 0..<m. bernoulli (Suc k) * inverse x ^ Suc k / real (Suc k)))"
     (is "_ = _ - (_ + ?S)") using x by (simp add: Polygamma_approx_1_real stirling_sum_def)
   also have "?S = (\<Sum>k=Suc 0..<m. bernoulli' (Suc k) * inverse x ^ Suc k / real (Suc k))"
     by (intro sum.cong refl) (simp_all add: bernoulli'_def)
   also have "1 / (2 * x) + \<dots> = 
                (\<Sum>k=0..<m. bernoulli' (Suc k) * inverse x ^ Suc k / real (Suc k))" using m
     by (subst (2) sum.atLeast_Suc_lessThan) (simp_all add: field_simps)
   also have "\<dots> = (\<Sum>k = Suc 0..m. bernoulli' k * inverse x ^ k / real k)" using assms
     by (subst sum.shift_bounds_Suc_ivl [symmetric]) (simp add: atLeastLessThanSuc_atLeastAtMost)
   finally show ?thesis .
 qed
 
 theorem
   assumes m: "m > 0"
   shows   ln_Gamma_real_asymptotics:
             "(\<lambda>x. ln_Gamma x - ((x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
                      (\<Sum>k = 1..<m. bernoulli (Suc k) / (real k * real (Suc k)) / x^k)))
                 \<in> O(\<lambda>x. 1 / x ^ m)" (is ?th1)
     and   Digamma_real_asymptotics:
             "(\<lambda>x. Digamma x - (ln x - (\<Sum>k=1..m. bernoulli' k / real k / x ^ k)))
                 \<in> O(\<lambda>x. 1 / (x ^ Suc m))" (is ?th2)
     and   Polygamma_real_asymptotics: "j > 0 \<Longrightarrow> 
              (\<lambda>x. Polygamma j x - (- 1) ^ Suc j * (\<Sum>k\<le>m. bernoulli' k *
                      pochhammer (real (Suc k)) (j - 1) / x ^ (k + j))) 
                 \<in> O(\<lambda>x. 1 / x ^ (m+j+1))" (is "_ \<Longrightarrow> ?th3")
 proof -
   define G :: "nat \<Rightarrow> real \<Rightarrow> real" where 
     "G = (\<lambda>m. if m = 0 then ln_Gamma else Polygamma (m - 1))"
   have *: "(\<lambda>x. G j x - h x) \<in> O(\<lambda>x. 1 / x ^ (m + j))"
     if "\<And>x::real. x > 0 \<Longrightarrow> Polygamma_approx j m x = h x" for j h
   proof -
     have "(\<lambda>x. G j x - h x) \<in> 
             \<Theta>(\<lambda>x. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x)" (is "_ \<in> \<Theta>(?f)")
       using that
       by (intro bigthetaI_cong) (auto intro: eventually_mono[OF eventually_gt_at_top[of "0::real"]]
             simp del: funpow.simps simp: higher_deriv_ln_Gamma_real G_def)
     also have "?f \<in> O(\<lambda>x::real. 1 / x ^ (m + j))" using m
       by (rule higher_deriv_lnGamma_stirling)
     finally show ?thesis .
   qed  
     
   note [[simproc del: simplify_landau_sum]]
   from *[OF Polygamma_approx_0] assms show ?th1 
     by (simp add: G_def Polygamma_approx_0 stirling_sum_def field_simps)
   from *[OF Polygamma_approx_1_real'] assms show ?th2 by (simp add: G_def field_simps)
       
   assume j: "j > 0"
   from *[OF Polygamma_approx_ge_2_real, of "j - 1"] assms j show ?th3
     by (simp add: G_def stirling_sum'_def power_add power_diff field_simps)
 qed
 
 
 
 
 subsection \<open>Asymptotics of the complex Gamma function\<close>
 
 text \<open>
   The \<open>m\<close>-th order remainder of Stirling's formula for $\log\Gamma$ is $O(s^{-m})$ uniformly over
-  any complex cone $\text{arg}(z) \leq \alpha$, $z\neq 0$ for any angle
+  any complex cone $\text{Arg}(z) \leq \alpha$, $z\neq 0$ for any angle
   $\alpha\in(0, \pi)$. This means that there is bounded by $c z^{-m}$ for some constant $c$ for
   all $z$ in this cone.
 \<close>
 context
   fixes F and \<alpha>
   assumes \<alpha>: "\<alpha> \<in> {0<..<pi}"
   defines "F \<equiv> principal (complex_cone' \<alpha> - {0})"
 begin
 
 lemma stirling_integral_bigo:
   fixes m :: nat
   assumes m: "m > 0"
   shows   "stirling_integral m \<in> O[F](\<lambda>s. 1 / s ^ m)"
 proof -
   obtain c where c: "\<And>s. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral m s) \<le> c / norm s ^ m"
     using stirling_integral_bound'[OF \<open>m > 0\<close> \<alpha>] by blast
   have "0 \<le> norm (stirling_integral m 1 :: complex)"
     by simp
   also have "\<dots> \<le> c"
     using c[of 1] \<alpha> by simp
   finally have "c \<ge> 0" .
 
   have "eventually (\<lambda>s. s \<in> complex_cone' \<alpha> - {0}) F"
     unfolding F_def by (auto simp: eventually_principal)
   hence "eventually (\<lambda>s. norm (stirling_integral m s) \<le>
                      c * norm (1 / s ^ m)) F"
     by eventually_elim (use c in \<open>simp add: norm_divide norm_power\<close>)
   thus "stirling_integral m \<in> O[F](\<lambda>s. 1 / s ^ m)"
     by (intro bigoI[of _ c]) auto
 qed
 
 end
 
 text \<open>
   The following is a more explicit statement of this:
 \<close>
 theorem ln_Gamma_complex_asymptotics_explicit:
   fixes m :: nat and \<alpha> :: real
   assumes "m > 0" and "\<alpha> \<in> {0<..<pi}"
   obtains C :: real and R :: "complex \<Rightarrow> complex"
   where "\<forall>s::complex. s \<notin> \<real>\<^sub>\<le>\<^sub>0 \<longrightarrow>
                ln_Gamma s = (s - 1/2) * ln s - s + ln (2 * pi) / 2 +
                             (\<Sum>k=1..<m. bernoulli (k+1) / (k * (k+1) * s ^ k)) - R s"
-    and "\<forall>s. s \<noteq> 0 \<and> \<bar>arg s\<bar> \<le> \<alpha> \<longrightarrow> norm (R s) \<le> C / norm s ^ m"    
+    and "\<forall>s. s \<noteq> 0 \<and> \<bar>Arg s\<bar> \<le> \<alpha> \<longrightarrow> norm (R s) \<le> C / norm s ^ m"    
 proof -
   obtain c where c: "\<And>s. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral m s) \<le> c / norm s ^ m"
     using stirling_integral_bound'[OF assms] by blast
   have "0 \<le> norm (stirling_integral m 1 :: complex)"
     by simp
   also have "\<dots> \<le> c"
     using c[of 1] assms by simp
   finally have "c \<ge> 0" .
   define R where "R = (\<lambda>s::complex. stirling_integral m s / of_nat m)"
   show ?thesis
   proof (rule that)
     from ln_Gamma_stirling_complex[of _ m] assms show
            "\<forall>s::complex. s \<notin> \<real>\<^sub>\<le>\<^sub>0 \<longrightarrow>
                ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 +
                (\<Sum>k=1..<m. bernoulli (k+1) / (k * (k+1) * s ^ k)) - R s"
       by (auto simp add: R_def algebra_simps)
-    show "\<forall>s. s \<noteq> 0 \<and> \<bar>arg s\<bar> \<le> \<alpha> \<longrightarrow> cmod (R s) \<le> c / real m / cmod s ^ m"
+    show "\<forall>s. s \<noteq> 0 \<and> \<bar>Arg s\<bar> \<le> \<alpha> \<longrightarrow> cmod (R s) \<le> c / real m / cmod s ^ m"
     proof (safe, goal_cases)
       case (1 s)
       show ?case
         using 1 c[of s] assms
         by (auto simp: complex_cone_altdef abs_le_iff R_def norm_divide field_simps)
     qed
   qed
 qed
 
 
 text \<open>
   Lastly, we can also derive the asymptotics of $\Gamma$ itself:
   \[\Gamma(z) \sim \sqrt{2\pi / z} \left(\frac{z}{e}\right)^z\]
-  uniformly for $|z|\to\infty$ within the cone $\text{arg}(z) \leq \alpha$ for $\alpha\in(0,\pi)$:
+  uniformly for $|z|\to\infty$ within the cone $\text{Arg}(z) \leq \alpha$ for $\alpha\in(0,\pi)$:
 \<close>
 
 context
   fixes F and \<alpha>
   assumes \<alpha>: "\<alpha> \<in> {0<..<pi}"
   defines "F \<equiv> inf at_infinity (principal (complex_cone' \<alpha>))"
 begin
 
 lemma Gamma_complex_asymp_equiv:
   "Gamma \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2))"
 proof -
   define I :: "complex \<Rightarrow> complex" where "I = stirling_integral 1"
   have "eventually (\<lambda>s. s \<in> complex_cone' \<alpha>) F"
     by (auto simp: eventually_inf_principal F_def)
   moreover have "eventually (\<lambda>s. s \<noteq> 0) F"
     unfolding F_def eventually_inf_principal
     using eventually_not_equal_at_infinity by eventually_elim auto
   ultimately have "eventually (\<lambda>s. Gamma s =
                      sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s)) F"
   proof eventually_elim
     case (elim s)
     from elim have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> by auto
     from elim have [simp]: "s \<noteq> 0" by auto      
     from s' have "Gamma s = exp (ln_Gamma s)"
       unfolding Gamma_complex_altdef using nonpos_Ints_subset_nonpos_Reals by auto
     also from s' have "ln_Gamma s = (s-1/2) * Ln s - s + complex_of_real (ln (2 * pi) / 2) - I s"
       by (subst ln_Gamma_stirling_complex[of _ 1]) (simp_all add: exp_add exp_diff I_def)
     also have "exp \<dots> = exp ((s - 1 / 2) * Ln s) / exp s *
                         exp (complex_of_real (ln (2 * pi) / 2)) / exp (I s)"
       unfolding exp_diff exp_add by (simp add: exp_diff exp_add)
     also have "exp ((s - 1 / 2) * Ln s) = s powr (s - 1 / 2)"
       by (simp add: powr_def)
     also have "exp (complex_of_real (ln (2 * pi) / 2)) = sqrt (2 * pi)"
       by (subst exp_of_real) (auto simp: powr_def simp flip: powr_half_sqrt)
     also have "exp s = exp 1 powr s"
       by (simp add: powr_def)
     also have "s powr (s - 1 / 2) / exp 1 powr s = (s powr s / exp 1 powr s) / s powr (1/2)"
       by (subst powr_diff) auto
     also have *: "Ln (s / exp 1) = Ln s - 1"
       using Ln_divide_of_real[of "exp 1" s] by (simp flip: exp_of_real)
     hence "s powr s / exp 1 powr s = (s / exp 1) powr s"
       unfolding powr_def by (subst *) (auto simp: exp_diff field_simps)
     finally show "Gamma s = sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s)"
       by (simp add: algebra_simps)
   qed
   hence "Gamma \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s))"
     by (rule asymp_equiv_refl_ev)
   also have "\<dots> \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / 1)"
   proof (intro asymp_equiv_intros)
     have "F \<le> principal (complex_cone' \<alpha> - {0})"
       unfolding le_principal F_def eventually_inf_principal
       using eventually_not_equal_at_infinity by eventually_elim auto
     moreover have "I \<in> O[principal (complex_cone' \<alpha> - {0})](\<lambda>s. 1 / s)"
       using stirling_integral_bigo[of \<alpha> 1] \<alpha> unfolding F_def by (simp add: I_def)
     ultimately have "I \<in> O[F](\<lambda>s. 1 / s)"
       by (rule landau_o.big.filter_mono)
     also have "(\<lambda>s. 1 / s) \<in> o[F](\<lambda>s. 1)"
     proof (rule landau_o.smallI)
       fix c :: real
       assume c: "c > 0"
       hence "eventually (\<lambda>z::complex. norm z \<ge> 1 / c) at_infinity"
         by (auto simp: eventually_at_infinity)
       moreover have "eventually (\<lambda>z::complex. z \<noteq> 0) at_infinity"
         by (rule eventually_not_equal_at_infinity)
       ultimately show "eventually (\<lambda>z::complex. norm (1 / z) \<le> c * norm (1 :: complex)) F"
         unfolding F_def eventually_inf_principal
         by eventually_elim (use \<open>c > 0\<close> in \<open>auto simp: norm_divide field_simps\<close>)
     qed
     finally have "I \<in> o[F](\<lambda>s. 1)" .
     from smalloD_tendsto[OF this] have [tendsto_intros]: "(I \<longlongrightarrow> 0) F"
       by simp
     show "(\<lambda>x. exp (I x)) \<sim>[F] (\<lambda>x. 1)"
       by (rule asymp_equivI' tendsto_eq_intros refl | simp)+
   qed
   finally show ?thesis by simp
 qed
 
 end
 
 end