(* -------------------------------------------------------------------------- *)
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)

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 cor_neg_one [simp]:
  shows "cor (-1) = -1"
  by simp

lemma neg_cor_neg_one [simp]:
  shows "- cor (-1) = 1"
  by simp

lemma cmod_cis [simp]:
  assumes "a \<noteq> 0"
  shows "cor (cmod a) * cis (arg a) = a"
  using assms
  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)

lemma cor_mult:
  shows "cor (a * b) = cor a * cor b"
  by (rule of_real_mult)

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 cor_mult real_sqrt_abs2 real_sqrt_mult)

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]:
  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:
  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:
  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_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:
  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 (metis complex_norm_square cor_squared numeral_times_numeral power2_eq_square semiring_norm(11) semiring_norm(13) semiring_normalization_rules(36))

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_mult [simp]:
  shows "cmod (a * b) = cmod a * cmod b"
  by (rule norm_mult)

lemma cmod_divide [simp]:
  shows "cmod (a / b) = cmod a / cmod b"
  by (rule norm_divide)

lemma cmod_cor_divide [simp]:
  shows "cmod (z / cor k) = cmod z / \<bar>k\<bar>"
  by auto

lemma cmod_mult_minus_left_distrib [simp]:
  shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)"
  by (metis bounded_bilinear.diff_right bounded_bilinear_mult cmod_mult)

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_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 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_half [simp]:
  shows "Re (x / 2) = Re x / 2"
  by (rule Re_divide_numeral)

lemma Re_double [simp]:
  shows "Re (2 * x) = 2 * Re x"
  using Re_mult_real[of "2" x]
  by simp

lemma Im_half [simp]:
  shows "Im (z / 2) = Im z / 2"
  by (subst Im_divide_real, auto)

lemma Im_double [simp]:
  shows "Im (2 * z) = 2 * Im z"
  using Im_mult_real[of "2" z]
  by simp

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:
  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:
  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]:
  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]:
  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]:
  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]:
  shows "cis \<phi> + cis (-\<phi>) = 2 * cos \<phi>"
proof-
  have "2 * cos \<phi> = (cis \<phi> + cnj (cis \<phi>))"
    using Re_express_cnj[of "cis \<phi>"]
    by (simp add: field_simps)
  thus ?thesis
    by simp
qed

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>

lemma is_real_arg1:
  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"]
  by auto

lemma is_real_arg2:
  assumes "is_real z"
  shows "arg z = 0 \<or> arg z = pi"
proof (cases "z = 0")
  case True
  thus ?thesis
    by (auto simp add: arg_zero)
next
  case False
  hence "sin (arg z) = 0"
    using assms rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"]
    by auto
  thus ?thesis
    using arg_bounded[of z]
    using sin_0_iff_canon
    by simp
qed

lemma arg_complex_of_real_positive [simp]:
  assumes "k > 0"
  shows "arg (cor k) = 0"
proof-
  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)"]
    by (smt complex.sel(1) mult_nonneg_nonpos norm_ge_zero)
  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"
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)"]
    by (smt complex.sel(1) mult_nonneg_nonneg norm_ge_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)

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)

text \<open>@{term arg} of imaginary numbers\<close>

lemma is_imag_arg1:
  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"]
  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"
proof-
  have "cos (arg z) = 0"
    using assms
    by (metis Re_rcis no_zero_divisors norm_eq_zero rcis_cmod_arg)
  thus ?thesis
    using arg_bounded[of z]
    using cos_0_iff_canon[of "arg z"]
    by simp
qed

lemma arg_complex_of_real_times_i_positive [simp]:
  assumes "k > 0"
  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)"]
    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
    by force
qed

lemma arg_complex_of_real_times_i_negative [simp]:
  assumes "k < 0"
  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)"]
    by (smt complex.sel(2) mult_nonneg_nonneg norm_ge_zero)
  thus ?thesis
    using assms is_imag_arg2[of "cor k * \<i>"]
    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)

lemma arg_minus_pi2_iff:
  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_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
  by simp

lemma arg_cis:
  shows "arg (cis \<phi>) = \<downharpoonright>\<phi>\<downharpoonleft>"
proof (rule canon_ang_eqI[symmetric])
  show "- pi < arg (cis \<phi>) \<and> arg (cis \<phi>) \<le> pi"
    using arg_bounded
    by simp
next
  show "\<exists> k::int. arg (cis \<phi>) - \<phi> = 2*k*pi"
  proof-
    have "cis (arg (cis \<phi>)) = cis \<phi>"
      using cis_arg[of "cis \<phi>"]
      by auto
    thus ?thesis
      using cis_eq
      by auto
  qed
qed

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)

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)

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)"
proof-
  have "z1 * z2 = cor (cmod z1) * cor (cmod z2) * cis (arg z1) * cis (arg z2)"
    using rcis_cmod_arg[of z1, symmetric]  rcis_cmod_arg[of z2, symmetric]
    unfolding rcis_def
    by algebra
  hence "z1 * z2 = cor (cmod (z1 * z2)) * cis (arg z1 + arg z2)"
    using cis_mult[of "arg z1" "arg z2"]
    by auto
  hence "cor (cmod (z1 * z2)) * cis (arg z1 + arg z2) =  cor (cmod (z1 * z2)) * cis (arg (z1 * z2))"
    using assms
    using rcis_cmod_arg[of "z1*z2"]
    unfolding rcis_def
    by auto
  thus ?thesis
    using mult_cancel_left[of "cor (cmod (z1 * z2))" "cis (arg z1 + arg z2)" "cis (arg (z1 * z2))"]
    using assms
    by auto
qed

lemma arg_mult_2kpi:
  assumes "z1 * z2 \<noteq> 0"
  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)"
    by (rule cis_arg_mult[OF assms])
  thus ?thesis
    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>"
proof-
  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>"
    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"
proof (cases "z = 0")
  case True
  thus ?thesis
    by (auto simp add: arg_zero)
next
  case False
  thus ?thesis
    using assms
    using arg_mult[of "cor k" z]
    by (auto simp add: canon_ang_arg)
qed

lemma arg_mult_real_negative [simp]:
  assumes "k < 0"
  shows "arg (cor k * z) = arg (-z)"
proof (cases "z = 0")
  case True
  thus ?thesis
    by (auto simp add: arg_zero)
next
  case False
  thus ?thesis
    using assms
    using arg_mult[of "cor k" z]
    using arg_mult[of "-1" z]
    using arg_complex_of_real_negative[of k] arg_complex_of_real_negative[of "-1"]
    by auto
qed

lemma arg_div_real_positive [simp]:
  assumes "k > 0"
  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)"
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"
proof-
  from assms have "\<downharpoonright>arg z + arg z1\<downharpoonleft> = \<downharpoonright>arg z + arg z2\<downharpoonleft>"
    by (simp add: arg_mult)
  then obtain x::int where *: "arg z1 - arg z2 = 2 * x * pi"
    using canon_ang_eqE[of "arg z + arg z1" "arg z + arg z2"]
    by auto
  moreover
  have "arg z1 - arg z2 < 2*pi" "arg z1 - arg z2 > -2*pi"
    using arg_bounded[of z1] arg_bounded[of z2]
    by auto
  ultimately
  have "-1 < x" "x < 1"
    using divide_strict_right_mono[of "-pi" "pi * x" pi]
    by auto
  hence "x = 0"
    by auto
  thus ?thesis
    using *
    by simp
qed

text \<open>Argument of conjugate\<close>

lemma arg_cnj_pi:
  assumes "arg z = pi"
  shows "arg (cnj z) = pi"
proof-
  have "cos (arg (cnj z)) = cos (arg z)"
    using rcis_cmod_arg[of z, symmetric] Re_rcis[of "cmod z" "arg z"]
    using rcis_cmod_arg[of "cnj z", symmetric] Re_rcis[of "cmod (cnj z)" "arg (cnj z)"]
    by auto
  hence "arg (cnj z) = arg z \<or> arg(cnj z) = -arg z"
    using arg_bounded[of z] arg_bounded[of "cnj z"]
    by (metis arccos_cos arccos_cos2 less_eq_real_def linorder_le_cases minus_minus)
  thus ?thesis
    using assms
    using arg_bounded[of "cnj z"]
    by auto
qed

lemma arg_cnj_not_pi:
  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 "cos (arg (cnj z)) = cos (arg z)"
    using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"]
    using rcis_cmod_arg[of "cnj z"] Re_rcis[of "cmod (cnj z)" "arg (cnj z)"]
    by auto
  hence "arg (cnj z) = arg z \<or> arg(cnj z) = -arg z"
    using arg_bounded[of z] arg_bounded[of "cnj z"]
    by (metis arccos_cos arccos_cos2 less_eq_real_def linorder_le_cases minus_minus)
  moreover
  have "sin (arg (cnj z)) = -sin (arg z)"
    using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"]
    using rcis_cmod_arg[of "cnj z"] Im_rcis[of "cmod (cnj z)" "arg (cnj z)"]
    using calculation eq_cnj_iff_real is_real_arg2
    by force
  hence "arg (cnj z) \<noteq> arg z"
    using sin_0_iff_canon[of "arg (cnj z)"] arg_bounded False assms
    by auto
  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"
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"
  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)

lemma arg_inv:
  assumes "z \<noteq> 0"
  shows "arg (1 / z) = \<downharpoonright>- arg z\<downharpoonleft>"
proof-
  obtain k::int where "arg(1 / z) = - arg z + 2*k*pi"
    using arg_inv_2kpi[of z]
    using assms
    by auto
  hence "\<downharpoonright>arg(1 / z)\<downharpoonleft> = \<downharpoonright>- arg z\<downharpoonleft>"
    using canon_ang_eq
    by(simp add:field_simps)
  thus ?thesis
    using canon_ang_arg[of "1 / z"]
    by auto
qed

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"
proof-
  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"
    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>"
proof-
  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)"
    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>"
  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")
  case True
  thus ?thesis
    using assms
    by (simp add: arg_uminus)
next
  case False
  show ?thesis
  proof (cases "arg z > 0")
    case True
    thus ?thesis
      using assms
      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 assms
      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)"
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"
    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]
    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>
    by auto
qed

subsubsection \<open>Complex square root\<close>

definition
  "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)

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"
    using assms
    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"]
    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>
    by simp

  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)"
      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)"
      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)"
    hence "s = ccsqrt z"
      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)"
    hence "s = - ccsqrt z"
      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"]
    by auto
  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)"
    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 (simp add: rcis_mult real_sqrt_mult arg_mult)
       (auto simp add: rcis_def)
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"
      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"
      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")
  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]
    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"]
    by simp
  thus ?thesis
    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"
  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)

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:
  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


section "Topological Ordering of Graphs"
theory Graph_Topological_Ordering
imports
  Refine_Imperative_HOL.Sepref_Misc
  "List-Index.List_Index"
begin

subsection \<open>List-Before Relation\<close>
text \<open>
  Two elements of a list are in relation if the first element comes (strictly) before
  the second element.
\<close>
definition "list_before_rel l \<equiv> { (a,b). \<exists>l1 l2 l3. l=l1@a#l2@b#l3 }"

text \<open>list-before only relates elements of the list\<close>
lemma list_before_rel_on_elems: "list_before_rel l \<subseteq> set l \<times> set l"
  unfolding list_before_rel_def by auto

text \<open>Irreflexivity of list-before is equivalent to the elements of the list being disjoint.\<close>
lemma list_before_irrefl_eq_distinct: "irrefl (list_before_rel l) \<longleftrightarrow> distinct l"
  using not_distinct_decomp[of l]
  by (auto simp: irrefl_def list_before_rel_def)

text \<open>Alternative characterization via indexes\<close>
lemma list_before_rel_alt: "list_before_rel l = { (l!i, l!j) | i j. i<j \<and> j<length l }"
  unfolding list_before_rel_def
  apply (rule; clarsimp)
  subgoal for a b l1 l2 l3
    apply (rule exI[of _ "length l1"]; simp)
    apply (rule exI[of _ "length l1 + Suc (length l2)"]; auto simp: nth_append)
    done
  subgoal for i j
    apply (rule exI[of _ "take i l"])
    apply (rule exI[of _ "drop (Suc i) (take j l)"])
    apply (rule exI[of _ "drop (Suc j) l"])
    by (simp add: Cons_nth_drop_Suc drop_take_drop_unsplit)
  done

text \<open>list-before is a strict ordering, i.e., it is transitive and asymmetric.\<close>
lemma list_before_trans[trans]: "distinct l \<Longrightarrow> trans (list_before_rel l)"
  by (clarsimp simp: trans_def list_before_rel_alt) (metis index_nth_id less_trans)

lemma list_before_asym: "distinct l \<Longrightarrow> asym (list_before_rel l)"
  by (meson asymI irrefl_def list_before_irrefl_eq_distinct list_before_trans transE)

text \<open>Structural properties on the list\<close>
lemma list_before_rel_empty[simp]: "list_before_rel [] = {}"
  unfolding list_before_rel_def by auto

lemma list_before_rel_cons: "list_before_rel (x#l) = ({x}\<times>set l) \<union> list_before_rel l"
  apply (intro equalityI subsetI; simp add: split_paired_all)
  subgoal for a b proof -
    assume "(a,b) \<in> list_before_rel (x # l)"
    then obtain i j where IDX_BOUND: "i<j" "j<Suc (length l)" and [simp]: "a=(x#l)!i" "b=(x#l)!j"
      unfolding list_before_rel_alt by auto

    {
      assume "i=0"
      hence "x=a" "b\<in>set l" using IDX_BOUND
        by (auto simp: nth_Cons split: nat.splits)
    } moreover {
      assume "i\<noteq>0"
      with IDX_BOUND have "a=l!(i-1)" "b=l!(j-1)" "i-1 < j-1" "j-1 < length l"
        by auto
      hence "(a, b) \<in> list_before_rel l" unfolding list_before_rel_alt by blast
    } ultimately show ?thesis by blast
  qed
  subgoal premises prems for a b
  proof -
    {
      assume [simp]: "a=x" and "b\<in>set l"
      then obtain j where "b = l!j" "j<length l" by (auto simp: in_set_conv_nth)
      hence "a=(x#l)!0" "b = (x#l)!Suc j" "0 < Suc j" "Suc j < length (x#l)" by auto
      hence ?thesis unfolding list_before_rel_alt by blast
    } moreover {
      assume "(a, b) \<in> list_before_rel l"
      hence ?thesis unfolding list_before_rel_alt
        by clarsimp (metis Suc_mono nth_Cons_Suc)
    } ultimately show ?thesis using prems by blast
  qed
  done

subsection \<open>Topological Ordering\<close>

text \<open>
  A topological ordering of a graph (binary relation) is an enumeration of its
  nodes, such that for any two nodes \<open>x\<close>,\<open>y\<close> with \<open>x\<close> being enumerated earlier than \<open>y\<close>,
  there is no path from \<open>y\<close> to \<open>x\<close> in the graph.

  We define the predicate \<open>is_top_sorted\<close> to capture the sortedness criterion, but
  not the completeness criterion, i.e., the list needs not contain all
  nodes of the graph.
\<close>

definition "is_top_sorted R l \<equiv> list_before_rel l \<inter> (R\<^sup>*)\<inverse> = {}"
lemma is_top_sorted_alt: "is_top_sorted R l \<longleftrightarrow> (\<forall>x y. (x,y)\<in>list_before_rel l \<longrightarrow> (y,x)\<notin>R\<^sup>*)"
  unfolding is_top_sorted_def by auto

lemma is_top_sorted_empty_rel[simp]: "is_top_sorted {} l \<longleftrightarrow> distinct l"
  by (auto simp: is_top_sorted_def list_before_irrefl_eq_distinct[symmetric] irrefl_def)

lemma is_top_sorted_empty_list[simp]: "is_top_sorted R []"
  by (auto simp: is_top_sorted_def)

text \<open>A topological sorted list must be distinct\<close>
lemma is_top_sorted_distinct:
  assumes "is_top_sorted R l"
  shows "distinct l"
proof (rule ccontr)
  assume "\<not>distinct l"
  with list_before_irrefl_eq_distinct[of l] obtain x where "(x,x)\<in>(list_before_rel l)"
    by (auto simp: irrefl_def)
  with assms show False unfolding is_top_sorted_def by auto
qed

lemma is_top_sorted_cons: "is_top_sorted R (x#l) \<longleftrightarrow> ({x}\<times>set l \<inter> (R\<^sup>*)\<inverse> = {}) \<and> is_top_sorted R l"
  unfolding is_top_sorted_def
  by (auto simp: list_before_rel_cons)

lemma is_top_sorted_append: "is_top_sorted R (l1@l2)
  \<longleftrightarrow> (set l1\<times>set l2 \<inter> (R\<^sup>*)\<inverse> = {}) \<and> is_top_sorted R l1 \<and> is_top_sorted R l2"
  by (induction l1) (auto simp: is_top_sorted_cons)

lemma is_top_sorted_remove_elem: "is_top_sorted R (l1@x#l2) \<Longrightarrow> is_top_sorted R (l1@l2)"
  by (auto simp: is_top_sorted_cons is_top_sorted_append)

text \<open>Removing edges from the graph preserves topological sorting\<close>
lemma is_top_sorted_antimono:
  assumes "R\<subseteq>R'"
  assumes "is_top_sorted R' l"
  shows "is_top_sorted R l"
  using assms
  unfolding is_top_sorted_alt
  by (auto dest: rtrancl_mono_mp)

text \<open>
  Adding a node to the graph, which has no incoming edges preserves topological ordering.
\<close>
lemma is_top_sorted_isolated_constraint:
  assumes "R' \<subseteq> R \<union> {x}\<times>X" "R'\<inter>UNIV\<times>{x} = {}"
  assumes "x\<notin>set l"
  assumes "is_top_sorted R l"
  shows "is_top_sorted R' l"
proof -
  {
    fix a b
    assume "(a,b)\<in>R'\<^sup>*" "a\<noteq>x" "b\<noteq>x"
    hence "(a,b)\<in>R\<^sup>*"
    proof (induction rule: converse_rtrancl_induct)
      case base
      then show ?case by simp
    next
      case (step y z)
      with assms(1,2) have "z\<noteq>x" "(y,z)\<in>R" by auto
      with step show ?case by auto
    qed
  } note AUX=this

  show ?thesis
    using assms(3,4) AUX list_before_rel_on_elems
    unfolding is_top_sorted_def by fastforce
qed

end


theory Ex2_2
  imports Main
begin

primrec sum :: "nat list \<Rightarrow> nat"  where
  "sum [] = 0"|
  "sum (x#xs) = x + sum xs"

lemma sum_foldr: "sum xs = foldr (op +) xs 0" by (induct xs, simp_all)

lemma length_foldr : "length xs = foldr (\<lambda>x res . 1 + res) xs 0" by (induct xs, simp_all)

lemma "sum (map (\<lambda>x . x +  3) xs) = foldr (\<lambda> x res . res + x + 3) xs 0" by (induct xs, simp_all)

lemma "foldr g (map f xs) a  = foldr (g o f) xs a" by (induct xs , simp_all)

primrec rev_acc :: "['a list , 'a list] \<Rightarrow> 'a list" where
  "rev_acc [] res = res"|
  "rev_acc (x#xs) res = rev_acc xs (x#res)"

lemma rev_acc_foldl : "rev_acc xs a = foldl (\<lambda> ys x . x # ys) a xs"
proof (induct xs arbitrary : a)
  case Nil
  then show ?case by simp
next
  case (Cons aa xs)
  assume hyp:"\<And> a . rev_acc xs a = foldl (\<lambda>ys x. x # ys) a xs"
  then show ?case by simp
qed

lemma sum_append [simp]: "sum (xs @ ys) = sum xs + sum ys" by (induct xs; simp)

lemma foldr_append : "\<forall>e . f a e = e \<Longrightarrow> \<forall>b c d . f d (f b c) = f (f d b) c \<Longrightarrow>foldr f (xs @ ys) a = f (foldr f xs a) (foldr f ys a)"
proof (induct xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  then show ?case by simp
qed

definition prod :: "nat list \<Rightarrow> nat" where
  "prod ls = fold (op *) ls 1"

declare prod_def [simp]

lemma helper1 :"fold (op *) xs (a::nat) = a * fold (op *) xs 1"
proof (induct xs arbitrary : a)
  case Nil
  then show ?case by simp
next
  case (Cons aa xs)
  assume hyp:"\<And> a . fold op * xs a = a * fold op * xs 1"
  have "a * fold op * (aa # xs) 1 = a * fold op * xs aa" by simp
  also have "\<dots> = a * aa * fold op * xs 1" by (subst hyp, simp)
  finally have "a * fold op * (aa # xs) 1 = a * aa * fold op * xs 1" by assumption
  note tmp=this
  have "fold op * (aa # xs) a =   fold op * xs (aa*a)" by simp
  also have "\<dots> = (aa * a) * fold op * xs 1" by (subst hyp, simp)
  finally  show ?case using tmp by auto
qed

lemma helper2 : "fold (op *) (xs @ ys) (1::nat) = fold (op *) xs 1 * fold (op *) ys 1"
proof (induct xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  assume hyp:"fold op * (xs @ ys) 1 = fold op * xs 1 * fold op * ys 1"
  have "fold op * ((a # xs) @ ys) 1 =  fold op * (a # (xs @ ys)) 1 " by simp
  also have "\<dots> = ( fold (op * ) (xs @ ys) \<circ> (op * a)) 1" by simp
  also have "\<dots> =  fold (op * ) (xs @ ys)  (op * a 1) " by simp
  also have "\<dots> = fold (op * ) (xs @ ys) a" by simp
  also have "\<dots> =a * fold (op * ) (xs @ ys) 1" by (subst helper1, rule refl)
  also have "\<dots> = a * fold (op * ) xs 1 * fold (op * ) ys 1" by (simp only : hyp)
  also have "\<dots> = fold (op * ) xs a * fold (op * ) ys 1" by (subst (3) helper1, rule refl)
  finally show ?case by simp
qed

lemma "prod (xs @ ys) = prod xs * prod ys"
proof (induct xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  assume hyp:"Ex2_2.prod (xs @ ys) = Ex2_2.prod xs * Ex2_2.prod ys"
  have "Ex2_2.prod ((a # xs) @ ys) = fold  (op *) ((a # xs) @ ys) 1" by (simp)
  also have "\<dots> = fold (op *) (a # xs) 1 * fold (op *) ys 1" by (subst helper2, rule refl)
  finally show ?case by simp
qed

datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

primrec preorder :: "'a tree \<Rightarrow> 'a list" where
  "preorder Tip  = []"|
  "preorder (Node lt val rt) = val # preorder lt @ preorder rt "

primrec postorder :: "'a tree \<Rightarrow> 'a list" where
  "postorder Tip = []"|
  "postorder (Node lt val rt) = postorder lt @ postorder rt @ [val]"

primrec postorder_acc :: "['a tree , 'a list] \<Rightarrow> 'a list" where
  "postorder_acc Tip acc = acc"|
  "postorder_acc (Node lt val rt) acc = (let tmp = postorder_acc rt (val # acc) in postorder_acc lt tmp)"

lemma "postorder_acc t xs = postorder t @ xs"
proof (induct t arbitrary : xs)
  case Tip
  then show ?case by simp
next
  case (Node t1 x2 t2)
  then show ?case by simp
qed

primrec foldl_tree :: "('b \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a tree \<Rightarrow> 'b" where
  "foldl_tree _ acc Tip = acc"|
  "foldl_tree f acc (Node lt val rt) = (let tmp = foldl_tree f (f acc val) rt in foldl_tree f tmp lt) "

lemma "\<forall> a. postorder_acc t a = foldl_tree (\<lambda> xs x . Cons x xs) a t" by (induct t, simp_all)

definition tree_sum :: "nat tree \<Rightarrow> nat" where
  "tree_sum = foldl_tree (op +) 0"

declare tree_sum_def [simp]

lemma helper3 : fixes x::nat shows  " x + foldl_tree (op +) 0 t = foldl_tree (op +) x t"
proof (induction t arbitrary : x)
  case Tip
  then show ?case by simp
next
  case (Node t1 x2 t2)

  assume h1:"\<And>x .x + foldl_tree op + 0 t1 = foldl_tree op + x t1"
     and h2:"\<And>x. x + foldl_tree op + 0 t2 = foldl_tree op + x t2"

  have "x + foldl_tree op + 0 (Node t1 x2 t2)  = x + foldl_tree op + (foldl_tree op + x2 t2) t1" by simp
  also have "\<dots> = x + (foldl_tree op + x2 t2 + foldl_tree op + 0 t1)" by (subst h1, rule refl)
  also have "\<dots> = x + foldl_tree op + x2 t2 + foldl_tree op + 0 t1" by simp
  also have "\<dots> = x + (x2 + foldl_tree op + 0 t2) + foldl_tree op + 0 t1" by (simp add : h2)
  also have "\<dots> =  x + x2 + foldl_tree op + 0 t2 + foldl_tree op + 0 t1" by simp
  also have "\<dots> = foldl_tree op + (op + x x2) t2 + foldl_tree op + 0 t1" by (simp add : h2)
  also have "\<dots> = foldl_tree op + (foldl_tree op + (op + x x2) t2) t1" by (simp add : h1)
  also have "\<dots> =  foldl_tree op + x (Node t1 x2 t2)" by simp
  finally show ?case by assumption
qed

lemma "tree_sum t = sum (preorder t)"
proof (induct t)
  case Tip
  then show ?case by simp
next
  case (Node t1 x2 t2)
  assume hyp1:" tree_sum t1 = Ex2_2.sum (preorder t1)"
     and hyp2:"tree_sum t2 = Ex2_2.sum (preorder t2)"
  have "Ex2_2.sum (preorder (Node t1 x2 t2)) = x2 + sum (preorder t1) + sum (preorder t2)" by simp
  also have "\<dots> = x2 + tree_sum t1 + tree_sum t2" by (subst hyp1, subst hyp2, rule refl)
  also have "\<dots> = x2 + foldl_tree (op +) 0 t1 + foldl_tree (op +) 0 t2" by simp
  also have "\<dots> =  x2 + foldl_tree (op +) 0 t2 + foldl_tree (op +) 0 t1" by simp
  also have "\<dots> = foldl_tree (op +) x2 t2 + foldl_tree (op +) 0 t1" by (simp add : helper3)
  also have "\<dots> = foldl_tree (op +) (foldl_tree (op +) x2 t2) t1" by (simp add : helper3)
  also have "\<dots> = foldl_tree (op +) 0 (Node t1 x2 t2)" by simp
  finally show ?case by simp
qed

github-repos/isabelle/SvenWille-ExerciseSolutions_New/ExerciseSolutions_New-b8243e7a669846c64e2f5520dae88ff41265d233/Isabelle/2. Trees and other inductive data types/Ex2_2.thy


theory MyList

  imports Main

begin

declare [[names_short]]

datatype 'a list = Nil | Cons 'a "'a list"

fun app :: "'a list => 'a list => 'a list" where
  "app Nil ys = ys" |
  "app (Cons x xs) ys = Cons x (app xs ys)"

fun rev :: "'a list => 'a list" where
  "rev Nil = Nil" |
  "rev (Cons x xs) = app (rev xs) (Cons x Nil)"

value "rev(Cons True (Cons False Nil))"

lemma rev_app [simp]: "rev(app xs (Cons x Nil)) = app (rev(Cons x Nil)) (rev xs)"
  apply(induction xs)
   apply(auto)
  done

theorem rev_rev [simp]: "rev(rev xs) = xs"
  apply(induction xs)
   apply(auto)
  done

    (* Ex. 2.1 *)
value "1 + (2::nat)"

value "1 - (2::nat)"

value "1 - (2::int)"

  (*
Ex. 2.2
Start from the definition of add given above. Prove that
add is associative and commutative.
Define a recursive function double :: nat \<Rightarrow> nat
and prove double m = add m m.
*)
fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "add 0 n = n" |
  "add ( Suc m ) n = Suc ( add m n )"

lemma add_n_0 [simp]: "add n 0 = n"
  apply(induction n)
   apply(auto)
  done

theorem add_is_associative: "add (add m n) l = add m (add n l)"
  apply(induction m)
   apply(auto)
  done

lemma add_suc_on_the_right[simp]: "add m (Suc n) = Suc (add m n)"
  apply(induction m)
   apply(auto)
  done

theorem add_is_commutative: "add m n = add n m"
  apply(induction m)
   apply(auto)
  done

    (* (Ex. 2.3, part 2)
Define a recursive function double :: nat \<Rightarrow> nat
and prove double m = add m m.
*)
fun double :: "nat \<Rightarrow> nat" where
  "double 0 = 0" |
  "double (Suc n) = Suc (Suc (double n))"

theorem double_m_is_add_m_to_m: "double m = add m m"
  apply(induction m)
   apply(auto)
  done

    (*
Ex. 2.3
 Define a function count :: 'a \<Rightarrow> 'a list \<Rightarrow> nat that counts the
number of occurrences of an element in a list.
Prove count x xs \<le> length xs.
*)
fun length :: "'a list \<Rightarrow> nat" where
  "length Nil = 0" |
  "length (Cons x xs) = length xs +1"

fun count :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
  "count y Nil = 0" |
  "count y (Cons x xs) =
   (if y=x then ((count y xs)+1) else (count y xs))"

theorem count_is_less_than_list_size: "count x xs \<le> length xs"
  apply(induction xs)
   apply(auto)
  done

    (*
Exercise 2.4. Define a recursive function snoc :: 'a list \<Rightarrow> 'a \<Rightarrow> 'a list
that appends an element to the end of a list. With the help of snoc define
a recursive function reverse :: 'a list \<Rightarrow> 'a list that reverses a list.
Prove reverse (reverse xs) = xs.
*)

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "snoc Nil x = Cons x Nil" |
  "snoc (Cons x xs) y = Cons x (snoc xs y)"

fun reverse :: "'a list \<Rightarrow> 'a list" where
  "reverse Nil = Nil" |
  "reverse (Cons x xs) = snoc (reverse xs) x"

lemma l0 [simp] : "reverse (snoc xs x) = Cons x (reverse xs)"
  apply(induction xs)
   apply(auto)
  done

theorem reverse_is_involutive: "reverse(reverse xs) = xs"
  apply(induction xs)
   apply(auto)
  done

    (*
Exercise 2.5.
Define a recursive function sum_upto :: nat \<Rightarrow> nat such that
sum_upto n = 0 + ... + n and prove sum_upto n = n \<^emph> (n + 1) div 2.
*)
fun sum_upto :: "nat \<Rightarrow> nat" where
  "sum_upto 0 = 0" |
  "sum_upto (Suc n) = (sum_upto n) + (Suc n)"

theorem sum_upto_formula [simp] : "sum_upto n = (n * (n + 1)) div 2"
  apply(induction n)
    apply(auto)
done

end


theory Chapter2
imports Main
begin

text{*
\section*{Chapter 2}

\exercise
Use the \textbf{value} command to evaluate the following expressions:
*}

value "1 + (2::nat)"
value "1 + (2::int)"
value "1 - (2::nat)"
value "1 - (2::int)"
value "[a,b] @ [c,d]"

text{*
\endexercise

\exercise
Recall the definition of our own addition function on @{typ nat}:
*}

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"add 0 n = n" |
"add (Suc m) n = Suc(add m n)"

text{*
Prove that @{const add} is associative and commutative.
You will need additional lemmas.
*}

lemma add_zero [simp]: "add m 0 = m"
apply(induction m)
apply(auto)
done

lemma add_suc [simp]: "add m (Suc n) = Suc(add m n)"
apply(induction m)
apply(auto)
done

lemma add_comm: "add m n = add n m"
apply(induction m)
apply(auto)
done

text{* Define a recursive function *}

fun double :: "nat \<Rightarrow> nat" where
"double 0 = 0" |
"double (Suc m) = Suc (Suc (double m))"

text{* and prove that *}

lemma double_add: "double m = add m m"
apply(induction m)
apply(auto)
done

text{*
\endexercise

\exercise
Define a function that counts the number of occurrences of
an element in a list:
*}

fun count :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
"count [] x = 0" |
"count (y # ys) x = (if y = x then Suc (count ys x) else count ys x)"

text {*
Test your definition of @{term count} on some examples.
Prove the following inequality:
*}

theorem "count xs x \<le> length xs"
apply(induction xs)
apply(auto)
done

text{*
\endexercise

\exercise
Define a function @{text snoc} that appends an element to the end of a list.
Do not use the existing append operator @{text "@"} for lists.
*}

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
"snoc [] x = [x]" |
"snoc (y # ys) x = y # (snoc ys x)"

text {*
Convince yourself on some test cases that your definition
of @{term snoc} behaves as expected.
With the help of @{text snoc} define a recursive function @{text reverse}
that reverses a list. Do not use the predefined function @{const rev}.
*}

fun reverse :: "'a list \<Rightarrow> 'a list" where
"reverse [] = []" |
"reverse (x # xs) = snoc (reverse xs) x"

text {*
Prove the following theorem. You will need an additional lemma.
*}

lemma rev_snoc [simp]: "reverse (snoc xs x) = x # (reverse xs)"
apply(induction xs)
apply(auto)
done

theorem "reverse (reverse xs) = xs"
apply(induction xs)
apply(auto)
done

text{*
\endexercise

\exercise
The aim of this exercise is to prove the summation formula
\[ \sum_{i=0}^{n}i = \frac{n(n+1)}{2} \]
Define a recursive function @{text "sum_upto n = 0 + ... + n"}:
*}

fun sum_upto :: "nat \<Rightarrow> nat" where
"sum_upto 0 = 0" |
"sum_upto (Suc n) = (Suc n) + (sum_upto n)"

text {*
Now prove the summation formula by induction on @{text "n"}.
First, write a clear but informal proof by hand following the examples
in the main text. Then prove the same property in Isabelle:
*}

lemma "sum_upto n = n * (n+1) div 2"
apply(induction n)
apply(auto)
done

text{*
\endexercise

\exercise
Starting from the type @{text "'a tree"} defined in the text, define
a function that collects all values in a tree in a list, in any order,
without removing duplicates.
*}
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

fun contents :: "'a tree \<Rightarrow> 'a list" where
"contents Tip = []" |
"contents (Node t1 v t2) = v # (contents t1) @ (contents t2)"

text{*
Then define a function that sums up all values in a tree of natural numbers
*}

fun sum_tree :: "nat tree \<Rightarrow> nat" where
"sum_tree Tip = 0" |
"sum_tree (Node t1 v t2) = v + (sum_tree t1) + (sum_tree t2)"

text{* and prove *}

lemma "sum_tree t = sum_list(contents t)"
apply(induction t)
apply(auto)
done

text{*
\endexercise

\exercise
Define a new type @{text "'a tree2"} of binary trees where values are also
stored in the leaves of the tree.  Also reformulate the
@{text mirror} function accordingly. Define two functions *}

datatype 'a tree2 = Leaf 'a | Node "'a tree2" "'a tree2"

fun mirror :: "'a tree2 \<Rightarrow> 'a tree2" where
"mirror (Leaf v) = Leaf v" |
"mirror (Node l r) = Node (mirror l) (mirror r)"

fun pre_order :: "'a tree2 \<Rightarrow> 'a list" where
"pre_order (Leaf v) = [v]" |
"pre_order (Node l r) = (pre_order l) @ (pre_order r)"

fun post_order :: "'a tree2 \<Rightarrow> 'a list" where
"post_order (Leaf v) = [v]" |
"post_order (Node l r) = (post_order r) @ (post_order l)"

text{*
that traverse a tree and collect all stored values in the respective order in
a list. Prove *}

lemma "pre_order (mirror t) = rev (post_order t)"
apply(induction t)
apply(auto)
done

text{*
\endexercise

\exercise
Define a recursive function
*}

fun intersperse :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"intersperse a [] = []" |
"intersperse a [x] = [x]" |
"intersperse a (x # xs) = x # a # (intersperse a xs)"

text{*
such that @{text "intersperse a [x\<^sub>1, ..., x\<^sub>n] = [x\<^sub>1, a, x\<^sub>2, a, ..., a, x\<^sub>n]"}.
Prove
*}

lemma "map f (intersperse a xs) = intersperse (f a) (map f xs)"
apply(induction xs rule: intersperse.induct)
apply(auto)
done

text{*
\endexercise

\exercise
Write a tail-recursive variant of the @{text add} function on @{typ nat}:
*}

fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"itadd 0 n = n" |
"itadd (Suc m) n = itadd m (Suc n)"

text{*
Tail-recursive means that in the recursive case, @{const itadd} needs to call
itself directly: \mbox{@{term"itadd (Suc m) n"}} @{text"= itadd \<dots>"}.
Prove
*}

lemma "itadd m n = add m n"
apply(induction m arbitrary: n)
apply(auto)
done

text{*
\endexercise

\exercise\label{exe:tree0}
Define a datatype @{text tree0} of binary tree skeletons which do not store
any information, neither in the inner nodes nor in the leaves.
Define a function that counts the number of all nodes (inner nodes and leaves)
in such a tree:
*}

datatype tree0 = Leaf | Node "tree0" "tree0"

fun nodes :: "tree0 \<Rightarrow> nat" where
"nodes (Leaf) = 1" |
"nodes (Node l r) = Suc (nodes l + nodes r)"

text {*
Consider the following recursive function:
*}

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

text {*
Experiment how @{text explode} influences the size of a binary tree
and find an equation expressing the size of a tree after exploding it
(\noquotes{@{term [source] "nodes (explode n t)"}}) as a function
of @{term "nodes t"} and @{text n}. Prove your equation.
You may use the usual arithmetic operations including the exponentiation
operator ``@{text"^"}''. For example, \noquotes{@{prop [source] "2 ^ 2 = 4"}}.

Hint: simplifying with the list of theorems @{thm[source] algebra_simps}
takes care of common algebraic properties of the arithmetic operators.
\endexercise
*}

theorem "(let l = nodes t in nodes (explode n t) = (2^n) * l + (2^n) - 1)"
apply(simp add: Let_def)
apply(induction n arbitrary: t)
apply(auto simp add: algebra_simps)
done

text{*

\exercise
Define arithmetic expressions in one variable over integers (type @{typ int})
as a data type:
*}

datatype exp = Var | Const int | Add exp exp | Mult exp exp

text{*
Define a function @{text eval} that evaluates an expression at some value:
*}

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
"eval Var        x = x" |
"eval (Const c)  x = c" |
"eval (Add l r)  x = (eval l x) + (eval r x)" |
"eval (Mult l r) x = (eval l x) * (eval r x)"

text{*
For example, @{prop"eval (Add (Mult (Const 2) Var) (Const 3)) i = 2*i+3"}.

A polynomial can be represented as a list of coefficients, starting with
the constant. For example, @{term "[4, 2, -1, 3::int]"} represents the
polynomial $4 + 2x - x^2 + 3x^3$.
Define a function @{text evalp} that evaluates a polynomial at a given value:
*}

fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
"evalp [] x = 0" |
"evalp [a0] x = a0" |
"evalp (ai # as) x = ai + x*(evalp as x)"

text{*
Define a function @{text coeffs} that transforms an expression into a polynomial.
This will require auxiliary functions.
*}

fun coeffs :: "exp \<Rightarrow> int list" where
(* your definition/proof here *)

text{*
Prove that @{text coeffs} preserves the value of the expression:
*}

theorem evalp_coeffs: "evalp (coeffs e) x = eval e x"
(* your definition/proof here *)

text{*
Hint: consider the hint in Exercise~\ref{exe:tree0}.
\endexercise
*}

end


(*  Title:      HOL/Hoare/Examples.thy
    Author:     Norbert Galm
    Copyright   1998 TUM

Various examples.
*)

theory Examples imports Hoare_Logic Arith2 begin

(*** ARITHMETIC ***)

(** multiplication by successive addition **)

lemma multiply_by_add: "VARS m s a b
  {a=A & b=B}
  m := 0; s := 0;
  WHILE m~=a
  INV {s=m*b & a=A & b=B}
  DO s := s+b; m := m+(1::nat) OD
  {s = A*B}"
by vcg_simp

lemma multiply_by_add_time: "VARS m s a b t
  {a=A & b=B & t=0}
  m := 0; t := t+1; s := 0; t := t+1;
  WHILE m~=a
  INV {s=m*b & a=A & b=B & t = 2*m + 2}
  DO s := s+b; t := t+1; m := m+(1::nat); t := t+1 OD
  {s = A*B \<and> t = 2*A + 2}"
by vcg_simp

lemma multiply_by_add2: "VARS M N P :: int
 {m=M & n=N}
 IF M < 0 THEN M := -M; N := -N ELSE SKIP FI;
 P := 0;
 WHILE 0 < M
 INV {0 <= M & (EX p. p = (if m<0 then -m else m) & p*N = m*n & P = (p-M)*N)}
 DO P := P+N; M := M - 1 OD
 {P = m*n}"
apply vcg_simp
 apply (auto simp add:int_distrib)
done

lemma multiply_by_add2_time: "VARS M N P t :: int
 {m=M & n=N & t=0}
 IF M < 0 THEN M := -M; t := t+1; N := -N; t := t+1 ELSE SKIP FI;
 P := 0; t := t+1;
 WHILE 0 < M
 INV {0 \<le> M & (EX p. p = (if m<0 then -m else m) & p*N = m*n & P = (p-M)*N & t \<ge> 0 & t \<le> 2*(p-M)+3)}
 DO P := P+N; t := t+1; M := M - 1; t := t+1 OD
 {P = m*n & t \<le> 2*abs m + 3}"
apply vcg_simp
 apply (auto simp add:int_distrib)
done

(** Euclid's algorithm for GCD **)

lemma Euclid_GCD: "VARS a b
 {0<A & 0<B}
 a := A; b := B;
 WHILE  a \<noteq> b
 INV {0<a & 0<b & gcd A B = gcd a b}
 DO IF a<b THEN b := b-a ELSE a := a-b FI OD
 {a = gcd A B}"
apply vcg
(*Now prove the verification conditions*)
  apply auto
  apply(simp add: gcd_diff_r less_imp_le)
 apply(simp add: linorder_not_less gcd_diff_l)
apply(erule gcd_nnn)
done

lemma Euclid_GCD_time: "VARS a b t
 {0<A & 0<B & t=0}
 a := A; t := t+1; b := B; t := t+1;
 WHILE  a \<noteq> b
 INV {0<a & 0<b & gcd A B = gcd a b & a\<le>A & b\<le>B & t \<le> max A B - max a b + 2}
 DO IF a<b THEN b := b-a; t := t+1 ELSE a := a-b; t := t+1 FI OD
 {a = gcd A B & t \<le> max A B + 2}"
apply vcg
(*Now prove the verification conditions*)
  apply auto
  apply(simp add: gcd_diff_r less_imp_le)
 apply(simp add: linorder_not_less gcd_diff_l)
apply(erule gcd_nnn)
done

(** Dijkstra's extension of Euclid's algorithm for simultaneous GCD and SCM **)
(* From E.W. Disjkstra. Selected Writings on Computing, p 98 (EWD474),
   where it is given without the invariant. Instead of defining scm
   explicitly we have used the theorem scm x y = x*y/gcd x y and avoided
   division by mupltiplying with gcd x y.
*)

lemmas distribs =
  diff_mult_distrib diff_mult_distrib2 add_mult_distrib add_mult_distrib2

lemma gcd_scm: "VARS a b x y
 {0<A & 0<B & a=A & b=B & x=B & y=A}
 WHILE  a ~= b
 INV {0<a & 0<b & gcd A B = gcd a b & 2*A*B = a*x + b*y}
 DO IF a<b THEN (b := b-a; x := x+y) ELSE (a := a-b; y := y+x) FI OD
 {a = gcd A B & 2*A*B = a*(x+y)}"
apply vcg
  apply simp
 apply(simp add: distribs gcd_diff_r linorder_not_less gcd_diff_l)
apply(simp add: distribs gcd_nnn)
done

(** Power by iterated squaring and multiplication **)

lemma power_by_mult: "VARS a b c
 {a=A & b=B}
 c := (1::nat);
 WHILE b ~= 0
 INV {A^B = c * a^b}
 DO  WHILE b mod 2 = 0
     INV {A^B = c * a^b}
     DO  a := a*a; b := b div 2 OD;
     c := c*a; b := b - 1
 OD
 {c = A^B}"
apply vcg_simp
apply(case_tac "b")
 apply simp
apply simp
done

(** Factorial **)

lemma factorial: "VARS a b
 {a=A}
 b := 1;
 WHILE a > 0
 INV {fac A = b * fac a}
 DO b := b*a; a := a - 1 OD
 {b = fac A}"
apply vcg_simp
apply(clarsimp split: nat_diff_split)
done

lemma factorial_time: "VARS a b t
 {a=A & t=0}
 b := 1; t := t+1;
 WHILE a > 0
 INV {fac A = b * fac a & a \<le> A & t = 2*(A-a)+1}
 DO b := b*a; t := t+1; a := a - 1; t := t+1 OD
 {b = fac A & t = 2*A + 1}"
apply vcg_simp
apply(clarsimp split: nat_diff_split)
done

lemma factorial2: "VARS i f
 {True}
 i := (1::nat); f := 1;
 WHILE i <= n INV {f = fac(i - 1) & 1 <= i & i <= n+1}
 DO f := f*i; i := i+1 OD
 {f = fac n}"
apply vcg_simp
apply(subgoal_tac "i = Suc n")
apply simp
apply arith
done

lemma factorial2_time: "VARS i f t
 {t=0}
 i := (1::nat); t := t+1; f := 1; t := t+1;
 WHILE i \<le> n INV {f = fac(i - 1) & 1 \<le> i & i \<le> n+1 & t = 2*(i-1)+2}
 DO f := f*i; t := t+1; i := i+1; t := t+1 OD
 {f = fac n & t = 2*n+2}"
apply vcg_simp
 apply auto
apply(subgoal_tac "i = Suc n")
 apply simp
apply arith
done

(** Square root **)

(* the easy way: *)

lemma sqrt: "VARS r x
 {True}
 r := (0::nat);
 WHILE (r+1)*(r+1) <= X
 INV {r*r \<le> X}
 DO r := r+1 OD
 {r*r <= X & X < (r+1)*(r+1)}"
apply vcg_simp
done

lemma sqrt_time: "VARS r t
 {t=0}
 r := (0::nat); t := t+1;
 WHILE (r+1)*(r+1) <= X
 INV {r*r \<le> X & t = r+1}
 DO r := r+1; t := t+1 OD
 {r*r <= X & X < (r+1)*(r+1) & (t-1)*(t-1) \<le> X}"
apply vcg_simp
done

(* without multiplication *)

lemma sqrt_without_multiplication: "VARS u w r
 {x=X}
 u := 1; w := 1; r := (0::nat);
 WHILE w <= X
 INV {u = r+r+1 & w = (r+1)*(r+1) & r*r <= X}
 DO r := r + 1; w := w + u + 2; u := u + 2 OD
 {r*r <= X & X < (r+1)*(r+1)}"
apply vcg_simp
done

(*** LISTS ***)

lemma imperative_reverse: "VARS y x
 {x=X}
 y:=[];
 WHILE x ~= []
 INV {rev(x)@y = rev(X)}
 DO y := (hd x # y); x := tl x OD
 {y=rev(X)}"
apply vcg_simp
 apply(simp add: neq_Nil_conv)
 apply auto
done

lemma imperative_reverse_time: "VARS y x t
 {x=X & t=0}
 y:=[]; t := t+1;
 WHILE x ~= []
 INV {rev(x)@y = rev(X) & t = 2*(length y) + 1}
 DO y := (hd x # y); t := t+1; x := tl x; t := t+1 OD
 {y=rev(X) & t = 2*length X + 1}"
apply vcg_simp
 apply(simp add: neq_Nil_conv)
 apply auto
done

lemma imperative_append: "VARS x y
 {x=X & y=Y}
 x := rev(x);
 WHILE x~=[]
 INV {rev(x)@y = X@Y}
 DO y := (hd x # y);
    x := tl x
 OD
 {y = X@Y}"
apply vcg_simp
apply(simp add: neq_Nil_conv)
apply auto
done

lemma imperative_append_time_no_rev: "VARS x y t
 {x=X & y=Y}
 x := rev(x); t := 0;
 WHILE x~=[]
 INV {rev(x)@y = X@Y & length x \<le> length X & t = 2 * (length X - length x)}
 DO y := (hd x # y); t := t+1;
    x := tl x; t := t+1
 OD
 {y = X@Y & t = 2 * length X}"
apply vcg_simp
apply(simp add: neq_Nil_conv)
apply auto
done

(*** ARRAYS ***)

(* Search for a key *)
lemma zero_search: "VARS A i
 {True}
 i := 0;
 WHILE i < length A & A!i ~= key
 INV {!j. j<i --> A!j ~= key}
 DO i := i+1 OD
 {(i < length A --> A!i = key) &
  (i = length A --> (!j. j < length A --> A!j ~= key))}"
apply vcg_simp
apply(blast elim!: less_SucE)
done

lemma zero_search_time: "VARS A i t
 {t=0}
 i := 0; t := t+1;
 WHILE i < length A & A!i ~= key
 INV {(\<forall>j. j<i --> A!j ~= key) & i \<le> length A & t = i+1}
 DO i := i+1; t := t+1 OD
 {(i < length A --> A!i = key) &
  (i = length A --> (!j. j < length A --> A!j ~= key)) & t \<le> length A + 1}"
apply vcg_simp
apply(blast elim!: less_SucE)
done

(*
The `partition' procedure for quicksort.
`A' is the array to be sorted (modelled as a list).
Elements of A must be of class order to infer at the end
that the elements between u and l are equal to pivot.

Ambiguity warnings of parser are due to := being used
both for assignment and list update.
*)
lemma lem: "m - Suc 0 < n ==> m < Suc n"
by arith

lemma Partition:
"[| leq == %A i. !k. k<i --> A!k <= pivot;
    geq == %A i. !k. i<k & k<length A --> pivot <= A!k |] ==>
 VARS A u l
 {0 < length(A::('a::order)list)}
 l := 0; u := length A - Suc 0;
 WHILE l <= u
  INV {leq A l & geq A u & u<length A & l<=length A}
  DO WHILE l < length A & A!l <= pivot
     INV {leq A l & geq A u & u<length A & l<=length A}
     DO l := l+1 OD;
     WHILE 0 < u & pivot <= A!u
     INV {leq A l & geq A u  & u<length A & l<=length A}
     DO u := u - 1 OD;
     IF l <= u THEN A := A[l := A!u, u := A!l] ELSE SKIP FI
  OD
 {leq A u & (!k. u<k & k<l --> A!k = pivot) & geq A l}"
(* expand and delete abbreviations first *)
apply (simp)
apply (erule thin_rl)+
apply vcg_simp
   apply (force simp: neq_Nil_conv)
  apply (blast elim!: less_SucE intro: Suc_leI)
 apply (blast elim!: less_SucE intro: less_imp_diff_less dest: lem)
apply (force simp: nth_list_update)
done

end