(*  Title:      Fermat3.thy
    Author:     Roelof Oosterhuis, 2007  Rijksuniversiteit Groningen
*)

header {* Fermat's last theorem, case $n=3$ *}

theory Fermat3
imports QuadForm
begin

text {* Proof of Fermat's last theorem for the case $n=3$: $$\forall x,y,z:~x^3 + y^3 = z^3 \Longrightarrow xyz=0.$$ *}

lemma factor_sum_cubes: "(x::int)^3 + y^3 = (x+y)*(x^2 - x*y + y^2)"
  by (simp add: eval_nat_numeral field_simps)

lemma two_not_abs_cube: "\<bar>x^3\<bar> = (2::int) \<Longrightarrow> False"
proof -
  assume "\<bar>x^3\<bar> = 2"
  hence x32: "\<bar>x\<bar>^3 = 2" by (simp only: abs_power3_distrib)
  have "\<bar>x\<bar> \<ge> 0" by simp
  moreover
  { assume "\<bar>x\<bar> = 0 \<or> \<bar>x\<bar> = 1 \<or> \<bar>x\<bar> = 2"
    with x32 have False by (auto simp add: power_0_left) }
  moreover
  { assume "\<bar>x\<bar> > 2"
    moreover have "(0::int) \<le> 2" and "(0::nat) < 3" by auto
    ultimately have "\<bar>x\<bar>^3 > 2^3" by (simp only: power_strict_mono)
    with x32 have False by simp }
  ultimately show False by arith
qed

text {* Shows there exists no solution $v^3+w^3 = x^3$ with $vwx\ne 0$ and $\gcd(v,w)=1$ and $x$ even, by constructing a solution with a smaller $|x^3|$. *}

lemma no_rewritten_fermat3:
  "\<not> (\<exists> v w. v^3+w^3 = x^3 \<and> v*w*x \<noteq> 0 \<and> x \<in> zEven \<and> zgcd v w=1)"
proof (induct x rule: infinite_descent0_measure[where V="\<lambda>x. nat\<bar>x^3\<bar>"])
  case (0 x) hence "x^3 = 0" by arith
  hence "x=0" by auto
  thus ?case by auto
next
  case (smaller x)
  then obtain v w where vwx:
    "v^3+w^3=x^3 \<and> v*w*x \<noteq> 0 \<and> x \<in> zEven \<and> zgcd v w=1" (is "?P v w x")
    by auto
  have "\<exists> \<alpha> \<beta> \<gamma>. ?P \<alpha> \<beta> \<gamma> \<and> nat\<bar>\<gamma>^3\<bar> < nat\<bar>x^3\<bar>"
  proof -
    -- "obtain coprime $p$ and $q$ such that $v = p+q$ and $w = p-q$"
    have vwOdd: "v \<in> zOdd \<and> w \<in> zOdd"
    proof (rule ccontr, case_tac "v \<in> zOdd", simp_all)
      assume "v \<notin> zOdd" hence ve: "v \<in> zEven" by (rule not_odd_impl_even)
      hence "v^3 \<in> zEven" by (simp only: power_preserves_even)
      moreover from vwx have "x^3 \<in> zEven" by (simp only: power_preserves_even)
      ultimately have "(x^3-v^3) \<in> zEven" by (simp only: even_minus_even)
      moreover from vwx have "x^3-v^3 = w^3" by simp
      ultimately have "w^3 \<in> zEven" by simp
      hence "w \<in> zEven" by (simp only: power_preserves_even)
      with ve have "2 dvd v \<and> 2 dvd w" by (auto simp add: zEven_def)
      hence "2 dvd zgcd v w" by (simp add: zgcd_greatest_iff)
      with vwx show False by simp
    next
      assume vo: "v \<in> zOdd" and "w \<notin> zOdd"
      hence "w \<in> zEven" by (simp add: not_odd_impl_even)
      with vo have "v^3 \<in> zOdd" and "w^3 \<in> zEven"
        by (auto simp only: power_preserves_even power_preserves_odd)
      hence "w^3 + v^3 \<in> zOdd" by (simp only: even_plus_odd)
      with vwx have "x^3 \<in> zOdd" by (simp add: add.commute)
      hence "x \<in> zOdd" by (simp only: power_preserves_odd)
      with vwx show False by (auto simp add: odd_iff_not_even)
    qed
    hence "v+w \<in> zEven \<and> v-w \<in> zEven" by (simp add: odd_minus_odd odd_plus_odd)
    then obtain p q where pq: "v+w = 2*p \<and> v-w = 2*q"
      by (auto simp add: zEven_def)
    hence vw: "v = p+q \<and> w = p-q" by auto
    -- "show that $x^3 = (2p)(p^2 + 3q^2)$ and that these factors are"
    -- "either coprime (first case), or have $3$ as g.c.d. (second case)"
    have vwpq: "v^3 + w^3 = (2*p)*(p^2 + 3*q^2)"
    proof -
      have "2*(v^3 + w^3) = 2*(v+w)*(v^2 - v*w + w^2)"
        by (simp only: factor_sum_cubes)
      also from pq have "\<dots> = 4*p*(v^2 - v*w + w^2)" by auto
      also have "\<dots> = p*((v+w)^2 + 3*(v-w)^2)"
        by (simp add: eval_nat_numeral field_simps)
      also with pq have "\<dots> = p*((2*p)^2 + 3*(2*q)^2)" by simp
      also have "\<dots> = 2*(2*p)*(p^2+3*q^2)" by (simp add: power_mult_distrib)
      finally show ?thesis by simp
    qed
    let ?g = "zgcd (2*p) (p^2+3*q^2)"
    have g1: "?g \<ge> 1"
    proof (rule ccontr)
      assume "\<not> ?g \<ge> 1"
      then have "?g < 0 \<or> ?g = 0" unfolding not_le by arith
      moreover have "?g \<ge> 0" by (rule zgcd_geq_zero)
      ultimately have "?g = 0" by arith
      hence "p = 0" by simp
      with vwpq vwx `0 < nat\<bar>x^3\<bar>` show False by auto
    qed
    have gOdd: "\<not> 2 dvd ?g"
    proof (rule ccontr, simp)
      assume "2 dvd ?g"
      hence"2 dvd p^2+3*q^2" by (simp only: zgcd_greatest_iff)
      then obtain k where k: "p^2 + 3*q^2 = 2*k" by (auto simp add: dvd_def)
      hence "2*(k - 2*q^2) = p^2-q^2" by auto
      with vw have "v*w = 2*(k - 2*q^2)" by (simp add: zspecial_product)
      hence "v*w \<in> zEven" by (auto simp only: zEven_def)
      hence "v \<in> zEven \<or> w \<in> zEven" by (simp add: even_product)
      with vwOdd show False by (auto simp add: odd_iff_not_even)
    qed
    -- "first case: $p$ is not a multiple of $3$; hence $2p$ and $p^2+3q^2$"
    -- "are coprime; hence both are cubes"
    { assume p3: "\<not> 3 dvd p"
      have g3: "\<not> 3 dvd ?g"
      proof (rule ccontr, simp)
        assume "3 dvd ?g" hence "3 dvd 2*p" by (simp add: zgcd_greatest_iff)
        hence "(3::int) dvd 2 \<or> 3 dvd p"
          by (auto simp only: zprime_3 zprime_zdvd_zmult_general)
        with p3 show False by arith
      qed
      have pq_relprime: "zgcd p q=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and zp: "z dvd p" and zq: "z dvd q"
        hence "z dvd p+q \<and> z dvd p-q" by (auto simp only: dvd_add dvd_diff)
        with vw have "z dvd v \<and> z dvd w" by simp
        with z vwx show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have factors_relprime: "?g = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and z2p: "z dvd 2*p" and zpq: "z dvd p^2+3*q^2"
        hence zg: "z dvd ?g" by (simp add: zgcd_greatest_iff)
        with gOdd have "z \<noteq> 2" by auto
        with z have zg2: "z > 2" by (auto simp add: zprime_def)
        from z z2p have "z dvd 2 \<or> z dvd p" by (simp only: zprime_zdvd_zmult_general)
        moreover
        { assume "z dvd 2"
          hence "z \<le> 2" by (auto simp add: zdvd_imp_le)
          with zg2 have False by simp }
        ultimately have zp: "z dvd p" by auto
        hence "z dvd p^2" by (auto simp add: power2_eq_square)
        with zpq have "z dvd p^2+3*q^2-p^2" by (simp only: dvd_diff)
        hence "z dvd 3*q^2" by auto
        with z have "z dvd 3 \<or> z dvd q^2" by (simp only: zprime_zdvd_zmult_general)
        moreover
        { assume "z dvd 3"
          hence "z \<le> 3" by (auto simp add: zdvd_imp_le)
          with zg2 have "z = 3" by auto
          with zg g3 have False by auto }
        ultimately have "z dvd q^2" by auto
        with z have "z dvd q" by (rule zprime_zdvd_power)
        with zp z pq_relprime show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      moreover from vwx vwpq have pqx: "(2*p)*(p^2 + 3*q^2) = x^3" by auto
      moreover have triv3: "3 = nat 3 \<and> nat 3 > 1 \<and> 3 \<in> zOdd"
        by (unfold zOdd_def, auto)
      ultimately have "\<exists> c. 2*p = c^3"
        by (simp only: int_relprime_odd_power_divisors)
      then obtain c where c: "c^3 = 2*p" by auto
      from pqx factors_relprime have "zgcd (p^2 + 3*q^2) (2*p) = 1"
        and "(p^2 + 3*q^2)*(2*p) = x^3" by (auto simp add: zgcd_commute ac_simps)
      with triv3 have "\<exists> d. p^2 + 3*q^2 = d^3"
        by (simp only: int_relprime_odd_power_divisors)
      then obtain d where d: "p^2 + 3*q^2 = d^3" by auto
      have "d \<in> zOdd"
      proof (rule ccontr)
        assume "d \<notin> zOdd" hence "d \<in> zEven" by (rule not_odd_impl_even)
        hence "d^3 \<in> zEven" by (simp only: power_preserves_even)
        hence "2 dvd d^3" by (simp add: zEven_def dvd_def)
        moreover have "2 dvd 2*p" by (rule dvd_triv_left)
        ultimately have "2 dvd zgcd (2*p) (d^3)" by (simp add: zgcd_greatest_iff)
        with d factors_relprime show False by simp
      qed
      with d pq_relprime have "zgcd p q=1 \<and> p^2 + 3*q^2 = d^3 \<and> d \<in> zOdd"
        by simp
      hence "is_cube_form p q" by (rule qf3_cube_impl_cube_form)
      then obtain a b where "p = a^3 - 9*a*b^2 \<and> q = 3*a^2*b - 3*b^3"
        by (unfold is_cube_form_def, auto)
      hence ab: "p = a*(a+3*b)*(a- 3*b) \<and> q = b*(a+b)*(a-b)*3"
        by (simp add: eval_nat_numeral field_simps)
      with c have abc: "(2*a)*(a+3*b)*(a- 3*b) = c^3" by auto
      have ab_relprime: "zgcd a b=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and za: "z dvd a" and zb: "z dvd b"
        with ab have "z dvd p \<and> z dvd q" by simp
        with z pq_relprime show
          False by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have ab1: "zgcd (2*a) (a+3*b) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and "z dvd 2*a" and zab: "z dvd a+3*b"
        hence "z dvd 2 \<or> z dvd a" by (simp add: zprime_zdvd_zmult)
        moreover have zn2: "\<not> z dvd 2"
        proof (rule ccontr, simp)
          assume z2: "z dvd 2"
          hence "z \<le> 2" by (simp only: zdvd_imp_le)
          with z have "z = 2" by (unfold zprime_def, auto)
          with zab have ab2: "2 dvd a+3*b" by simp
          moreover have "2 dvd 2*b" by (rule dvd_triv_left)
          ultimately have "2 dvd a+3*b- 2*b" by (rule dvd_diff)
          hence "2 dvd a+b" by arith
          hence "2 dvd (a+b)*((a-b)*b*3)" by (rule dvd_mult2)
          with ab have qEven: "2 dvd q" by (simp only: ac_simps)
          from ab2 have "2 dvd (a+3*b)*((a- 3*b)*a)" by (rule dvd_mult2)
          with ab have "2 dvd p" by (simp only: ac_simps)
          with qEven have "2 dvd zgcd p q" by (simp add: zgcd_greatest_iff)
          with pq_relprime show False by auto
        qed
        ultimately have za: "z dvd a" by auto
        with zab have "z dvd a+3*b-a" by (simp only: dvd_diff)
        hence "z dvd 3*b" by simp
        with z have "z dvd 3 \<or> z dvd b" by (simp only: zprime_zdvd_zmult_general)
        moreover
        { assume "z dvd 3"
          with z have "z \<le> 3" by (auto simp add: zdvd_imp_le)
          moreover from zn2 have "z\<noteq>2" by auto
          moreover from z have "z > 1" by (simp add: zprime_def)
          ultimately have "z=3" by auto
          with za have "3 dvd a" by simp
          with ab have "3 dvd p" by auto
          with p3 have False by auto }
        ultimately have "z dvd b" by auto
        with za z ab_relprime show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have ab2: "zgcd (a+3*b) (a- 3*b) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and zab1: "z dvd a+3*b" and zab2: "z dvd a- 3*b"
        hence "z dvd (a+3*b)+(a- 3*b)" by (simp only: dvd_add)
        hence "z dvd 2*a" by simp
        with zab1 z ab1 show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have "zgcd(a- 3*b) (2*a) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and z2a: "z dvd 2*a" and zab: "z dvd a- 3*b"
        hence "z dvd 2*a-(a- 3*b)" by (simp only: dvd_diff)
        moreover have "2*a-(a- 3*b) = a+3*b" by simp
        ultimately have "z dvd a+3*b" by simp
        with z2a z ab1 show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      with abc ab1 ab2 triv3 have "\<exists> k l m. 2*a=k^3 \<and> a+3*b=l^3 \<and> a- 3*b=m^3"
        by (simp only: int_triple_relprime_odd_power_divisors)
      then obtain \<alpha> \<beta> \<gamma> where albega:
        "2*a = \<gamma>^3 \<and> a - 3*b = \<alpha>^3 \<and> a+3*b = \<beta>^3" by auto
      -- "show this is a (smaller) solution"
      hence "\<alpha>^3 + \<beta>^3 = \<gamma>^3" by auto
      moreover have "\<alpha>*\<beta>*\<gamma> \<noteq> 0"
      proof (rule ccontr, safe)
        assume "\<alpha> * \<beta> * \<gamma> = 0"
        with albega ab have "p=0" by (auto simp add: power_0_left)
        with vwpq vwx show False by auto
      qed
      moreover have "\<gamma> \<in> zEven"
      proof -
        have "2*a \<in> zEven" by (simp add: zEven_def)
        with albega have "\<gamma>^3 \<in> zEven" by simp
        thus ?thesis by (simp only: power_preserves_even)
      qed
      moreover have "zgcd \<alpha> \<beta>=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and za: "z dvd \<alpha>" and zb: "z dvd \<beta>"
        hence "z dvd \<alpha> * \<alpha>^2 \<and> z dvd \<beta> * \<beta>^2" by simp
        hence "z dvd \<alpha>^Suc 2 \<and> z dvd \<beta>^Suc 2" by (auto simp only: power_Suc)
        with albega have "z dvd a- 3*b \<and> z dvd a+3*b" by auto
        with ab2 z show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      moreover have "nat\<bar>\<gamma>^3\<bar> < nat\<bar>x^3\<bar>"
      proof -
        let ?A = "p^2 + 3*q^2"
        from vwx vwpq have "x^3 = 2*p*?A" by auto
        also with ab have "\<dots> = 2*a*((a+3*b)*(a- 3*b)*?A)" by auto
        also with albega have "\<dots> = \<gamma>^3 *((a+3*b)*(a- 3*b)*?A)" by auto
        finally have eq: "\<bar>x^3\<bar> = \<bar>\<gamma>^3\<bar> * \<bar>(a+3*b)*(a- 3*b)*?A\<bar>"
          by (auto simp add: abs_mult)
        with `0 < nat\<bar>x^3\<bar>` have "\<bar>(a+3*b)*(a- 3*b)*?A\<bar> > 0" by auto
        hence eqpos: "\<bar>(a+3*b)*(a- 3*b)\<bar> > 0" by auto
        moreover have Ag1: "\<bar>?A\<bar> > 1"
        proof -
          have Aqf3: "is_qfN ?A 3" by (auto simp add: is_qfN_def)
          moreover have triv3b: "(3::int) \<ge> 1" by simp
          ultimately have "?A \<ge> 0" by (simp only: qfN_pos)
          hence "?A > 1 \<or> ?A = 0 \<or> ?A =1" by arith
          moreover
          { assume "?A = 0" with triv3b have "p = 0 \<and> q = 0" by (rule qfN_zero)
            with vwpq vwx have False by auto }
          moreover
          { assume A1: "?A = 1"
            have "q=0"
            proof (rule ccontr)
              assume "q \<noteq> 0"
              hence "q^2 > 0"  by (simp add: zero_less_power2)
              hence "3*q^2 > 1" by arith
              moreover have "p^2 \<ge> 0" by (rule zero_le_power2)
              ultimately have "?A > 1" by arith
              with A1 show False by simp
            qed
            with A1 have p21: "p^2 = 1" by simp
            hence "\<bar>p\<bar> = 1" by (rule power2_eq1_iff)
            with vwpq vwx A1 have "\<bar>x^3\<bar> = 2" by auto
            hence False by (rule two_not_abs_cube) }
          ultimately show ?thesis by auto
        qed
        ultimately have
          "\<bar>(a+3*b)*(a- 3*b)\<bar>*1 < \<bar>(a+3*b)*(a- 3*b)\<bar>*\<bar>?A\<bar>"
          by (simp only: zmult_zless_mono2)
        with eqpos have "\<bar>(a+3*b)*(a- 3*b)\<bar>*\<bar>?A\<bar> > 1" by arith
        hence "\<bar>(a+3*b)*(a- 3*b)*?A\<bar> > 1" by (auto simp add: abs_mult)
        moreover have "\<bar>\<gamma>^3\<bar> > 0"
        proof -
          from eq have "\<bar>\<gamma>^3\<bar> = 0 \<Longrightarrow> \<bar>x^3\<bar>=0" by auto
          with `0 < nat\<bar>x^3\<bar>` show ?thesis by auto
        qed
        ultimately have "\<bar>\<gamma>^3\<bar> * 1 < \<bar>\<gamma>^3\<bar> * \<bar>(a+3*b)*(a- 3*b)*?A\<bar>"
          by (rule zmult_zless_mono2)
        with eq have "\<bar>x^3\<bar> > \<bar>\<gamma>^3\<bar>" by auto
        thus ?thesis by arith
      qed
      ultimately have ?thesis by auto }
    moreover
    -- "second case: $p = 3r$ and hence $x^3 = (18r)(q^2+3r^2)$ and these"
    -- "factors are coprime; hence both are cubes"
    { assume p3: "3 dvd p"
      then obtain r where r: "p = 3*r" by (auto simp add: dvd_def)
      moreover have "3 dvd 3*(3*r^2 + q^2)" by (rule dvd_triv_left)
      ultimately have pq3: "3 dvd p^2+3*q^2" by (simp add: power_mult_distrib)
      moreover from p3 have "3 dvd 2*p" by (rule dvd_mult)
      ultimately have g3: "3 dvd ?g" by (simp add: zgcd_greatest_iff)
      have qr_relprime: "zgcd q r = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and zq: "z dvd q" and "z dvd r"
        with r have "z dvd p" by simp
        with zq have "z dvd p+q \<and> z dvd p-q" by simp
        with vw have "z dvd zgcd v w" by (simp add: zgcd_greatest_iff)
        with vwx z show False by (auto simp add: zprime_def)
      qed
      have factors_relprime: "zgcd (18*r) (q^2 + 3*r^2) = 1"
      proof -
        from g3 obtain k where k: "?g = 3*k" by (auto simp add: dvd_def)
        have "k = 1"
        proof (rule ccontr)
          assume "k \<noteq> 1"
          with g1 k have "k > 1" by auto
          then obtain h where h: "zprime h \<and> h dvd k"
            by (frule_tac a="k" in zprime_factor_exists, blast)
          with k have hg: "3*h dvd ?g" by (auto simp add: mult_dvd_mono)
          hence "3*h dvd p^2 + 3*q^2" and hp: "3*h dvd 2*p"
            by (auto simp only: zgcd_greatest_iff)
          then obtain s where s: "p^2 + 3*q^2 = (3*h)*s"
            by (auto simp add: dvd_def)
          with r have rqh: "3*r^2+q^2 = h*s" by (simp add: power_mult_distrib)
          from hp r have "3*h dvd 3*(2*r)" by simp
          moreover have "(3::int) \<noteq> 0" by simp
          ultimately have "h dvd 2*r" by (rule zdvd_mult_cancel)
          with h have "h dvd 2 \<or> h dvd r" by (simp only: zprime_zdvd_zmult_general)
          moreover have "\<not> h dvd 2"
          proof (rule ccontr, simp)
            assume "h dvd 2"
            with h have "h=2" by (auto simp add: zdvd_not_zless zprime_def)
            with hg have "2*3 dvd ?g" by auto
            hence "2 dvd ?g" by (rule dvd_mult_left)
            with gOdd show False by simp
          qed
          ultimately have hr: "h dvd r" by simp
          then obtain t where "r = h*t" by (auto simp add: dvd_def)
          hence t: "r^2 = h*(h*t^2)" by (auto simp add: power2_eq_square)
          with rqh have "h*s = h*(3*h*t^2) + q^2" by simp
          hence "q^2 = h*(s - 3*h*t^2)" by (simp add: right_diff_distrib)
          hence "h dvd q^2" by simp
          with h have "h dvd q" by (auto dest: zprime_zdvd_power)
          with hr have "h dvd zgcd q r" by (simp add: zgcd_greatest_iff)
          with h qr_relprime show False by (unfold zprime_def, auto)
        qed
        with k r have "3 = zgcd (2*(3*r)) ((3*r)^2 + 3*q^2)" by auto
        also have "\<dots> = zgcd (3*(2*r)) (3*(3*r^2 + q^2))"
          by (simp add: power_mult_distrib)
        also have "\<dots> = 3 * zgcd (2*r) (3*r^2 + q^2)"
          by (simp only: zgcd_zmult_distrib2)
        finally have "zgcd (2*r) (3*r^2 + q^2) = 1" by auto
        moreover have "zgcd (3*3) (3*r^2 + q^2) = 1"
        proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
          fix h::int assume "h dvd 3*3" and h: "zprime h" and hrq: "h dvd 3*r^2 + q^2"
          hence "h dvd 3 \<or> h dvd 3" by (simp only: zprime_zdvd_zmult_general)
          hence h3: "h dvd 3" by simp
          have "h \<le> 3"
          proof (rule ccontr)
            assume "\<not> h \<le> 3" hence "h > 3" by simp
            with h3 show False by (auto simp add: zdvd_not_zless)
          qed
          with h have "h = 2 \<or> h = 3" by (unfold zprime_def, auto)
          with h h3 have "h = 3 \<or> (2::int) dvd 3" by auto
          hence "h=3" by arith
          with hrq obtain s where "3*r^2+q^2 = 3*s" by (auto simp add: dvd_def)
          hence "q^2 = 3*(s- r^2)" by auto
          hence "3 dvd q^2" and "zprime 3" by (auto simp only: dvd_triv_left zprime_3)
          hence "3 dvd q" by (rule_tac p="3" in zprime_zdvd_power)
          with p3 have "3 dvd p+q \<and> 3 dvd p-q" by simp
          with vw have "3 dvd zgcd v w" by (simp add: zgcd_greatest_iff)
          with vwx show False by auto
        qed
        ultimately have "zgcd ((3*3)*(2*r)) (3*r^2 + q^2) = 1"
          by (simp only: zgcd_zmult_cancel)
        thus ?thesis by (auto simp add: ac_simps ac_simps)
      qed
      moreover have rqx: "(18*r)*(q^2 + 3*r^2) = x^3"
      proof -
        from vwx vwpq have "x^3 = 2*p*(p^2 + 3*q^2)" by auto
        also with r have "\<dots> = 2*(3*r)*(9*r^2 + 3*q^2)"
          by (auto simp add: power2_eq_square)
        finally show ?thesis by auto
      qed
      moreover have triv3: "3 = nat 3 \<and> nat 3 > 1 \<and> 3 \<in> zOdd"
        by (unfold zOdd_def, auto)
      ultimately have "\<exists> c. 18*r = c^3"
        by (simp only: int_relprime_odd_power_divisors)
      then obtain c1 where c1: "c1^3 = 3*(6*r)" by auto
      hence "3 dvd c1^3" and "zprime 3" by (auto simp only: dvd_triv_left zprime_3)
      hence "3 dvd c1" by (rule_tac p="3" in zprime_zdvd_power)
      with c1 obtain c where c: "3*c^3 = 2*r"
        by (auto simp add: power_mult_distrib dvd_def)
      from rqx factors_relprime have "zgcd (q^2 + 3*r^2) (18*r) = 1"
        and "(q^2 + 3*r^2)*(18*r) = x^3" by (auto simp add: zgcd_commute ac_simps)
      with triv3 have "\<exists> d. q^2 + 3*r^2 = d^3"
        by (simp only: int_relprime_odd_power_divisors)
      then obtain d where d: "q^2 + 3*r^2 = d^3" by auto
      have "d \<in> zOdd"
      proof (rule ccontr)
        assume "d \<notin> zOdd" hence "d \<in> zEven" by (rule not_odd_impl_even)
        hence "d^3 \<in> zEven" by (simp only: power_preserves_even)
        hence "2 dvd d^3" by (simp add: zEven_def dvd_def)
        moreover have "2 dvd 2*(9*r)" by (rule dvd_triv_left)
        ultimately have "2 dvd zgcd (2*(9*r)) (d^3)" by (simp add: zgcd_greatest_iff)
        with d factors_relprime show False by auto
      qed
      with d qr_relprime have "zgcd q r=1 \<and> q^2 + 3*r^2 = d^3 \<and> d \<in> zOdd"
        by simp
      hence "is_cube_form q r" by (rule qf3_cube_impl_cube_form)
      then obtain a b where "q = a^3 - 9*a*b^2 \<and> r = 3*a^2*b - 3*b^3"
        by (unfold is_cube_form_def, auto)
      hence ab: "q = a*(a+3*b)*(a- 3*b) \<and> r = b*(a+b)*(a-b)*3"
        by (simp add: eval_nat_numeral field_simps)
      with c have abc: "(2*b)*(a+b)*(a-b) = c^3" by auto
      have ab_relprime: "zgcd a b=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and za: "z dvd a" and zb: "z dvd b"
        with ab have "z dvd q \<and> z dvd r" by simp
        with z qr_relprime show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have ab1: "zgcd (2*b) (a+b) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and "z dvd 2*b" and zab: "z dvd a+b"
        hence "z dvd 2 \<or> z dvd b" by (simp add: zprime_zdvd_zmult)
        moreover
        { assume z2: "z dvd 2"
          hence "z \<le> 2" by (simp only: zdvd_imp_le)
          with z have "z = 2" by (unfold zprime_def, auto)
          with zab have ab2: "2 dvd a+b" by simp
          moreover have "2 dvd 2*b" by (rule dvd_triv_left)
          ultimately have "2 dvd a+b+2*b" by (rule dvd_add)
          hence "2 dvd a+3*b" by arith
          hence "2 dvd (a+3*b)*((a- 3*b)*a)" by (rule dvd_mult2)
          with ab have qEven: "2 dvd q" by (simp only: ac_simps)
          from ab2 have "2 dvd (a+b)*((a-b)*3*b)" by (rule dvd_mult2)
          with ab have "2 dvd r" by (simp only: ac_simps)
          with qEven have "2 dvd zgcd q r" by (simp add: zgcd_greatest_iff)
          with qr_relprime have False by auto }
        moreover
        { assume zb: "z dvd b"
          with zab have "z dvd a+b-b" by (simp only: dvd_diff)
          hence "z dvd a" by simp
          with zb ab_relprime z have False
            by (auto simp add: zgcd1_iff_no_common_primedivisor) }
        ultimately show False by auto
      qed
      have ab2: "zgcd (a+b) (a-b) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and zab1: "z dvd a+b" and zab2: "z dvd a-b"
        hence "z dvd (a+b)-(a-b)" by (simp only: dvd_diff)
        hence "z dvd 2*b" by simp
        with zab1 z ab1 show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      have "zgcd (a-b) (2*b) = 1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and z2b: "z dvd 2*b" and zab: "z dvd a-b"
        hence "z dvd a-b+2*b" by (simp only: dvd_add)
        moreover have "a-b+2*b = a+b" by simp
        ultimately have "z dvd a+b" by simp
        with z2b z ab1 show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      with abc ab1 ab2 triv3 have "\<exists> k l m. 2*b = k^3 \<and> a+b = l^3 \<and> a-b = m^3"
        by (simp only: int_triple_relprime_odd_power_divisors)
      then obtain \<alpha>1 \<beta> \<gamma> where a1: "2*b = \<gamma>^3 \<and> a-b = \<alpha>1^3 \<and> a+b = \<beta>^3"
        by auto
      then obtain \<alpha> where "\<alpha> = -\<alpha>1" by auto
      -- "show this is a (smaller) solution"
      with triv3 a1 have a2: "\<alpha>^3 = b-a" by (auto simp only: neg_odd_power)
      with a1 have "\<alpha>^3 + \<beta>^3 = \<gamma>^3" by auto
      moreover have "\<alpha>*\<beta>*\<gamma> \<noteq> 0"
      proof (rule ccontr, safe)
        assume "\<alpha> * \<beta> * \<gamma> = 0"
        with a1 a2 ab have "r=0" by (auto simp add: power_0_left)
        with r vwpq vwx show False by auto
      qed
      moreover have "\<gamma> \<in> zEven"
      proof -
        have "2*b \<in> zEven" by (simp add: zEven_def)
        with a1 have "\<gamma>^3 \<in> zEven" by simp
        thus ?thesis by (simp only: power_preserves_even)
      qed
      moreover have "zgcd \<alpha> \<beta>=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix z assume z: "zprime z" and za: "z dvd \<alpha>" and zb: "z dvd \<beta>"
        hence "z dvd \<alpha> * \<alpha>^2 \<and> z dvd \<beta> * \<beta>^2" by simp
        hence "z dvd \<alpha>^Suc 2 \<and> z dvd \<beta>^Suc 2" by (auto simp only: power_Suc)
        with a1 a2 have "z dvd b-a \<and> z dvd a+b" by auto
        hence "z dvd -(b-a) \<and> z dvd a+b" by (auto simp only: dvd_minus_iff)
        with ab2 z show False
          by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      moreover have "nat\<bar>\<gamma>^3\<bar> < nat\<bar>x^3\<bar>"
      proof -
        let ?A = "p^2 + 3*q^2"
        from vwx vwpq have "x^3 = 2*p*?A" by auto
        also with r have "\<dots> = 6*r*?A" by auto
        also with ab have "\<dots> = 2*b*(9*(a+b)*(a-b)*?A)" by auto
        also with a1 have "\<dots> = \<gamma>^3 *(9*(a+b)*(a-b)*?A)" by auto
        finally have eq: "\<bar>x^3\<bar> = \<bar>\<gamma>^3\<bar> * \<bar>9*(a+b)*(a-b)*?A\<bar>"
          by (auto simp add: abs_mult)
        with `0 < nat\<bar>x^3\<bar>` have "\<bar>9*(a+b)*(a-b)*?A\<bar> > 0" by auto
        hence "\<bar>(a+b)*(a-b)*?A\<bar> \<ge> 1" by arith
        hence "\<bar>9*(a+b)*(a-b)*?A\<bar> > 1" by arith
        moreover have "\<bar>\<gamma>^3\<bar> > 0"
        proof -
          from eq have "\<bar>\<gamma>^3\<bar> = 0 \<Longrightarrow> \<bar>x^3\<bar>=0" by auto
          with `0 < nat\<bar>x^3\<bar>` show ?thesis by auto
        qed
        ultimately have "\<bar>\<gamma>^3\<bar> * 1 < \<bar>\<gamma>^3\<bar> * \<bar>9*(a+b)*(a-b)*?A\<bar>"
          by (rule zmult_zless_mono2)
        with eq have "\<bar>x^3\<bar> > \<bar>\<gamma>^3\<bar>" by auto
        thus ?thesis by arith
      qed
      ultimately have ?thesis by auto }
    ultimately show ?thesis by auto
  qed
  thus ?case by auto
qed

text {* The theorem. Puts equation in requested shape. *}

theorem fermat3:
  assumes ass: "(x::int)^3 + y^3 = z^3"
  shows "x*y*z=0"
proof (rule ccontr)
  let ?g = "zgcd x y"
  let ?c = "z div ?g"
  assume xyz0: "x*y*z\<noteq>0"
  -- "divide out the g.c.d."
  hence "x \<noteq> 0 \<or> y \<noteq> 0" by simp
  then obtain a b where ab: "x = ?g*a \<and> y = ?g*b \<and> zgcd a b=1"
    by (frule_tac a="x" in make_zrelprime, auto)
  moreover have abc: "?c*?g = z \<and> a^3 + b^3 = ?c^3 \<and> a*b*?c \<noteq> 0"
  proof -
    from xyz0 have g0: "?g\<noteq>0" by (simp add: zgcd_def gcd_zero)
    have zgab: "z^3 = ?g^3 * (a^3+b^3)"
    proof -
      from ab and ass have "z^3 = (?g*a)^3+(?g*b)^3" by simp
      thus ?thesis by (simp only: power_mult_distrib distrib_left)
    qed
    have cgz: "?c * ?g = z"
    proof -
      from zgab have "?g^3 dvd z^3" by simp
      hence "?g dvd z" by (simp only: zpower_zdvd_mono)
      thus ?thesis by (simp only: ac_simps dvd_mult_div_cancel)
    qed
    moreover have "a^3 + b^3 = ?c^3"
    proof -
      have "?c^3 * ?g^3 = (a^3+b^3)*?g^3"
      proof -
        have "?c^3 * ?g^3 = (?c*?g)^3" by (simp only: power_mult_distrib)
        also with cgz have "\<dots> = z^3" by simp
        also with zgab have "\<dots> = ?g^3*(a^3+b^3)" by simp
        finally show ?thesis by simp
      qed
      with g0 show ?thesis by auto
    qed
    moreover from ab and xyz0 and cgz have "a*b*?c\<noteq>0" by auto
    ultimately show ?thesis by simp
  qed
  -- "make both sides even"
  have "\<exists> u v w. u^3 + v^3 = w^3 \<and> u*v*w\<noteq>0 \<and> w \<in> zEven \<and> zgcd u v = 1"
  proof -
    let "?Q u v w" = "u^3 + v^3 = w^3 \<and> u*v*w\<noteq>0 \<and> w \<in> zEven \<and> zgcd u v=1"
    have "a \<in> zEven \<or> b \<in> zEven \<or> ?c \<in> zEven"
    proof (rule ccontr)
      assume "\<not>(a \<in> zEven \<or> b \<in> zEven \<or> ?c \<in> zEven)"
      hence aodd: "a \<in> zOdd" and "b \<in> zOdd \<and> ?c \<in> zOdd"
        by (auto simp add: odd_iff_not_even)
      hence "?c^3 - b^3 \<in> zEven" by (simp only: power_preserves_odd odd_minus_odd)
      moreover from abc have "?c^3-b^3 = a^3" by simp
      ultimately have "a^3 \<in> zEven" by auto
      hence "a \<in> zEven" by (simp only: power_preserves_even)
      with aodd show False by (simp add: odd_iff_not_even)
    qed
    moreover
    { assume "a \<in> zEven"
      then obtain u v w where uvwabc: "u = -b \<and> v = ?c \<and> w = a \<and> w \<in> zEven"
        by auto
      moreover with abc have "u*v*w\<noteq>0" by auto
      moreover have uvw: "u^3+v^3=w^3"
      proof -
        from uvwabc have "u^3 + v^3 = (-1*b)^3 + ?c^3" by simp
        also have "\<dots> = (-1)^3*b^3 + ?c^3" by (simp only: power_mult_distrib)
        also have "\<dots> = - (b^3) + ?c^3" by (auto simp add: neg_one_odd_power)
        also with abc and uvwabc have "\<dots> = w^3" by auto
        finally show ?thesis by simp
      qed
      moreover have "zgcd u v=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix h::int assume hu: "h dvd u" and "h dvd v" and h: "zprime h"
        with uvwabc have "h dvd ?c*?c^2" by (simp only: dvd_mult2)
        with abc have "h dvd a^3+b^3" by (simp only: cube_square)
        moreover from hu uvwabc have "h dvd b*b^2" by simp
        ultimately have "h dvd a^3+b^3-b^3" by (simp only: cube_square dvd_diff)
        with h hu uvwabc have "h dvd a \<and> h dvd b" by (auto dest: zprime_zdvd_power)
        with h ab show False by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      ultimately have "?Q u v w" using `a \<in> zEven` by simp
      hence ?thesis by auto }
    moreover
    { assume "b \<in> zEven"
      then obtain u v w where uvwabc: "u = -a \<and> v = ?c \<and> w = b \<and> w \<in> zEven"
        by auto
      moreover with abc have "u*v*w\<noteq>0" by auto
      moreover have uvw: "u^3+v^3=w^3"
      proof -
        from uvwabc have "u^3 + v^3 = (-1*a)^3 + ?c^3" by simp
        also have "\<dots> = (-1)^3*a^3 + ?c^3" by (simp only: power_mult_distrib)
        also have "\<dots> = - (a^3) + ?c^3" by (auto simp add: neg_one_odd_power)
        also with abc and uvwabc have "\<dots> = w^3" by auto
        finally show ?thesis by simp
      qed
      moreover have "zgcd u v=1"
      proof (simp only: zgcd1_iff_no_common_primedivisor, clarify)
        fix h::int assume hu: "h dvd u" and "h dvd v" and h: "zprime h"
        with uvwabc have "h dvd ?c*?c^2" by (simp only: dvd_mult2)
        with abc have "h dvd a^3+b^3" by (simp only: cube_square)
        moreover from hu uvwabc have "h dvd a*a^2" by simp
        ultimately have "h dvd a^3+b^3-a^3" by (simp only: cube_square dvd_diff)
        with h hu uvwabc have "h dvd a \<and> h dvd b" by (auto dest: zprime_zdvd_power)
        with h ab show False by (auto simp add: zgcd1_iff_no_common_primedivisor)
      qed
      ultimately have "?Q u v w" using `b \<in> zEven` by simp
      hence ?thesis by auto }
    moreover
    { assume "?c \<in> zEven"
      then obtain u v w where uvwabc: "u = a \<and> v = b \<and> w = ?c \<and> w \<in> zEven"
        by auto
      with abc ab have ?thesis by auto }
    ultimately show ?thesis by auto
  qed
  hence "\<exists> w. \<exists> u v. u^3 + v^3 = w^3 \<and> u*v*w \<noteq> 0 \<and> w \<in> zEven \<and> zgcd u v=1"
    by auto
  -- "show contradiction using the earlier result"
  thus False by (auto simp only: no_rewritten_fermat3)
qed

corollary fermat_mult3:
  assumes xyz: "(x::int)^n + y^n = z^n" and n: "3 dvd n"
  shows "x*y*z=0"
proof -
  from n obtain m where "n = m*3" by (auto simp only: ac_simps dvd_def)
  with xyz have "(x^m)^3 + (y^m)^3 = (z^m)^3" by (simp only: power_mult)
  hence "(x^m)*(y^m)*(z^m) = 0" by (rule fermat3)
  thus ?thesis by auto
qed

end


(* D. Fuenmayor and A. Steen, August 2021 *)
(* This file contains various meta-theoretical properties of different argumentation semantics. *)
(* Auxiliary references:
 [BCG 2011] Baroni, P., M. Caminada and M. Giacomin, An introduction to argumentation semantics,
            Knowledge Engineering Review (2011)
 [Dung 1995] Dung, P.M., On the acceptability of arguments and its fundamental role in nonmonotonic reasoning,
             logic programming and n-person games, Artificial Intelligence. (1995)
*)
theory "adequacy"
  imports "extensions" "labellings" "Zorn-lemma" "ext-properties" "lab-properties"
begin

(*** Properties as stated in JLC article section 4.2. Lemma numbering as in the article.  ****)
(* -- except for those about correspondences: they are in correspondence.thy
   -- and those about relationships between semantics: they are in ext-relationships.thy and
      lab-relationships.thy.
*)

(* Lemma 4.3:  no self-attacks in conflict-free extension  [BCG textual on p.8] *)
lemma cf_noselfattacks: \<open>conflictfreeExt\<^sup>\<A> att S \<Longrightarrow> \<not> (\<exists>\<^sup>\<A> (\<lambda>a. (S a) \<and> (att a a))) \<close>
  by (simp add: conflictfreeExt_def)

(* Lemma 4.4:  the characteristic function preserves conflict-freeness. *)
lemma cf_preserveChar: \<open>conflictfreeExt\<^sup>\<A> att S \<Longrightarrow> conflictfreeExt\<^sup>\<A> att (\<F>\<^sup>\<A> att S)\<close>
  by (smt (verit) conflictfreeExt_def defends_rel_def)

(* Lemma 4.5: A conflict-free set S is admissible iff it is a subset of \<F>(S).
   [Dung, Lemma 18] *)
lemma cf_admissibleChar: \<open>conflictfreeExt\<^sup>\<A> att S \<Longrightarrow> admissibleExt\<^sup>\<A> att S \<longleftrightarrow> S \<subseteq>\<^sup>\<A> \<F>\<^sup>\<A> att S\<close>
  by (simp add: admissibleExt_def)

(* Lemma 4.6: Admissible sets can be extended with defended arguments (Dung's Fundamental Lemma)
   [Dung, Lemma 10] *)
lemma dung_fundlemma_1: \<open>(admissibleExt\<^sup>\<A> att S) \<and> (defends\<^sup>\<A> att S a) \<Longrightarrow> admissibleExt\<^sup>\<A> att (S \<union> \<lbrace>a\<rbrace>)\<close>
  by (smt (z3) admissibleExt_def conflictfreeExt_def defends_rel_def)

lemma dung_fundlemma_2: \<open>(admissibleExt\<^sup>\<A> att S) \<and> (defends\<^sup>\<A> att S a) \<and> (defends\<^sup>\<A> att S a') \<Longrightarrow> defends\<^sup>\<A> att (S \<union> \<lbrace>a\<rbrace>) a'\<close>
  by (metis (full_types, lifting) MONO_def \<F>_mono')

(* Lemma 4.7: Admissible sets form a \<omega>-complete CPO wrt. set-inclusion
   [Dung, Theorem 11, Part (1)] *)
(* We can, in fact, prove a stronger statement: admissible extensions form a dcpo*)
lemma admissibleDirectedComplete: "dcpo\<^sup>\<A> (admissibleExt\<^sup>\<A> AF)"
  unfolding admissibleExt_def conflictfreeExt_def defends_rel_def directedcomplete_rel_def directed_rel_def
    supremum_def by meson
lemma admissibleOmegaComplete: "\<omega>-cpo\<^sup>\<A> (admissibleExt\<^sup>\<A> AF)" by (simp add: admissibleDirectedComplete dcpo_\<omega>_rel)

(* Lemma 4.8: For each admissible set there exists a preferred extension extending it.
   [Dung, Theorem 11, Part (2)] *)
lemma DungTh11: "admissibleExt\<^sup>\<A> att S \<longrightarrow> (\<exists>E. S \<subseteq>\<^sup>\<A> E \<and> preferredExt\<^sup>\<A> att E)"
  using ZornLemma2_\<omega>_rel admissibleOmegaComplete
  by (metis preferredExt2_def preferredExt_defEq)

(* Lemma 4.9: Conflict-free sets are complete iff they are fixed-points of \<F> *)
lemma complete_fix: \<open>conflictfreeExt\<^sup>\<A> att S \<Longrightarrow> completeExt\<^sup>\<A> att S \<longleftrightarrow> S \<approx>\<^sup>\<A> \<F>\<^sup>\<A> att S\<close>
  by (metis admissibleExt_def completeExt_def)

(* Lemma 4.10: Complete, preferred and grounded extensions always exist *)
lemma completeExtExists: \<open>\<exists>E. completeExt\<^sup>\<A> att E\<close>
  by (metis DungTh11 emptyAdmissible maximal_rel_def preferredExt_def)
lemma preferredExtExists: \<open>\<exists>E. preferredExt\<^sup>\<A> att E\<close>
  by (meson DungTh11 emptyAdmissible maximal_rel_def preferredExt_def)
lemma groundedExtExists: \<open>\<exists>E. groundedExt\<^sup>\<A> att E\<close>
  by (meson \<F>_leastFP_ex groundedExt3_def groundedExt_defEq1 groundedExt_defEq2 DungTh11 emptyAdmissible minimal_rel_def groundedExt_def)

(* Lemma 4.11: Grounded labellings can equivalently be characterized by minimal in-sets
   and minimal out-sets [BCG11, Prop. 5]*)
lemma complete_sets_mono: \<open>completeLab\<^sup>\<A> att Lab1 \<and> completeLab\<^sup>\<A> att Lab2 \<Longrightarrow> in(Lab1) \<subseteq>\<^sup>\<A> in(Lab2) \<longleftrightarrow> out(Lab1) \<subseteq>\<^sup>\<A> out(Lab2)\<close>
  unfolding completeLab_def inset_def outset_def
  by (smt (z3) Label.exhaust admissibleLab_def inset_def legallyIn_def legallyOut_def legallyUndec_def outset_def undecset_def)

lemma complete_min_inout: \<open>minimal\<^sup>\<A>  (completeLab\<^sup>\<A> att) Lab in \<longleftrightarrow> minimal\<^sup>\<A>  (completeLab\<^sup>\<A> att) Lab out \<close>
  by (smt (verit) complete_sets_mono minimal_rel_def)

(* Lemma 4.12: grounded extensions resp. labellings are unique [BCG11, Prop. 4] *)
lemma \<open>groundedExt\<^sup>\<A> att E \<longleftrightarrow> least\<^sup>\<A> (completeExt\<^sup>\<A> att) E id\<close>
  by (simp add: groundedExt2_def groundedExt_defEq1)
lemma \<open>groundedLab\<^sup>\<A> att Lab \<longleftrightarrow> least\<^sup>\<A> (groundedLab\<^sup>\<A> att) Lab in\<close>
  by (metis (full_types) grounded_unique inset_def least_rel_def)

(* Lemma 4.13: Preferred labellings can equivalently be characterized by maximal in-sets
   and maximal out-sets [BCG11, Prop. 8]*)
lemma preferred_max_inout: \<open>maximal\<^sup>\<A>  (completeLab\<^sup>\<A> att) Lab in \<longleftrightarrow> maximal\<^sup>\<A>  (completeLab\<^sup>\<A> att) Lab out \<close>
  using prop8 by auto

(* Relationships between different semantics: See ext-relationships.thy and lab-relationships.thy *)
(* Correspondences: See correspondence.thy *)

(* Further properties not mentioned in the article *)
lemma \<open>conflictfreeExt\<^sup>\<A> att S \<and>  minimal\<^sup>\<A> (fixpoint\<^sup>\<A> (\<F>\<^sup>\<A> att)) S id \<Longrightarrow> lfp\<^sup>\<A> att S  \<close>
  by (meson \<F>_leastFP_ex lfpR_def minLeastCollapse_rel)

lemma emptyset_is_cf: \<open>conflictfreeExt\<^sup>\<A> att (\<lambda>x. False)\<close>
  by (simp add: conflictfreeExt_def)

lemma char_is_cf: \<open>conflictfreeExt\<^sup>\<A> att (\<F>\<^sup>\<A> att (\<lambda>x. False))\<close>
  by (simp add: cf_preserveChar emptyset_is_cf)

lemma \<open> maximal\<^sup>\<A> (completeLab\<^sup>\<A> att) Lab in \<longleftrightarrow>  maximal\<^sup>\<A> (completeLab\<^sup>\<A> att) Lab out\<close>
  by (smt (verit) complete_sets_mono maximal_rel_def)

lemma \<open> maximal\<^sup>\<A> (admissibleExt\<^sup>\<A> att) S id \<Longrightarrow>  maximal\<^sup>\<A> (completeExt\<^sup>\<A> att) S id\<close>
  unfolding maximal_rel_def completeExt_def admissibleExt_def by (smt (z3) conflictfreeExt_def defends_rel_def id_apply)

end


(*
Author: Tobias Nipkow, Daniel Stüwe
*)

section \<open>AA Tree Implementation of Sets\<close>

theory AA_Set
imports
  Isin2
  Cmp
begin

type_synonym 'a aa_tree = "('a,nat) tree"

fun lvl :: "'a aa_tree \<Rightarrow> nat" where
"lvl Leaf = 0" |
"lvl (Node lv _ _ _) = lv"

fun invar :: "'a aa_tree \<Rightarrow> bool" where
"invar Leaf = True" |
"invar (Node h l a r) =
 (invar l \<and> invar r \<and>
  h = lvl l + 1 \<and> (h = lvl r + 1 \<or> (\<exists>lr b rr. r = Node h lr b rr \<and> h = lvl rr + 1)))"

fun skew :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
"skew (Node lva (Node lvb t1 b t2) a t3) =
  (if lva = lvb then Node lva t1 b (Node lva t2 a t3) else Node lva (Node lvb t1 b t2) a t3)" |
"skew t = t"

fun split :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
"split (Node lva t1 a (Node lvb t2 b (Node lvc t3 c t4))) =
   (if lva = lvb \<and> lvb = lvc (* lva = lvc suffices *)
    then Node (lva+1) (Node lva t1 a t2) b (Node lva t3 c t4)
    else Node lva t1 a (Node lvb t2 b (Node lvc t3 c t4)))" |
"split t = t"

hide_const (open) insert

fun insert :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
"insert x Leaf = Node 1 Leaf x Leaf" |
"insert x (Node lv t1 a t2) =
  (case cmp x a of
     LT \<Rightarrow> split (skew (Node lv (insert x t1) a t2)) |
     GT \<Rightarrow> split (skew (Node lv t1 a (insert x t2))) |
     EQ \<Rightarrow> Node lv t1 x t2)"

fun sngl :: "'a aa_tree \<Rightarrow> bool" where
"sngl Leaf = False" |
"sngl (Node _ _ _ Leaf) = True" |
"sngl (Node lva _ _ (Node lvb _ _ _)) = (lva > lvb)"

definition adjust :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
"adjust t =
 (case t of
  Node lv l x r \<Rightarrow>
   (if lvl l >= lv-1 \<and> lvl r >= lv-1 then t else
    if lvl r < lv-1 \<and> sngl l then skew (Node (lv-1) l x r) else
    if lvl r < lv-1
    then case l of
           Node lva t1 a (Node lvb t2 b t3)
             \<Rightarrow> Node (lvb+1) (Node lva t1 a t2) b (Node (lv-1) t3 x r)
    else
    if lvl r < lv then split (Node (lv-1) l x r)
    else
      case r of
        Node lvb t1 b t4 \<Rightarrow>
          (case t1 of
             Node lva t2 a t3
               \<Rightarrow> Node (lva+1) (Node (lv-1) l x t2) a
                    (split (Node (if sngl t1 then lva else lva+1) t3 b t4)))))"

text{* In the paper, the last case of @{const adjust} is expressed with the help of an
incorrect auxiliary function \texttt{nlvl}.

Function @{text del_max} below is called \texttt{dellrg} in the paper.
The latter is incorrect for two reasons: \texttt{dellrg} is meant to delete the largest
element but recurses on the left instead of the right subtree; the invariant
is not restored.*}

fun del_max :: "'a aa_tree \<Rightarrow> 'a aa_tree * 'a" where
"del_max (Node lv l a Leaf) = (l,a)" |
"del_max (Node lv l a r) = (let (r',b) = del_max r in (adjust(Node lv l a r'), b))"

fun delete :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
"delete _ Leaf = Leaf" |
"delete x (Node lv l a r) =
  (case cmp x a of
     LT \<Rightarrow> adjust (Node lv (delete x l) a r) |
     GT \<Rightarrow> adjust (Node lv l a (delete x r)) |
     EQ \<Rightarrow> (if l = Leaf then r
            else let (l',b) = del_max l in adjust (Node lv l' b r)))"

fun pre_adjust where
"pre_adjust (Node lv l a r) = (invar l \<and> invar r \<and>
    ((lv = lvl l + 1 \<and> (lv = lvl r + 1 \<or> lv = lvl r + 2 \<or> lv = lvl r \<and> sngl r)) \<or>
     (lv = lvl l + 2 \<and> (lv = lvl r + 1 \<or> lv = lvl r \<and> sngl r))))"

declare pre_adjust.simps [simp del]

subsection "Auxiliary Proofs"

lemma split_case: "split t = (case t of
  Node lvx a x (Node lvy b y (Node lvz c z d)) \<Rightarrow>
   (if lvx = lvy \<and> lvy = lvz
    then Node (lvx+1) (Node lvx a x b) y (Node lvx c z d)
    else t)
  | t \<Rightarrow> t)"
by(auto split: tree.split)

lemma skew_case: "skew t = (case t of
  Node lvx (Node lvy a y b) x c \<Rightarrow>
  (if lvx = lvy then Node lvx a y (Node lvx b x c) else t)
 | t \<Rightarrow> t)"
by(auto split: tree.split)

lemma lvl_0_iff: "invar t \<Longrightarrow> lvl t = 0 \<longleftrightarrow> t = Leaf"
by(cases t) auto

lemma lvl_Suc_iff: "lvl t = Suc n \<longleftrightarrow> (\<exists> l a r. t = Node (Suc n) l a r)"
by(cases t) auto

lemma lvl_skew: "lvl (skew t) = lvl t"
by(cases t rule: skew.cases) auto

lemma lvl_split: "lvl (split t) = lvl t \<or> lvl (split t) = lvl t + 1 \<and> sngl (split t)"
by(cases t rule: split.cases) auto

lemma invar_2Nodes:"invar (Node lv l x (Node rlv rl rx rr)) =
     (invar l \<and> invar \<langle>rlv, rl, rx, rr\<rangle> \<and> lv = Suc (lvl l) \<and>
     (lv = Suc rlv \<or> rlv = lv \<and> lv = Suc (lvl rr)))"
by simp

lemma invar_NodeLeaf[simp]:
  "invar (Node lv l x Leaf) = (invar l \<and> lv = Suc (lvl l) \<and> lv = Suc 0)"
by simp

lemma sngl_if_invar: "invar (Node n l a r) \<Longrightarrow> n = lvl r \<Longrightarrow> sngl r"
by(cases r rule: sngl.cases) clarsimp+

subsection "Invariance"

subsubsection "Proofs for insert"

lemma lvl_insert_aux:
  "lvl (insert x t) = lvl t \<or> lvl (insert x t) = lvl t + 1 \<and> sngl (insert x t)"
apply(induction t)
apply (auto simp: lvl_skew)
apply (metis Suc_eq_plus1 lvl.simps(2) lvl_split lvl_skew)+
done

lemma lvl_insert: obtains
  (Same) "lvl (insert x t) = lvl t" |
  (Incr) "lvl (insert x t) = lvl t + 1" "sngl (insert x t)"
using lvl_insert_aux by blast

lemma lvl_insert_sngl: "invar t \<Longrightarrow> sngl t \<Longrightarrow> lvl(insert x t) = lvl t"
proof (induction t rule: insert.induct)
  case (2 x lv t1 a t2)
  consider (LT) "x < a" | (GT) "x > a" | (EQ) "x = a"
    using less_linear by blast
  thus ?case proof cases
    case LT
    thus ?thesis using 2 by (auto simp add: skew_case split_case split: tree.splits)
  next
    case GT
    thus ?thesis using 2 proof (cases t1)
      case Node
      thus ?thesis using 2 GT
        apply (auto simp add: skew_case split_case split: tree.splits)
        by (metis less_not_refl2 lvl.simps(2) lvl_insert_aux n_not_Suc_n sngl.simps(3))+
    qed (auto simp add: lvl_0_iff)
  qed simp
qed simp

lemma skew_invar: "invar t \<Longrightarrow> skew t = t"
by(cases t rule: skew.cases) auto

lemma split_invar: "invar t \<Longrightarrow> split t = t"
by(cases t rule: split.cases) clarsimp+

lemma invar_NodeL:
  "\<lbrakk> invar(Node n l x r); invar l'; lvl l' = lvl l \<rbrakk> \<Longrightarrow> invar(Node n l' x r)"
by(auto)

lemma invar_NodeR:
  "\<lbrakk> invar(Node n l x r); n = lvl r + 1; invar r'; lvl r' = lvl r \<rbrakk> \<Longrightarrow> invar(Node n l x r')"
by(auto)

lemma invar_NodeR2:
  "\<lbrakk> invar(Node n l x r); sngl r'; n = lvl r + 1; invar r'; lvl r' = n \<rbrakk> \<Longrightarrow> invar(Node n l x r')"
by(cases r' rule: sngl.cases) clarsimp+

lemma lvl_insert_incr_iff: "(lvl(insert a t) = lvl t + 1) \<longleftrightarrow>
  (EX l x r. insert a t = Node (lvl t + 1) l x r \<and> lvl l = lvl r)"
apply(cases t)
apply(auto simp add: skew_case split_case split: if_splits)
apply(auto split: tree.splits if_splits)
done

lemma invar_insert: "invar t \<Longrightarrow> invar(insert a t)"
proof(induction t)
  case (Node n l x r)
  hence il: "invar l" and ir: "invar r" by auto
  note N = Node
  let ?t = "Node n l x r"
  have "a < x \<or> a = x \<or> x < a" by auto
  moreover
  { assume "a < x"
    note iil = Node.IH(1)[OF il]
    have ?case
    proof (cases rule: lvl_insert[of a l])
      case (Same) thus ?thesis
        using \<open>a<x\<close> invar_NodeL[OF Node.prems iil Same]
        by (simp add: skew_invar split_invar del: invar.simps)
    next
      case (Incr)
      then obtain t1 w t2 where ial[simp]: "insert a l = Node n t1 w t2"
        using Node.prems by (auto simp: lvl_Suc_iff)
      have l12: "lvl t1 = lvl t2"
        by (metis Incr(1) ial lvl_insert_incr_iff tree.inject)
      have "insert a ?t = split(skew(Node n (insert a l) x r))"
        by(simp add: \<open>a<x\<close>)
      also have "skew(Node n (insert a l) x r) = Node n t1 w (Node n t2 x r)"
        by(simp)
      also have "invar(split \<dots>)"
      proof (cases r)
        case Leaf
        hence "l = Leaf" using Node.prems by(auto simp: lvl_0_iff)
        thus ?thesis using Leaf ial by simp
      next
        case [simp]: (Node m t3 y t4)
        show ?thesis (*using N(3) iil l12 by(auto)*)
        proof cases
          assume "m = n" thus ?thesis using N(3) iil by(auto)
        next
          assume "m \<noteq> n" thus ?thesis using N(3) iil l12 by(auto)
        qed
      qed
      finally show ?thesis .
    qed
  }
  moreover
  { assume "x < a"
    note iir = Node.IH(2)[OF ir]
    from \<open>invar ?t\<close> have "n = lvl r \<or> n = lvl r + 1" by auto
    hence ?case
    proof
      assume 0: "n = lvl r"
      have "insert a ?t = split(skew(Node n l x (insert a r)))"
        using \<open>a>x\<close> by(auto)
      also have "skew(Node n l x (insert a r)) = Node n l x (insert a r)"
        using Node.prems by(simp add: skew_case split: tree.split)
      also have "invar(split \<dots>)"
      proof -
        from lvl_insert_sngl[OF ir sngl_if_invar[OF \<open>invar ?t\<close> 0], of a]
        obtain t1 y t2 where iar: "insert a r = Node n t1 y t2"
          using Node.prems 0 by (auto simp: lvl_Suc_iff)
        from Node.prems iar 0 iir
        show ?thesis by (auto simp: split_case split: tree.splits)
      qed
      finally show ?thesis .
    next
      assume 1: "n = lvl r + 1"
      hence "sngl ?t" by(cases r) auto
      show ?thesis
      proof (cases rule: lvl_insert[of a r])
        case (Same)
        show ?thesis using \<open>x<a\<close> il ir invar_NodeR[OF Node.prems 1 iir Same]
          by (auto simp add: skew_invar split_invar)
      next
        case (Incr)
        thus ?thesis using invar_NodeR2[OF `invar ?t` Incr(2) 1 iir] 1 \<open>x < a\<close>
          by (auto simp add: skew_invar split_invar split: if_splits)
      qed
    qed
  }
  moreover { assume "a = x" hence ?case using Node.prems by auto }
  ultimately show ?case by blast
qed simp

subsubsection "Proofs for delete"

lemma invarL: "ASSUMPTION(invar \<langle>lv, l, a, r\<rangle>) \<Longrightarrow> invar l"
by(simp add: ASSUMPTION_def)

lemma invarR: "ASSUMPTION(invar \<langle>lv, l, a, r\<rangle>) \<Longrightarrow> invar r"
by(simp add: ASSUMPTION_def)

lemma sngl_NodeI:
  "sngl (Node lv l a r) \<Longrightarrow> sngl (Node lv l' a' r)"
by(cases r) (simp_all)

declare invarL[simp] invarR[simp]

lemma pre_cases:
assumes "pre_adjust (Node lv l x r)"
obtains
 (tSngl) "invar l \<and> invar r \<and>
    lv = Suc (lvl r) \<and> lvl l = lvl r" |
 (tDouble) "invar l \<and> invar r \<and>
    lv = lvl r \<and> Suc (lvl l) = lvl r \<and> sngl r " |
 (rDown) "invar l \<and> invar r \<and>
    lv = Suc (Suc (lvl r)) \<and>  lv = Suc (lvl l)" |
 (lDown_tSngl) "invar l \<and> invar r \<and>
    lv = Suc (lvl r) \<and> lv = Suc (Suc (lvl l))" |
 (lDown_tDouble) "invar l \<and> invar r \<and>
    lv = lvl r \<and> lv = Suc (Suc (lvl l)) \<and> sngl r"
using assms unfolding pre_adjust.simps
by auto

declare invar.simps(2)[simp del] invar_2Nodes[simp add]

lemma invar_adjust:
  assumes pre: "pre_adjust (Node lv l a r)"
  shows  "invar(adjust (Node lv l a r))"
using pre proof (cases rule: pre_cases)
  case (tDouble) thus ?thesis unfolding adjust_def by (cases r) (auto simp: invar.simps(2))
next
  case (rDown)
  from rDown obtain llv ll la lr where l: "l = Node llv ll la lr" by (cases l) auto
  from rDown show ?thesis unfolding adjust_def by (auto simp: l invar.simps(2) split: tree.splits)
next
  case (lDown_tDouble)
  from lDown_tDouble obtain rlv rr ra rl where r: "r = Node rlv rl ra rr" by (cases r) auto
  from lDown_tDouble and r obtain rrlv rrr rra rrl where
    rr :"rr = Node rrlv rrr rra rrl" by (cases rr) auto
  from  lDown_tDouble show ?thesis unfolding adjust_def r rr
    apply (cases rl) apply (auto simp add: invar.simps(2) split!: if_split)
    using lDown_tDouble by (auto simp: split_case lvl_0_iff  elim:lvl.elims split: tree.split)
qed (auto simp: split_case invar.simps(2) adjust_def split: tree.splits)

lemma lvl_adjust:
  assumes "pre_adjust (Node lv l a r)"
  shows "lv = lvl (adjust(Node lv l a r)) \<or> lv = lvl (adjust(Node lv l a r)) + 1"
using assms(1) proof(cases rule: pre_cases)
  case lDown_tSngl thus ?thesis
    using lvl_split[of "\<langle>lvl r, l, a, r\<rangle>"] by (auto simp: adjust_def)
next
  case lDown_tDouble thus ?thesis
    by (auto simp: adjust_def invar.simps(2) split: tree.split)
qed (auto simp: adjust_def split: tree.splits)

lemma sngl_adjust: assumes "pre_adjust (Node lv l a r)"
  "sngl \<langle>lv, l, a, r\<rangle>" "lv = lvl (adjust \<langle>lv, l, a, r\<rangle>)"
  shows "sngl (adjust \<langle>lv, l, a, r\<rangle>)"
using assms proof (cases rule: pre_cases)
  case rDown
  thus ?thesis using assms(2,3) unfolding adjust_def
    by (auto simp add: skew_case) (auto split: tree.split)
qed (auto simp: adjust_def skew_case split_case split: tree.split)

definition "post_del t t' ==
  invar t' \<and>
  (lvl t' = lvl t \<or> lvl t' + 1 = lvl t) \<and>
  (lvl t' = lvl t \<and> sngl t \<longrightarrow> sngl t')"

lemma pre_adj_if_postR:
  "invar\<langle>lv, l, a, r\<rangle> \<Longrightarrow> post_del r r' \<Longrightarrow> pre_adjust \<langle>lv, l, a, r'\<rangle>"
by(cases "sngl r")
  (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)

lemma pre_adj_if_postL:
  "invar\<langle>lv, l, a, r\<rangle> \<Longrightarrow> post_del l l' \<Longrightarrow> pre_adjust \<langle>lv, l', b, r\<rangle>"
by(cases "sngl r")
  (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)

lemma post_del_adjL:
  "\<lbrakk> invar\<langle>lv, l, a, r\<rangle>; pre_adjust \<langle>lv, l', b, r\<rangle> \<rbrakk>
  \<Longrightarrow> post_del \<langle>lv, l, a, r\<rangle> (adjust \<langle>lv, l', b, r\<rangle>)"
unfolding post_del_def
by (metis invar_adjust lvl_adjust sngl_NodeI sngl_adjust lvl.simps(2))

lemma post_del_adjR:
assumes "invar\<langle>lv, l, a, r\<rangle>" "pre_adjust \<langle>lv, l, a, r'\<rangle>" "post_del r r'"
shows "post_del \<langle>lv, l, a, r\<rangle> (adjust \<langle>lv, l, a, r'\<rangle>)"
proof(unfold post_del_def, safe del: disjCI)
  let ?t = "\<langle>lv, l, a, r\<rangle>"
  let ?t' = "adjust \<langle>lv, l, a, r'\<rangle>"
  show "invar ?t'" by(rule invar_adjust[OF assms(2)])
  show "lvl ?t' = lvl ?t \<or> lvl ?t' + 1 = lvl ?t"
    using lvl_adjust[OF assms(2)] by auto
  show "sngl ?t'" if as: "lvl ?t' = lvl ?t" "sngl ?t"
  proof -
    have s: "sngl \<langle>lv, l, a, r'\<rangle>"
    proof(cases r')
      case Leaf thus ?thesis by simp
    next
      case Node thus ?thesis using as(2) assms(1,3)
      by (cases r) (auto simp: post_del_def)
    qed
    show ?thesis using as(1) sngl_adjust[OF assms(2) s] by simp
  qed
qed

declare prod.splits[split]

theorem post_del_max:
 "\<lbrakk> invar t; (t', x) = del_max t; t \<noteq> Leaf \<rbrakk> \<Longrightarrow> post_del t t'"
proof (induction t arbitrary: t' rule: del_max.induct)
  case (2 lv l a lvr rl ra rr)
  let ?r =  "\<langle>lvr, rl, ra, rr\<rangle>"
  let ?t = "\<langle>lv, l, a, ?r\<rangle>"
  from "2.prems"(2) obtain r' where r': "(r', x) = del_max ?r"
    and [simp]: "t' = adjust \<langle>lv, l, a, r'\<rangle>" by auto
  from  "2.IH"[OF _ r'] \<open>invar ?t\<close> have post: "post_del ?r r'" by simp
  note preR = pre_adj_if_postR[OF \<open>invar ?t\<close> post]
  show ?case by (simp add: post_del_adjR[OF "2.prems"(1) preR post])
qed (auto simp: post_del_def)

theorem post_delete: "invar t \<Longrightarrow> post_del t (delete x t)"
proof (induction t)
  case (Node lv l a r)

  let ?l' = "delete x l" and ?r' = "delete x r"
  let ?t = "Node lv l a r" let ?t' = "delete x ?t"

  from Node.prems have inv_l: "invar l" and inv_r: "invar r" by (auto)

  note post_l' = Node.IH(1)[OF inv_l]
  note preL = pre_adj_if_postL[OF Node.prems post_l']

  note post_r' = Node.IH(2)[OF inv_r]
  note preR = pre_adj_if_postR[OF Node.prems post_r']

  show ?case
  proof (cases rule: linorder_cases[of x a])
    case less
    thus ?thesis using Node.prems by (simp add: post_del_adjL preL)
  next
    case greater
    thus ?thesis using Node.prems by (simp add: post_del_adjR preR post_r')
  next
    case equal
    show ?thesis
    proof cases
      assume "l = Leaf" thus ?thesis using equal Node.prems
        by(auto simp: post_del_def invar.simps(2))
    next
      assume "l \<noteq> Leaf" thus ?thesis using equal
        by simp (metis Node.prems inv_l post_del_adjL post_del_max pre_adj_if_postL)
    qed
  qed
qed (simp add: post_del_def)

declare invar_2Nodes[simp del]

subsection "Functional Correctness"

subsubsection "Proofs for insert"

lemma inorder_split: "inorder(split t) = inorder t"
by(cases t rule: split.cases) (auto)

lemma inorder_skew: "inorder(skew t) = inorder t"
by(cases t rule: skew.cases) (auto)

lemma inorder_insert:
  "sorted(inorder t) \<Longrightarrow> inorder(insert x t) = ins_list x (inorder t)"
by(induction t) (auto simp: ins_list_simps inorder_split inorder_skew)

subsubsection "Proofs for delete"

lemma inorder_adjust: "t \<noteq> Leaf \<Longrightarrow> pre_adjust t \<Longrightarrow> inorder(adjust t) = inorder t"
by(cases t)
  (auto simp: adjust_def inorder_skew inorder_split invar.simps(2) pre_adjust.simps
     split: tree.splits)

lemma del_maxD:
  "\<lbrakk> del_max t = (t',x); t \<noteq> Leaf; invar t \<rbrakk> \<Longrightarrow> inorder t' @ [x] = inorder t"
by(induction t arbitrary: t' rule: del_max.induct)
  (auto simp: sorted_lems inorder_adjust pre_adj_if_postR post_del_max split: prod.splits)

lemma inorder_delete:
  "invar t \<Longrightarrow> sorted(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
by(induction t)
  (auto simp: del_list_simps inorder_adjust pre_adj_if_postL pre_adj_if_postR
              post_del_max post_delete del_maxD split: prod.splits)

interpretation I: Set_by_Ordered
where empty = Leaf and isin = isin and insert = insert and delete = delete
and inorder = inorder and inv = invar
proof (standard, goal_cases)
  case 1 show ?case by simp
next
  case 2 thus ?case by(simp add: isin_set)
next
  case 3 thus ?case by(simp add: inorder_insert)
next
  case 4 thus ?case by(simp add: inorder_delete)
next
  case 5 thus ?case by(simp)
next
  case 6 thus ?case by(simp add: invar_insert)
next
  case 7 thus ?case using post_delete by(auto simp: post_del_def)
qed

end


(*
   File:     Laws_of_Large_Numbers.thy
   Author:   Manuel Eberl, TU München
*)
section \<open>The Laws of Large Numbers\<close>
theory Laws_of_Large_Numbers
  imports Ergodic_Theory.Shift_Operator
begin

text \<open>
  We prove the strong law of large numbers in the following form: Let $(X_i)_{i\in\mathbb{N}}$
  be a sequence of i.i.d. random variables over a probability space \<open>M\<close>. Further assume that
  the expected value $E[X_0]$ of $X_0$ exists. Then the sequence of random variables
  \[\overline{X}_n = \frac{1}{n} \sum_{i=0}^n X_i\]
  of running averages almost surely converges to $E[X_0]$.
  This means that
  \[\mathcal{P}[\overline{X}_n \longrightarrow E[X_0]] = 1\ .\]

  We start with the strong law.
\<close>

subsection \<open>The strong law\<close>

text \<open>
  The proof uses Birkhoff's Theorem from Gouëzel's formalisation of ergodic theory~\cite{gouezel}
  and the fact that the shift operator $T(x_1, x_2, x_3, \ldots) = (x_2, x_3, \ldots)$ is ergodic.
  This proof can be found in various textbooks on probability theory/ergodic
  theory, e.g. the ones by Krengel~\cite[p.~24]{krengel} and
  Simmonet~\cite[Chapter 15, pp.~311--325]{Simonnet1996}.
\<close>
theorem (in prob_space) strong_law_of_large_numbers_iid:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real"
  assumes indep: "indep_vars (\<lambda>_. borel) X UNIV"
  assumes distr: "\<And>i. distr M borel (X i) = distr M borel (X 0)"
  assumes L1:    "integrable M (X 0)"
  shows "AE x in M. (\<lambda>n. (\<Sum>i<n. X i x) / n) \<longlonglongrightarrow> expectation (X 0)"
proof -
  text \<open>
    We adopt a more explicit view of \<^term>\<open>M\<close> as a countably infinite product of i.i.d.
    random variables, indexed by the natural numbers:
  \<close>
  define M' :: "(nat \<Rightarrow> real) measure" where "M' = Pi\<^sub>M UNIV (\<lambda>i. distr M borel (X i))"
  have [measurable]: "random_variable borel (X i)" for i
    using indep by (auto simp: indep_vars_def)
  have M'_eq: "M' = distr M (Pi\<^sub>M UNIV (\<lambda>i. borel)) (\<lambda>x. \<lambda>i\<in>UNIV. X i x)"
    using indep unfolding M'_def by (subst (asm) indep_vars_iff_distr_eq_PiM) auto
  have space_M': "space M' = UNIV"
    by (simp add: M'_def space_PiM)
  have sets_M' [measurable_cong]: "sets M' = sets (Pi\<^sub>M UNIV (\<lambda>i. borel))"
    by (simp add: M'_eq)
  interpret M': prob_space M'
    unfolding M'_eq by (intro prob_space_distr) auto

  text \<open>We introduce a shift operator that forgets the first variable in the sequence.\<close>
  define T :: "(nat \<Rightarrow> real) \<Rightarrow> (nat \<Rightarrow> real)" where
    "T = (\<lambda>f. f \<circ> Suc)"
  have funpow_T: "(T ^^ i) = (\<lambda>f. f \<circ> (\<lambda>n. n + i))" for i
    by (induction i) (auto simp: T_def)

  interpret T: shift_operator_ergodic "distr M borel (X 0)" T M'
  proof -
    interpret X0: prob_space "distr M borel (X 0)"
      by (rule prob_space_distr) auto
    show "shift_operator_ergodic (distr M borel (X 0))"
      by unfold_locales
    show "M' \<equiv> Pi\<^sub>M UNIV (\<lambda>_. distr M borel (X 0)) "
      unfolding M'_def by (subst distr)
  qed (simp_all add: T_def)

  have [intro]: "integrable M' (\<lambda>f. f 0)"
    unfolding M'_eq by (subst integrable_distr_eq) (use L1 in auto)
  have "AE f in M'. (\<lambda>n. T.birkhoff_sum (\<lambda>f. f 0) n f / real n)
            \<longlonglongrightarrow> real_cond_exp M' T.Invariants (\<lambda>f. f 0) f"
    by (rule T.birkhoff_theorem_AE_nonergodic) auto
  moreover have "AE x in M'. real_cond_exp M' T.Invariants (\<lambda>f. f 0) x =
                    M'.expectation (\<lambda>f. f 0) / M'.prob (space M')"
    by (intro T.Invariants_cond_exp_is_integral_fmpt) auto
  ultimately have "AE f in M'. (\<lambda>n. T.birkhoff_sum (\<lambda>f. f 0) n f / real n)
                     \<longlonglongrightarrow> M'.expectation (\<lambda>f. f 0)"
    by eventually_elim (simp_all add: M'.prob_space)
  also have "M'.expectation (\<lambda>f. f 0) = expectation (X 0)"
    unfolding M'_eq by (subst integral_distr) simp_all
  also have "T.birkhoff_sum (\<lambda>f. f 0) = (\<lambda>n f. sum f {..<n})"
    by (intro ext) (simp_all add:T.birkhoff_sum_def funpow_T)
  finally show ?thesis
    unfolding M'_eq by (subst (asm) AE_distr_iff) simp_all
qed

subsection \<open>The weak law\<close>

text \<open>
  To go from the strong law to the weak one, we need the fact that almost sure convergence
  implies convergence in probability. We prove this for sequences of random variables here.
\<close>
lemma (in prob_space) AE_convergence_imp_convergence_in_prob:
  assumes [measurable]: "\<And>i. random_variable borel (X i)" "random_variable borel Y"
  assumes AE: "AE x in M. (\<lambda>i. X i x) \<longlonglongrightarrow> Y x"
  assumes "\<epsilon> > (0 :: real)"
  shows   "(\<lambda>i. prob {x\<in>space M. \<bar>X i x - Y x\<bar> > \<epsilon>}) \<longlonglongrightarrow> 0"
proof -
  define A where "A = (\<lambda>i. {x\<in>space M. \<bar>X i x - Y x\<bar> > \<epsilon>})"
  define B where "B = (\<lambda>n. (\<Union>i\<in>{n..}. A i))"
  have [measurable]: "A i \<in> sets M"  "B i \<in> sets M" for i
    unfolding A_def B_def by measurable

  have "AE x in M. x \<notin> (\<Inter>i. B i)"
    using AE unfolding B_def A_def
    by eventually_elim
       (use \<open>\<epsilon> > 0\<close> in \<open>fastforce simp: tendsto_iff dist_norm eventually_at_top_linorder\<close>)
  hence "(\<Inter>i. B i) \<in> null_sets M"
    by (subst AE_iff_null_sets) auto

  show "(\<lambda>i. prob (A i)) \<longlonglongrightarrow> 0"
  proof (rule Lim_null_comparison)
    have "(\<lambda>i. prob (B i)) \<longlonglongrightarrow> prob (\<Inter>i. B i)"
    proof (rule finite_Lim_measure_decseq)
      show "decseq B"
        by (rule decseq_SucI) (force simp: B_def)
    qed auto
    also have "prob (\<Inter>i. B i) = 0"
      using \<open>(\<Inter>i. B i) \<in> null_sets M\<close> by (simp add: measure_eq_0_null_sets)
    finally show "(\<lambda>i. prob (B i)) \<longlonglongrightarrow> 0" .
  next
    have "prob (A n) \<le> prob (B n)" for n
      unfolding B_def by (intro finite_measure_mono) auto
    thus "\<forall>\<^sub>F n in at_top. norm (prob (A n)) \<le> prob (B n)"
      by (intro always_eventually) auto
  qed
qed

text \<open>
  The weak law is now a simple corollary: we again have the same setting as before. The weak
  law now states that $\overline{X}_n$ converges to $E[X_0]$ in probability. This means that
  for any \<open>\<epsilon> > 0\<close>, the probability that $|\overline{X}_n - X_0| > \varepsilon$ vanishes as
  \<open>n \<rightarrow> \<infinity>\<close>.
\<close>
corollary (in prob_space) weak_law_of_large_numbers_iid:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real" and \<epsilon> :: real
  assumes indep: "indep_vars (\<lambda>_. borel) X UNIV"
  assumes distr: "\<And>i. distr M borel (X i) = distr M borel (X 0)"
  assumes L1:    "integrable M (X 0)"
  assumes "\<epsilon> > 0"
  shows   "(\<lambda>n. prob {x\<in>space M. \<bar>(\<Sum>i<n. X i x) / n - expectation (X 0)\<bar> > \<epsilon>}) \<longlonglongrightarrow> 0"
proof (rule AE_convergence_imp_convergence_in_prob)
  show "AE x in M. (\<lambda>n. (\<Sum>i<n. X i x) / n) \<longlonglongrightarrow> expectation (X 0)"
    by (rule strong_law_of_large_numbers_iid) fact+
next
  have [measurable]: "random_variable borel (X i)" for i
    using indep by (auto simp: indep_vars_def)
  show "random_variable borel (\<lambda>x. (\<Sum>i<n. X i x) / real n)" for n
    by measurable
qed (use \<open>\<epsilon> > 0\<close> in simp_all)

end


(*
  Title: Ad-Hoc Duality for Orderings and Lattices
  Author: Georg Struth
  Maintainer: Georg Struth <g.struth@sheffield.ac.uk>
*)

section \<open>Ad-Hoc Duality for Orderings and Lattices\<close>

theory Order_Duality
  imports Sup_Lattice

begin

text \<open>This component presents an "explicit" formalisation of order and lattice duality. It augments the data type based one
 used by Wenzel in his lattice components \cite{Wenzel}, and complements the "implicit" formalisation given by locales. It uses a functor dual,
supplied within a type class, which is simply a bijection (isomorphism) between types, with the constraint that
the dual of a dual object is the original object. In Wenzel's formalisation, by contrast, dual is a bijection, but not
 idempotent or involutive. In the past, Preoteasa has used a similar approach with Isabelle~\cite{Preoteasa11b}.\<close>

text \<open>Duality is such a fundamental concept in order and lattice theory that it probably deserves to be included in the type classes
for these objects, as in this section.\<close>

class dual =
  fixes dual :: "'a \<Rightarrow> 'a" ("\<partial>")
  assumes inj_dual: "inj \<partial>"
  and invol_dual [simp]: "\<partial> \<circ> \<partial> = id"

text \<open>This type class allows one to define a type dual. It is actually a dependent type
for which dual can be instantiated.\<close>

typedef (overloaded) 'a dual = "range (dual::'a::dual \<Rightarrow> 'a)"
  by fastforce

setup_lifting type_definition_dual

text \<open>At the moment I have no use for this type.\<close>

context dual
begin

lemma surj_dual: "surj \<partial>"
  unfolding surj_def by (metis invol_dual_var)

lemma bij_dual: "bij \<partial>"
  by (simp add: bij_def inj_dual surj_dual)

lemma inj_dual_iff: "(\<partial> x = \<partial> y) = (x = y)"
  by (meson inj_dual injD)

lemma the_inv_dual: "the_inv \<partial> = \<partial>"
  by (metis comp_apply id_def invol_dual_var inj_dual surj_dual surj_fun_eq the_inv_f_o_f_id)

end

text \<open>In boolean algebras, duality is of course De Morgan duality and can be expressed within the language.\<close>

sublocale boolean_algebra \<subseteq> ba_dual: dual "uminus"
  by (unfold_locales, simp_all add: inj_def)

definition map_dual:: "('a \<Rightarrow> 'b) \<Rightarrow> 'a::dual \<Rightarrow> 'b::dual" ("\<partial>\<^sub>F") where
  "\<partial>\<^sub>F f = \<partial> \<circ> f \<circ> \<partial>"

lemma map_dual_func1: "\<partial>\<^sub>F (f \<circ> g) = \<partial>\<^sub>F f \<circ> \<partial>\<^sub>F g"
  by (metis (no_types, lifting) comp_assoc comp_id invol_dual map_dual_def)

lemma map_dual_func2 [simp]: "\<partial>\<^sub>F id = id"
  by (simp add: map_dual_def)

lemma map_dual_nat_iso: "\<partial>\<^sub>F f \<circ> \<partial> = \<partial> \<circ> id f"
  by (simp add: comp_assoc map_dual_def)

lemma map_dual_invol [simp]: "\<partial>\<^sub>F \<circ> \<partial>\<^sub>F = id"
  unfolding map_dual_def comp_def fun_eq_iff by simp

text \<open>Thus map-dual is naturally isomorphic to the identify functor: The function dual is a natural transformation
between  map-dual and the identity functor, and, because it has a two-sided inverse --- itself, it is a natural isomorphism.\<close>

text \<open>The generic function set-dual provides another natural transformation (see below). Before introducing it, we introduce useful notation
for a widely used function.\<close>

abbreviation "\<eta> \<equiv> (\<lambda>x. {x})"

lemma eta_inj: "inj \<eta>"
  by simp

definition "set_dual = \<eta> \<circ> \<partial>"

lemma set_dual_prop: "set_dual (\<partial> x) = {x}"
  by (metis comp_apply dual_iff set_dual_def)

text \<open>The next four lemmas show that (functional) image and preimage are functors (on functions). This does not really belong here,
but it is useful for what follows. The interaction between duality and (pre)images is needed in applications.\<close>

lemma image_func1: "(`) (f \<circ> g) = (`) f \<circ> (`) g"
  unfolding fun_eq_iff by (simp add: image_comp)

lemma image_func2: "(`) id = id"
  by simp

lemma vimage_func1: "(-`) (f \<circ> g) = (-`) g \<circ> (-`) f"
  unfolding fun_eq_iff by (simp add: vimage_comp)

lemma vimage_func2: "(-`) id = id"
  by simp

lemma iso_image: "mono ((`) f)"
  by (simp add: image_mono monoI)

lemma iso_preimage: "mono ((-`) f)"
  by (simp add: monoI vimage_mono)

context dual
begin

lemma image_dual [simp]: "(`) \<partial> \<circ> (`) \<partial> = id"
  by (metis image_func1 image_func2 invol_dual)

lemma vimage_dual [simp]: "(-`) \<partial> \<circ> (-`) \<partial> = id"
  by (simp add: set.comp)

end

text \<open>The following natural transformation between the powerset functor (image) and the identity functor
is well known.\<close>

lemma power_set_func_nat_trans: "\<eta> \<circ> id f = (`) f \<circ> \<eta>"
  unfolding fun_eq_iff comp_def by simp

text \<open>As an instance, set-dual is a natural transformation with built-in type coercion.\<close>

lemma dual_singleton: "(`) \<partial> \<circ> \<eta> = \<eta> \<circ> \<partial>"
  by auto

lemma finite_dual [simp]: "finite \<circ> (`) \<partial> = finite"
  unfolding fun_eq_iff comp_def using inj_dual finite_vimageI inj_vimage_image_eq by fastforce

lemma finite_dual_var [simp]: "finite (\<partial> ` X) = finite X"
  by (metis comp_def finite_dual)

lemma subset_dual: "(X = \<partial> ` Y) = (\<partial> ` X = Y)"
  by (metis image_dual pointfree_idE)

lemma subset_dual1: "(X \<subseteq> Y) = (\<partial> ` X \<subseteq> \<partial> ` Y)"
  by (simp add: inj_dual inj_image_subset_iff)

lemma dual_empty [simp]: "\<partial> ` {} = {}"
  by simp

lemma dual_UNIV [simp]: "\<partial> ` UNIV = UNIV"
  by (simp add: surj_dual)

lemma fun_dual1: "(f = g \<circ> \<partial>) = (f \<circ> \<partial> = g)"
  by (metis comp_assoc comp_id invol_dual)

lemma fun_dual2: "(f = \<partial> \<circ> g) = (\<partial> \<circ> f = g)"
  by (metis comp_assoc fun.map_id invol_dual)

lemma fun_dual3: "(f = g \<circ> (`) \<partial>) = (f \<circ> (`) \<partial> = g)"
  by (metis comp_id image_dual o_assoc)

lemma fun_dual4: "(f = (`) \<partial> \<circ> g) = ((`) \<partial> \<circ> f = g)"
  by (metis comp_assoc id_comp image_dual)

lemma fun_dual5: "(f = \<partial> \<circ> g \<circ> \<partial>) = (\<partial> \<circ> f \<circ> \<partial> = g)"
  by (metis comp_assoc fun_dual1 fun_dual2)

lemma fun_dual6: "(f = (`) \<partial> \<circ> g \<circ> (`) \<partial>) = ((`) \<partial> \<circ> f \<circ> (`) \<partial> = g)"
  by (simp add: comp_assoc fun_dual3 fun_dual4)

lemma fun_dual7: "(f = \<partial> \<circ> g \<circ> (`) \<partial>) = (\<partial> \<circ> f \<circ> (`) \<partial> = g)"
  by (simp add: comp_assoc fun_dual2 fun_dual3)

lemma fun_dual8: "(f = (`) \<partial> \<circ> g \<circ> \<partial>) = ((`) \<partial> \<circ> f \<circ> \<partial> = g)"
  by (simp add: comp_assoc fun_dual1 fun_dual4)

lemma map_dual_dual: "(\<partial>\<^sub>F f = g) = (\<partial>\<^sub>F g = f)"
  by (metis map_dual_invol pointfree_idE)

text \<open>The next facts show incrementally that the dual of a complete lattice is a complete lattice.\<close>

class ord_with_dual = dual + ord +
  assumes ord_dual: "x \<le> y \<Longrightarrow> \<partial> y \<le> \<partial> x"

begin

lemma dual_dual_ord: "(\<partial> x \<le> \<partial> y) = (y \<le> x)"
  by (metis dual_iff ord_dual)

end

lemma ord_pres_dual:
  fixes f :: "'a::ord_with_dual \<Rightarrow> 'b::ord_with_dual"
  shows "ord_pres f \<Longrightarrow> ord_pres (\<partial>\<^sub>F f)"
  by (simp add: dual_dual_ord map_dual_def ord_pres_def)

lemma map_dual_anti: "(f::'a::ord_with_dual \<Rightarrow> 'b::ord_with_dual) \<le> g  \<Longrightarrow> \<partial>\<^sub>F g \<le> \<partial>\<^sub>F f"
  by (simp add: le_fun_def map_dual_def ord_dual)

class preorder_with_dual = ord_with_dual + preorder

begin

lemma less_dual_def_var: "(\<partial> y < \<partial> x) = (x < y)"
  by (simp add: dual_dual_ord less_le_not_le)

end

class order_with_dual = preorder_with_dual + order

lemma iso_map_dual:
  fixes f :: "'a::order_with_dual \<Rightarrow> 'b::order_with_dual"
  shows "mono f \<Longrightarrow> mono (\<partial>\<^sub>F f)"
  by (simp add: ord_pres_dual ord_pres_mono)

class lattice_with_dual = lattice + dual +
  assumes sup_dual_def: "\<partial> (x \<squnion> y) = \<partial> x \<sqinter> \<partial> y"

begin

subclass order_with_dual
  by (unfold_locales, metis inf.absorb_iff2 sup_absorb1 sup_commute sup_dual_def)

lemma inf_dual: "\<partial> (x \<sqinter> y) = \<partial> x \<squnion> \<partial> y"
  by (metis invol_dual_var sup_dual_def)

lemma inf_to_sup: "x \<sqinter> y = \<partial> (\<partial> x \<squnion> \<partial> y)"
  using inf_dual dual_iff by fastforce

lemma sup_to_inf: "x \<squnion> y = \<partial> (\<partial> x \<sqinter> \<partial> y)"
  by (simp add: inf_dual)

end

class bounded_lattice_with_dual = lattice_with_dual + bounded_lattice

begin

lemma bot_dual: "\<partial> \<bottom> = \<top>"
  by (metis dual_dual_ord dual_iff le_bot top_greatest)

lemma top_dual: "\<partial> \<top> = \<bottom>"
  using bot_dual dual_iff by force

end

class boolean_algebra_with_dual = lattice_with_dual + boolean_algebra

sublocale boolean_algebra \<subseteq> badual: boolean_algebra_with_dual _ _ _ _ _ _ _ _ uminus
  by unfold_locales simp_all

class Sup_lattice_with_dual = Sup_lattice + dual +
  assumes Sups_dual_def: "\<partial> \<circ> Sup = Infs \<circ> (`) \<partial>"

class Inf_lattice_with_dual = Inf_lattice + dual +
  assumes Sups_dual_def: "\<partial> \<circ> Supi = Inf \<circ> (`) \<partial>"

class complete_lattice_with_dual = complete_lattice + dual +
  assumes Sups_dual_def: "\<partial> \<circ> Sup = Inf \<circ> (`) \<partial>"

sublocale Sup_lattice_with_dual \<subseteq> sclatd: complete_lattice_with_dual Infs Sup infs "(\<le>)" le sups bots tops "\<partial>"
  by (unfold_locales, simp add: Sups_dual_def)

sublocale Inf_lattice_with_dual \<subseteq> iclatd: complete_lattice_with_dual Inf Supi infi "(\<le>)" le supi boti topi "\<partial>"
  by (unfold_locales, simp add: Sups_dual_def)

context complete_lattice_with_dual
begin

lemma Inf_dual: "\<partial> \<circ> Inf = Sup \<circ> (`) \<partial>"
  by (metis comp_assoc comp_id fun.map_id Sups_dual_def image_dual invol_dual)

lemma Inf_dual_var: "\<partial> (\<Sqinter>X) = \<Squnion>(\<partial> ` X)"
  using comp_eq_dest Inf_dual by fastforce

lemma Inf_to_Sup: "Inf = \<partial> \<circ> Sup \<circ> (`) \<partial>"
  by (auto simp add: Sups_dual_def image_comp)

lemma Inf_to_Sup_var: "\<Sqinter>X = \<partial> (\<Squnion>(\<partial> ` X))"
  using Inf_dual_var dual_iff by fastforce

lemma Sup_to_Inf: "Sup = \<partial> \<circ> Inf \<circ> (`) \<partial>"
  by (auto simp add: Inf_dual image_comp)

lemma Sup_to_Inf_var: "\<Squnion>X = \<partial> (\<Sqinter>(\<partial> ` X))"
  using Sup_to_Inf by force

lemma Sup_dual_def_var: "\<partial> (\<Squnion>X) = \<Sqinter> (\<partial> ` X)"
  using comp_eq_dest Sups_dual_def by fastforce

lemma bot_dual_def: "\<partial> \<top> = \<bottom>"
  by (smt Inf_UNIV Sup_UNIV Sups_dual_def surj_dual o_eq_dest)

lemma top_dual_def: "\<partial> \<bottom> = \<top>"
  using bot_dual_def dual_iff by blast

lemma inf_dual2: "\<partial> (x \<sqinter> y) = \<partial> x \<squnion> \<partial> y"
  by (smt comp_eq_elim Inf_dual Inf_empty Inf_insert SUP_insert inf_top.right_neutral)

lemma sup_dual: "\<partial> (x \<squnion> y) = \<partial> x \<sqinter> \<partial> y"
  by (metis inf_dual2 dual_iff)

subclass lattice_with_dual
  by (unfold_locales, auto simp: inf_dual sup_dual)

subclass bounded_lattice_with_dual..

end

end