(*
  File:     Nearest_Neighbors.thy
  Author:   Martin Rau, TU München
*)

section \<open>Nearest Neighbor Search on the \<open>k\<close>-d Tree\<close>

theory Nearest_Neighbors
imports
  KD_Tree
  "../../../../SeLFiE"
begin

text \<open>
  Verifying nearest neighbor search on the k-d tree. Given a \<open>k\<close>-d tree and a point \<open>p\<close>,
  which might not be in the tree, find the points \<open>ps\<close> that are closest to \<open>p\<close> using the
  Euclidean metric.
\<close>

subsection \<open>Auxiliary Lemmas about \<open>sorted_wrt\<close>\<close>

lemma
  assumes "sorted_wrt f xs"
  shows sorted_wrt_take: "sorted_wrt f (take n xs)"
  and sorted_wrt_drop: "sorted_wrt f (drop n xs)"
proof -
  have "sorted_wrt f (take n xs @ drop n xs)"
    using assms by simp
  thus "sorted_wrt f (take n xs)" "sorted_wrt f (drop n xs)"
    using sorted_wrt_append by blast+
qed

definition sorted_wrt_dist :: "('k::finite) point \<Rightarrow> 'k point list \<Rightarrow> bool" where
  "sorted_wrt_dist p \<equiv> sorted_wrt (\<lambda>p\<^sub>0 p\<^sub>1. dist p\<^sub>0 p \<le> dist p\<^sub>1 p)"

lemma sorted_wrt_dist_insort_key:
  "sorted_wrt_dist p ps \<Longrightarrow> sorted_wrt_dist p (insort_key (\<lambda>q. dist q p) q ps)"

  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["ps"], arb[],rule[]]
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["ps"], arb["q"],rule[]](*a little unfortunate, but okay*)
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["ps"], arb["p"],rule[]](*a little unfortunate, but okay*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["ps"], arb["p"],rule[]]      (*very good*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["ps"], arb["p", "q"],rule[]] (*very good*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["ps"], arb["q"],rule[]]
  assert_SeLFiE_true  for_all_arbs_there_should_be_a_change [on["ps"], arb[],rule[]] (*good*)
  all_induction_heuristic      [on["ps"], arb[],rule[]]
  all_generalization_heuristic [on["ps"], arb[],rule[]]
  by (induction ps) (auto simp: sorted_wrt_dist_def set_insort_key)

lemma sorted_wrt_dist_take_drop:
  assumes "sorted_wrt_dist p ps"
  shows "\<forall>p\<^sub>0 \<in> set (take n ps). \<forall>p\<^sub>1 \<in> set (drop n ps). dist p\<^sub>0 p \<le> dist p\<^sub>1 p"
  using assms sorted_wrt_append[of _ "take n ps" "drop n ps"] by (simp add: sorted_wrt_dist_def)

lemma sorted_wrt_dist_last_take_mono:
  assumes "sorted_wrt_dist p ps" "n \<le> length ps" "0 < n"
  shows "dist (last (take n ps)) p \<le> dist (last ps) p"
  using assms unfolding sorted_wrt_dist_def

  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["ps"], arb["n"],rule[]]
  assert_SeLFiE_false  generalize_arguments_used_in_recursion [on["ps"], arb[],rule[]]
  all_induction_heuristic      [on["ps"], arb["n"],rule[]]
  all_generalization_heuristic [on["ps"], arb["n"],rule[]]
  by (induction ps arbitrary: n) (auto simp add: take_Cons')

lemma sorted_wrt_dist_last_insort_key_eq:
  assumes "sorted_wrt_dist p ps" "insort_key (\<lambda>q. dist q p) q ps \<noteq> ps @ [q]"
  shows "last (insort_key (\<lambda>q. dist q p) q ps) = last ps"
  using assms unfolding sorted_wrt_dist_def by (induction ps) (auto)

lemma sorted_wrt_dist_last:
  assumes "sorted_wrt_dist p ps"
  shows "\<forall>q \<in> set ps. dist q p \<le> dist (last ps) p"
proof (cases "ps = []")
  case True
  thus ?thesis by simp
next
  case False
  then obtain ps' p' where [simp]:"ps = ps' @ [p']"
    using rev_exhaust by blast
  hence "sorted_wrt_dist p (ps' @ [p'])"
    using assms by blast
  thus ?thesis
    unfolding sorted_wrt_dist_def using sorted_wrt_append[of _ ps' "[p']"] by simp
qed

subsection \<open>Neighbors Sorted wrt. Distance\<close>

definition upd_nbors :: "nat \<Rightarrow> ('k::finite) point \<Rightarrow> 'k point \<Rightarrow> 'k point list \<Rightarrow> 'k point list" where
  "upd_nbors n p q ps = take n (insort_key (\<lambda>q. dist q p) q ps)"

lemma sorted_wrt_dist_nbors:
  assumes "sorted_wrt_dist p ps"
  shows "sorted_wrt_dist p (upd_nbors n p q ps)"
proof -
  have "sorted_wrt_dist p (insort_key (\<lambda>q. dist q p) q ps)"
    using assms sorted_wrt_dist_insort_key by blast
  thus ?thesis
    by (simp add: sorted_wrt_dist_def sorted_wrt_take upd_nbors_def)
qed

lemma sorted_wrt_dist_nbors_diff:
  assumes "sorted_wrt_dist p ps"
  shows "\<forall>r \<in> set ps \<union> {q} - set (upd_nbors n p q ps). \<forall>s \<in> set (upd_nbors n p q ps). dist s p \<le> dist r p"
proof -
  let ?ps' = "insort_key (\<lambda>q. dist q p) q ps"
  have "set ps \<union> { q } = set ?ps'"
    by (simp add: set_insort_key)
  moreover have "set ?ps' = set (take n ?ps') \<union> set (drop n ?ps')"
    using append_take_drop_id set_append by metis
  ultimately have "set ps \<union> { q } - set (take n ?ps') \<subseteq> set (drop n ?ps')"
    by blast
  moreover have "sorted_wrt_dist p ?ps'"
    using assms sorted_wrt_dist_insort_key by blast
  ultimately show ?thesis
    unfolding upd_nbors_def using sorted_wrt_dist_take_drop by blast
qed

lemma sorted_wrt_dist_last_upd_nbors_mono:
  assumes "sorted_wrt_dist p ps" "n \<le> length ps" "0 < n"
  shows "dist (last (upd_nbors n p q ps)) p \<le> dist (last ps) p"
proof (cases "insort_key (\<lambda>q. dist q p) q ps = ps @ [q]")
  case True
  thus ?thesis
    unfolding upd_nbors_def using assms sorted_wrt_dist_last_take_mono by auto
next
  case False
  hence "last (insort_key (\<lambda>q. dist q p) q ps) = last ps"
    using sorted_wrt_dist_last_insort_key_eq assms by blast
  moreover have "dist (last (upd_nbors  n p q ps)) p \<le> dist (last (insort_key (\<lambda>q. dist q p) q ps)) p"
    unfolding upd_nbors_def using assms sorted_wrt_dist_last_take_mono[of p "insort_key (\<lambda>q. dist q p) q ps"]
    by (simp add: sorted_wrt_dist_insort_key)
  ultimately show ?thesis
    by simp
qed

subsection \<open>The Recursive Nearest Neighbor Algorithm\<close>

fun nearest_nbors :: "nat \<Rightarrow> ('k::finite) point list \<Rightarrow> 'k point \<Rightarrow> 'k kdt \<Rightarrow> 'k point list" where
  "nearest_nbors n ps p (Leaf q) = upd_nbors n p q ps"
| "nearest_nbors n ps p (Node k v l r) = (
    if p$k \<le> v then
      let candidates = nearest_nbors n ps p l in
      if length candidates = n \<and> dist p (last candidates) \<le> dist v (p$k) then
        candidates
      else
        nearest_nbors n candidates p r
    else
      let candidates = nearest_nbors n ps p r in
      if length candidates = n \<and> dist p (last candidates) \<le> dist v (p$k) then
        candidates
      else
        nearest_nbors n candidates p l
  )"

subsection \<open>Auxiliary Lemmas\<close>

lemma cutoff_r:
  assumes "invar (Node k v l r)"
  assumes "p$k \<le> v" "dist p c \<le> dist (p$k) v"
  shows "\<forall>q \<in> set_kdt r. dist p c \<le> dist p q"
proof standard
  fix q
  assume *: "q \<in> set_kdt r"
  have "dist p c \<le> dist (p$k) v"
    using assms(3) by blast
  also have "... \<le> dist (p$k) v + dist v (q$k)"
    by simp
  also have "... = dist (p$k) (q$k)"
    using * assms(1,2) dist_real_def by auto
  also have "... \<le> dist p q"
    using dist_vec_nth_le by blast
  finally show "dist p c \<le> dist p q" .
qed

lemma cutoff_l:
  assumes "invar (Node k v l r)"
  assumes "v \<le> p$k" "dist p c \<le> dist v (p$k)"
  shows "\<forall>q \<in> set_kdt l. dist p c \<le> dist p q"
proof standard
  fix q
  assume *: "q \<in> set_kdt l"
  have "dist p c \<le> dist v (p$k)"
    using assms(3) by blast
  also have "... \<le> dist v (p$k) + dist (q$k) v"
    by simp
  also have "... = dist (p$k) (q$k)"
    using * assms(1,2) dist_real_def by auto
  also have "... \<le> dist p q"
    using dist_vec_nth_le by blast
  finally show "dist p c \<le> dist p q" .
qed

subsection \<open>The Main Theorems\<close>

lemma set_nns:
  "set (nearest_nbors n ps p kdt) \<subseteq> set_kdt kdt \<union> set ps"
  assert_SeLFiE_true  generalize_arguments_used_in_recursion_deep [on["kdt"], arb["ps"], rule[]](*okay*)
  assert_SeLFiE_true  generalize_arguments_used_in_recursion_deep [on["kdt"], arb[    ], rule[]](*not great, but okay*)
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["kdt"], arb["ps"],rule[]](*very good.It takes 2.385s elapsed time, 13.012s cpu time, 0.196s GC time*)
  assert_SeLFiE_false generalize_arguments_used_in_recursion [on["kdt"], arb[],rule[]]    (*very good*)
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["kdt"], arb["p", "ps"],rule[]](*a little unfortunate*)
  assert_SeLFiE_true  for_all_arbs_there_should_be_a_change [on["kdt"], arb["ps"],rule[]]
  assert_SeLFiE_true  for_all_arbs_there_should_be_a_change [on["kdt"], arb[],rule[]]     (*unfortunate because of the universal quantifier over generalized terms*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p", "ps"],rule[]](*very good*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["n"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["n","p"],rule[]]
  apply (induction kdt arbitrary: ps)
  apply (auto simp: Let_def upd_nbors_def set_insort_key)
  using in_set_takeD set_insort_key by fastforce

lemma length_nns:
  "length (nearest_nbors n ps p kdt) = min n (size_kdt kdt + length ps)"
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["kdt"], arb["ps"],rule[]](*very good. It takes 1.706s elapsed time, 4.520s cpu time, 0.064s GC time*)
  assert_SeLFiE_false generalize_arguments_used_in_recursion [on["kdt"], arb[],rule[]]    (*very good*)
  assert_SeLFiE_true  generalize_arguments_used_in_recursion [on["kdt"], arb["p", "ps"],rule[]](*a little unfortunate*)(*1.793s elapsed time, 5.413s cpu time, 0.180s GC time*)
  assert_SeLFiE_true  for_all_arbs_there_should_be_a_change [on["kdt"], arb["ps"],rule[]]
  assert_SeLFiE_true  for_all_arbs_there_should_be_a_change [on["kdt"], arb[],rule[]]     (*unfortunate because of the universal quantifier over generalized terms*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p", "ps"],rule[]](*very good*)
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["n"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["n","p"],rule[]]
  by (induction kdt arbitrary: ps) (auto simp: Let_def upd_nbors_def)

lemma length_nns_gt_0:
  "0 < n \<Longrightarrow> 0 < length (nearest_nbors n ps p kdt)"
  all_induction_heuristic      [on["n"], arb["ps"],rule[]]
  all_generalization_heuristic [on["n"], arb["ps"],rule[]]
  all_induction_heuristic      [on["kdt"], arb["ps"],rule[]]
  all_generalization_heuristic [on["kdt"], arb["ps"],rule[]]
  all_generalization_heuristic [on["kdt"], arb["ps","p","n"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p"],rule[]]
  by (induction kdt arbitrary: ps) (auto simp: Let_def upd_nbors_def)

lemma length_nns_n:
  assumes "(set_kdt kdt \<union> set ps) - set (nearest_nbors n ps p kdt) \<noteq> {}"
  shows "length (nearest_nbors n ps p kdt) = n"
  using assms
  all_induction_heuristic      [on["kdt"], arb["ps","p","n"],rule[]]
  all_generalization_heuristic [on["kdt"], arb["ps","p","n"],rule[]]
  assert_SeLFiE_false for_all_arbs_there_should_be_a_change [on["kdt"], arb["p"],rule[]](*!*)
proof (induction kdt arbitrary: ps)
  case (Node k v l r)
  let ?nnsl = "nearest_nbors n ps p l"
  let ?nnsr = "nearest_nbors n ps p r"
  consider (A) "p$k \<le> v \<and> length ?nnsl = n \<and> dist p (last ?nnsl) \<le> dist v (p$k)"
         | (B) "p$k \<le> v \<and> \<not>(length ?nnsl = n \<and> dist p (last ?nnsl) \<le> dist v (p$k))"
         | (C) "v < p$k \<and> length ?nnsr = n \<and> dist p (last ?nnsr) \<le> dist v (p$k)"
         | (D) "v < p$k \<and> \<not>(length ?nnsr = n \<and> dist p (last ?nnsr) \<le> dist v (p$k))"
    by argo
  thus ?case
  proof cases
    case B
    let ?nns = "nearest_nbors n ?nnsl p r"
    have "length ?nnsl \<noteq> n \<longrightarrow> (set_kdt l \<union> set ps - set (nearest_nbors n ps p l) = {})"
      using Node.IH(1) by blast
    hence "length ?nnsl \<noteq> n \<longrightarrow> (set_kdt r \<union> set ?nnsl - set ?nns \<noteq> {})"
      using B Node.prems by auto
    moreover have "length ?nnsl = n \<longrightarrow> ?thesis"
      using B by (auto simp: length_nns)
    ultimately show ?thesis
      using B Node.IH(2) by force
  next
    case D
    let ?nns = "nearest_nbors n ?nnsr p l"
    have "length ?nnsr \<noteq> n \<longrightarrow> (set_kdt r \<union> set ps - set (nearest_nbors n ps p r) = {})"
      using Node.IH(2) by blast
    hence "length ?nnsr \<noteq> n \<longrightarrow> (set_kdt l \<union> set ?nnsr - set ?nns \<noteq> {})"
      using D Node.prems by auto
    moreover have "length ?nnsr = n \<longrightarrow> ?thesis"
      using D by (auto simp: length_nns)
    ultimately show ?thesis
      using D Node.IH(1) by force
  qed auto
qed (auto simp: upd_nbors_def min_def set_insort_key)

lemma sorted_nns:
  "sorted_wrt_dist p ps \<Longrightarrow> sorted_wrt_dist p (nearest_nbors n ps p kdt)"
  using sorted_wrt_dist_nbors by (induction kdt arbitrary: ps) (auto simp: Let_def)

lemma distinct_nns:
  assumes "invar kdt" "distinct ps" "set ps \<inter> set_kdt kdt = {}"
  shows "distinct (nearest_nbors n ps p kdt)"
  using assms semantic_induct
proof (induction kdt arbitrary: ps)
  case (Node k v l r)
  let ?nnsl = "nearest_nbors n ps p l"
  let ?nnsr = "nearest_nbors n ps p r"
  have "set ps \<inter> set_kdt l = {}" "set ps \<inter> set_kdt r = {}"
    using Node.prems(3) by auto
  hence DCLR: "distinct ?nnsl" "distinct ?nnsr"
    using Node invar_l invar_r by blast+
  have "set ?nnsl \<inter> set_kdt r = {}" "set ?nnsr \<inter> set_kdt l = {}"
    using Node.prems(1,3) set_nns by fastforce+
  hence "distinct (nearest_nbors n ?nnsl p r)" "distinct (nearest_nbors n ?nnsr p l)"
    using Node.IH(1,2) Node.prems(1,2) DCLR invar_l invar_r by blast+
  thus ?case
    using DCLR by (auto simp add: Let_def)
qed (auto simp: upd_nbors_def distinct_insort)

theorem dist_nns:
  assumes "invar kdt" "sorted_wrt_dist p ps" "set ps \<inter> set_kdt kdt = {}" "distinct ps" "0 < n"
  shows "\<forall>q \<in> set_kdt kdt \<union> set ps - set (nearest_nbors n ps p kdt). dist (last (nearest_nbors n ps p kdt)) p \<le> dist q p"
  using assms
proof (induction kdt arbitrary: ps)
  case (Node k v l r)

  let ?nnsl = "nearest_nbors n ps p l"
  let ?nnsr = "nearest_nbors n ps p r"

  have IHL: "\<forall>q \<in> set_kdt l \<union> set ps - set ?nnsl. dist (last ?nnsl) p \<le> dist q p"
    using Node.IH(1) Node.prems invar_l invar_set by auto
  have IHR: "\<forall>q \<in> set_kdt r \<union> set ps - set ?nnsr. dist (last ?nnsr) p \<le> dist q p"
    using Node.IH(2) Node.prems invar_r invar_set by auto

  have SORTED_L: "sorted_wrt_dist p ?nnsl"
    using sorted_nns Node.prems(2) by blast
  have SORTED_R: "sorted_wrt_dist p ?nnsr"
    using sorted_nns Node.prems(2) by blast

  have DISTINCT_L: "distinct ?nnsl"
    using Node.prems distinct_nns invar_set invar_l by fastforce
  have DISTINCT_R: "distinct ?nnsr"
    using Node.prems distinct_nns invar_set invar_r
    by (metis inf_bot_right inf_sup_absorb inf_sup_aci(3) sup.commute)

  consider (A) "p$k \<le> v \<and> length ?nnsl = n \<and> dist p (last ?nnsl) \<le> dist v (p$k)"
         | (B) "p$k \<le> v \<and> \<not>(length ?nnsl = n \<and> dist p (last ?nnsl) \<le> dist v (p$k))"
         | (C) "v < p$k \<and> length ?nnsr = n \<and> dist p (last ?nnsr) \<le> dist v (p$k)"
         | (D) "v < p$k \<and> \<not>(length ?nnsr = n \<and> dist p (last ?nnsr) \<le> dist v (p$k))"
    by argo
  thus ?case
  proof cases
    case A
    hence "\<forall>q \<in> set_kdt r. dist (last ?nnsl) p \<le> dist q p"
      using Node.prems(1,2) cutoff_r by (metis dist_commute)
    thus ?thesis
      using IHL A by auto
  next
    case B

    let ?nns = "nearest_nbors n ?nnsl p r"

    have "set ?nnsl \<subseteq> set_kdt l \<union> set ps" "set ps \<inter> set_kdt r = {}"
      using set_nns Node.prems(1,3) by (simp add: set_nns disjoint_iff_not_equal)+
    hence "set ?nnsl \<inter> set_kdt r = {}"
      using Node.prems(1) by fastforce
    hence IHLR: "\<forall>q \<in> set_kdt r \<union> set ?nnsl - set ?nns. dist (last ?nns) p \<le> dist q p"
      using Node.IH(2)[OF _ SORTED_L _ DISTINCT_L Node.prems(5)] Node.prems(1) invar_r by blast

    have "\<forall>q \<in> set ps - set ?nnsl. dist (last ?nns) p \<le> dist q p"
    proof standard
      fix q
      assume *: "q \<in> set ps - set ?nnsl"

      hence "length ?nnsl = n"
        using length_nns_n by blast
      hence LAST: "dist (last ?nns) p \<le> dist (last ?nnsl) p"
        using last_nns_mono SORTED_L invar_r Node.prems(1,2,5) by (metis order_refl)
      have "dist (last ?nnsl) p \<le> dist q p"
        using IHL * by blast
      thus "dist (last ?nns) p \<le> dist q p"
        using LAST by argo
    qed
    hence R: "\<forall>q \<in> set_kdt r \<union> set ps - set ?nns. dist (last ?nns) p \<le> dist q p"
      using IHLR by auto

    have "\<forall>q \<in> set_kdt l - set ?nnsl. dist (last ?nns) p \<le> dist q p"
    proof standard
      fix q
      assume *: "q \<in> set_kdt l - set ?nnsl"

      hence "length ?nnsl = n"
        using length_nns_n by blast
      hence LAST: "dist (last ?nns) p \<le> dist (last ?nnsl) p"
        using last_nns_mono SORTED_L invar_r Node.prems(1,2,5) by (metis order_refl)
      have "dist (last ?nnsl) p \<le> dist q p"
        using IHL * by blast
      thus "dist (last ?nns) p \<le> dist q p"
        using LAST by argo
    qed
    hence L: "\<forall>q \<in> set_kdt l - set ?nns. dist (last ?nns) p \<le> dist q p"
      using IHLR by blast

    show ?thesis
      using B R L by auto
  next
    case C
    hence "\<forall>q \<in> set_kdt l. dist (last ?nnsr) p \<le> dist q p"
      using Node.prems(1,2) cutoff_l by (metis dist_commute less_imp_le)
    thus ?thesis
      using IHR C by auto
  next
    case D

    let ?nns = "nearest_nbors n ?nnsr p l"

    have "set ?nnsr \<subseteq> set_kdt r \<union> set ps" "set ps \<inter> set_kdt l = {}"
      using set_nns Node.prems(1,3) by (simp add: set_nns disjoint_iff_not_equal)+
    hence "set ?nnsr \<inter> set_kdt l = {}"
      using Node.prems(1) by fastforce
    hence IHRL: "\<forall>q \<in> set_kdt l \<union> set ?nnsr - set ?nns. dist (last ?nns) p \<le> dist q p"
      using Node.IH(1)[OF _ SORTED_R _ DISTINCT_R Node.prems(5)] Node.prems(1) invar_l by blast

    have "\<forall>q \<in> set ps - set ?nnsr. dist (last ?nns) p \<le> dist q p"
    proof standard
      fix q
      assume *: "q \<in> set ps - set ?nnsr"

      hence "length ?nnsr = n"
        using length_nns_n by blast
      hence LAST: "dist (last ?nns) p \<le> dist (last ?nnsr) p"
        using last_nns_mono SORTED_R invar_l Node.prems(1,2,5) by (metis order_refl)
      have "dist (last ?nnsr) p \<le> dist q p"
        using IHR * by blast
      thus "dist (last ?nns) p \<le> dist q p"
        using LAST by argo
    qed
    hence R: "\<forall>q \<in> set_kdt l \<union> set ps - set ?nns. dist (last ?nns) p \<le> dist q p"
      using IHRL by auto

    have "\<forall>q \<in> set_kdt r - set ?nnsr. dist (last ?nns) p \<le> dist q p"
    proof standard
      fix q
      assume *: "q \<in> set_kdt r - set ?nnsr"

      hence "length ?nnsr = n"
        using length_nns_n by blast
      hence LAST: "dist (last ?nns) p \<le> dist (last ?nnsr) p"
        using last_nns_mono SORTED_R invar_l Node.prems(1,2,5) by (metis order_refl)
      have "dist (last ?nnsr) p \<le> dist q p"
        using IHR * by blast
      thus "dist (last ?nns) p \<le> dist q p"
        using LAST by argo
    qed
    hence L: "\<forall>q \<in> set_kdt r - set ?nns. dist (last ?nns) p \<le> dist q p"
      using IHRL by blast

    show ?thesis
      using D R L by auto
  qed
qed (auto simp: sorted_wrt_dist_nbors_diff upd_nbors_def)

subsection \<open>Nearest Neighbors Definition and Theorems\<close>

definition nearest_neighbors :: "nat \<Rightarrow> ('k::finite) point \<Rightarrow> 'k kdt \<Rightarrow> 'k point list" where
  "nearest_neighbors n p kdt = nearest_nbors n [] p kdt"

theorem length_nearest_neighbors:
  "length (nearest_neighbors n p kdt) = min n (size_kdt kdt)"
  by (simp add: length_nns nearest_neighbors_def)

theorem sorted_wrt_dist_nearest_neighbors:
  "sorted_wrt_dist p (nearest_neighbors n p kdt)"
  using sorted_nns unfolding nearest_neighbors_def sorted_wrt_dist_def by force

theorem distinct_nearest_neighbors:
  assumes "invar kdt"
  shows "distinct (nearest_neighbors n p kdt)"
  using assms by (simp add: distinct_nns nearest_neighbors_def)

theorem dist_nearest_neighbors:
  assumes "invar kdt" "nns = nearest_neighbors n p kdt"
  shows "\<forall>q \<in> (set_kdt kdt - set nns). \<forall>r \<in> set nns. dist r p \<le> dist q p"
proof (cases "0 < n")
  case True
  have "\<forall>q \<in> set_kdt kdt - set nns. dist (last nns) p \<le> dist q p"
    using nearest_neighbors_def dist_nns[OF assms(1), of p "[]", OF _ _ _ True] assms(2)
    by (simp add: nearest_neighbors_def sorted_wrt_dist_def)
  hence "\<forall>q \<in> set_kdt kdt - set nns. \<forall>n \<in> set nns. dist n p \<le> dist q p"
    using assms(2) sorted_wrt_dist_nearest_neighbors[of p n kdt] sorted_wrt_dist_last[of p nns] by force
  thus ?thesis
    using nearest_neighbors_def by blast
next
  case False
  hence "length nns = 0"
    using assms(2) unfolding nearest_neighbors_def by (auto simp: length_nns)
  thus ?thesis
    by simp
qed

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
theory TIP_prop_24
  imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun x :: "Nat => Nat => bool" where
  "x (Z) (Z) = True"
| "x (Z) (S z2) = False"
| "x (S x2) (Z) = False"
| "x (S x2) (S y2) = x x2 y2"

fun max :: "Nat => Nat => Nat" where
  "max (Z) z = z"
| "max (S z2) (Z) = S z2"
| "max (S z2) (S x2) = S (max z2 x2)"

fun t2 :: "Nat => Nat => bool" where
  "t2 (Z) z = True"
| "t2 (S z2) (Z) = False"
| "t2 (S z2) (S x2) = t2 z2 x2"

theorem property0 :(*Probably the best proof.*)
  "((x (max a b) a) = (t2 b a))"
  apply(induct rule:x.induct)
     apply fastforce
    apply clarsimp
    apply(induct_tac z2)
     apply fastforce+
  done
    (*Why does "x.induct" lead to the shortest proof?
  Because "x"'s pattern-matching is complete, meaning that it does not involve any wild-card.*)

theorem property0' :
  "((x (max a b) a) = (t2 b a))"
  apply(induct b arbitrary:a)(*This arbitrary is important.*)
   apply(induct_tac a)
    apply fastforce+
   apply(induct_tac xa)
    apply fastforce+
  apply(induct_tac a)
   apply fastforce+
  done

(*We can finish proving this theorem starting induction on "a".*)
theorem property0'' :
  "((x (max a b) a) = (t2 b a))"
  apply(induct a arbitrary:b)(*This arbitrary is important.*)
   apply clarsimp
   apply(induct_tac b)
    apply fastforce+
  apply(induct_tac b)
   apply clarsimp
   apply(induct_tac a)
    apply fastforce+
  done

theorem property0''' :
  "((x (max a b) a) = (t2 b a))"
  apply(induct rule:t2.induct)
    apply clarsimp
    apply(induct_tac z)
     apply fastforce
    apply clarsimp
    apply(induct_tac xa)
     apply fastforce+
  done

theorem property0'''' :
  "((x (max a b) a) = (t2 b a))"
  apply(induct rule:max.induct)(*This is equivalent to "(induct rule:t2.induct)"*)
    apply clarsimp
    apply(induct_tac z)
     apply fastforce
    apply clarsimp
    apply(induct_tac xa)
     apply fastforce+
  done

end


theory Testing
  imports "HOL-Analysis.Multivariate_Analysis"

begin

lemma interior_ball: "(x \<in> interior S) \<longleftrightarrow> (\<exists> e. 0 < e & (ball x e) \<subseteq> S)"
proof-
  { assume "x \<in> interior S"
    from this obtain T where T_def: "open T & x \<in> T & T \<subseteq> S" using interior_def by auto
    hence "\<exists> e. 0 < e & (ball x e) \<subseteq> T" using open_contains_ball by auto
    hence "\<exists> e. 0 < e & (ball x e) \<subseteq> S" using T_def by auto
  } note imp1 = this
  { assume "(\<exists> e. 0 < e & (ball x e) \<subseteq> S)"
    from this obtain e where e_def: "0 < e & (ball x e) \<subseteq> S" by auto
    obtain T where T_def: "T = ball x e" by auto
    then have "open T & x \<in> T & T \<subseteq> S" using open_ball e_def by auto
    hence "x \<in> interior S" using interior_def by auto
  } from this show ?thesis using imp1 by auto
qed
end


(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-nantes.fr
    License: BSD
*)

section \<open>A theorem by Kohlberg and Neyman\<close>

theory Kohlberg_Neyman_Karlsson
  imports Fekete
begin

text \<open>In this section, we prove a theorem due to Kohlberg and Neyman: given a semicontraction
$T$ of a euclidean space, then $T^n(0)/n$ converges when $n \to \infty$. The proof we give
is due to Karlsson. It mainly builds on subadditivity ideas. The geometry of the space
is essentially not relevant except at the very end of the argument, where strict convexity
comes into play.\<close>

text \<open>We recall Fekete's lemma: if a sequence is subadditive (i.e.,
$u_{n+m}\leq u_n + u_m$), then $u_n/n$ converges to its infimum. It is proved
in a different file, but we recall the statement for self-containedness.\<close>

lemma fekete:
  fixes u::"nat \<Rightarrow> real"
  assumes "\<And>n m. u (m+n) \<le> u m + u n"
          "bdd_below {u n/n | n. n>0}"
  shows "(\<lambda>n. u n/n) \<longlonglongrightarrow> Inf {u n/n | n. n>0}"
apply (rule subadditive_converges_bounded) unfolding subadditive_def using assms by auto

text \<open>A real sequence tending to infinity has infinitely many high-scores, i.e.,
there are infinitely many times where it is larger than all its previous values.\<close>

lemma high_scores:
  fixes u::"nat \<Rightarrow> real" and i::nat
  assumes "u \<longlonglongrightarrow> \<infinity>"
  shows "\<exists>n \<ge> i. \<forall>l \<le> n. u l \<le> u n"
proof -
  define M where "M = Max {u l|l. l < i}"
  define n where "n = Inf {m. u m > M}"
  have "eventually (\<lambda>m. u m > M) sequentially"
    using assms by (simp add: filterlim_at_top_dense tendsto_PInfty_eq_at_top)
  then have "{m. u m > M} \<noteq> {}" by fastforce
  then have "n \<in> {m. u m > M}" unfolding n_def using Inf_nat_def1 by metis
  then have "u n > M" by simp
  have "n \<ge> i"
  proof (rule ccontr)
    assume " \<not> i \<le> n"
    then have *: "n < i" by simp
    have "u n \<le> M" unfolding M_def apply (rule Max_ge) using * by auto
    then show False using \<open>u n > M\<close> by auto
  qed
  moreover have "u l \<le> u n" if "l \<le> n" for l
  proof (cases "l = n")
    case True
    then show ?thesis by simp
  next
    case False
    then have "l < n" using \<open>l \<le> n\<close> by auto
    then have "l \<notin> {m. u m > M}"
      unfolding n_def by (meson bdd_below_def cInf_lower not_le zero_le)
    then show ?thesis using \<open>u n > M\<close> by auto
  qed
  ultimately show ?thesis by auto
qed

text \<open>Hahn-Banach in euclidean spaces: given a vector $u$, there exists a unit norm
vector $v$ such that $\langle u, v \rangle = \|u\|$ (and we put a minus sign as we will
use it in this form). This uses the fact that, in Isabelle/HOL, euclidean spaces
have positive dimension by definition.\<close>

lemma select_unit_norm:
  fixes u::"'a::euclidean_space"
  shows "\<exists>v. norm v = 1 \<and> v \<bullet> u = - norm u"
proof (cases "u = 0")
  case True
  then show ?thesis using norm_Basis nonempty_Basis by fastforce
next
  case False
  show ?thesis
    apply (rule exI[of _ "-u/\<^sub>R norm u"])
    using False by (auto simp add: dot_square_norm power2_eq_square)
qed

text \<open>We set up the assumption that we will use until the end of this file,
in the following locale: we fix a semicontraction $T$ of a euclidean space.
Our goal will be to show that such a semicontraction has an asymptotic translation vector.\<close>

locale Kohlberg_Neyman_Karlsson =
  fixes T::"'a::euclidean_space \<Rightarrow> 'a"
  assumes semicontract: "dist (T x) (T y) \<le> dist x y"
begin

text \<open>The iterates of $T$ are still semicontractions, by induction.\<close>

lemma semicontract_Tn:
  "dist ((T^^n) x) ((T^^n) y) \<le> dist x y"
apply (induction n, auto) using semicontract order_trans by blast

text \<open>The main quantity we will use is the distance from the origin to its image under $T^n$.
We denote it by $u_n$. The main point is that it is subadditive by semicontraction, hence
it converges to a limit $A$ given by $Inf \{u_n/n\}$, thanks to Fekete Lemma.\<close>

definition u::"nat \<Rightarrow> real"
  where "u n = dist 0 ((T^^n) 0)"

definition A::real
  where "A = Inf {u n/n | n. n>0}"

lemma Apos: "A \<ge> 0"
unfolding A_def u_def by (rule cInf_greatest, auto)

lemma Alim:"(\<lambda>n. u n/n) \<longlonglongrightarrow> A"
unfolding A_def proof (rule fekete)
  show "bdd_below {u n / real n |n. 0 < n}"
    unfolding u_def bdd_below_def by (rule exI[of _ 0], auto)

  fix m n
  have "u (m+n) = dist 0 ((T^^(m+n)) 0)"
    unfolding u_def by simp
  also have "... \<le> dist 0 ((T^^m) 0) + dist ((T^^m) 0) ((T^^(m+n)) 0)"
    by (rule dist_triangle)
  also have "... = dist 0 ((T^^m) 0) + dist ((T^^m) 0) ((T^^m) ((T^^n) 0))"
    by (auto simp add: funpow_add)
  also have "... \<le> dist 0 ((T^^m) 0) + dist 0 ((T^^n) 0)"
    using semicontract_Tn[of m] add_mono_thms_linordered_semiring(2) by blast
  also have "... = u m + u n"
    unfolding u_def by auto
  finally show "u (m+n) \<le> u m + u n" by auto
qed

text \<open>The main fact to prove the existence of an asymptotic translation vector for $T$
is the following proposition: there exists a unit norm vector $v$ such that $T^\ell(0)$ is in
the half-space at distance $A \ell$ of the origin directed by $v$.

The idea of the proof is to find such a vector $v_i$ that works (with a small error $\epsilon_i > 0$)
for times up to a time $n_i$, and then take a limit by compactness (or weak compactness, but
since we are in finite dimension, compactness works fine). Times $n_i$ are chosen to be large
high scores of the sequence $u_n - (A-\epsilon_i) n$, which tends to infinity since $u_n/n$
tends to $A$.\<close>

proposition half_space:
  "\<exists>v. norm v = 1 \<and> (\<forall>l. v \<bullet> (T ^^ l) 0 \<le> - A * l)"
proof -
  define eps::"nat \<Rightarrow> real" where "eps = (\<lambda>i. 1/of_nat (i+1))"
  have "eps i > 0" for i unfolding eps_def by auto
  have "eps \<longlonglongrightarrow> 0"
    unfolding eps_def using LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] by simp
  have vi: "\<exists>vi. norm vi = 1 \<and> (\<forall>l \<le> i. vi \<bullet> (T ^^ l) 0 \<le> (- A + eps i) * l)" for i
  proof -
    have L: "(\<lambda>n. ereal(u n - (A - eps i) * n)) \<longlonglongrightarrow> \<infinity>"
    proof (rule Lim_transform_eventually)
      have "ereal ((u n/n - A) + eps i) * ereal n = ereal(u n - (A - eps i) * n)" if "n \<ge> 1" for n
        using that by (auto simp add: divide_simps algebra_simps)
      then show "eventually (\<lambda>n. ereal ((u n/n - A) + eps i) * ereal n = ereal(u n - (A - eps i) * n)) sequentially"
        unfolding eventually_sequentially by auto

      have "(\<lambda>n. (ereal ((u n/n - A) + eps i)) * ereal n) \<longlonglongrightarrow> (0 + eps i) * \<infinity>"
        apply (intro tendsto_intros)
        using \<open>eps i > 0\<close> Alim by (auto simp add: LIM_zero)
      then show "(\<lambda>n. ereal (u n / real n - A + eps i) * ereal (real n)) \<longlonglongrightarrow> \<infinity>"
        using  \<open>eps i > 0\<close> by simp
    qed
    obtain n where n: "n \<ge> i" "\<And>l. l \<le> n \<Longrightarrow> u l - (A - eps i) * l \<le> u n - (A - eps i) * n"
      using high_scores[OF L, of i] by auto
    obtain vi where vi: "norm vi = 1" "vi \<bullet> ((T^^n) 0) = - norm ((T^^n) 0)"
      using select_unit_norm by auto
    have "vi \<bullet> (T ^^ l) 0 \<le> (- A + eps i) * l" if "l \<le> i" for l
    proof -
      have *: "n = l + (n-l)" using that \<open>n \<ge> i\<close> by auto
      have **: "real (n-l) = real n - real l" using that \<open>n \<ge> i\<close> by auto
      have "vi \<bullet> (T ^^ l) 0 = vi \<bullet> ((T ^^ l) 0 - (T^^n) 0) + vi \<bullet> ((T^^n) 0)"
        by (simp add: inner_diff_right)
      also have "... \<le> norm vi * norm (((T ^^ l) 0 - (T^^n) 0)) + vi \<bullet> ((T^^n) 0)"
        by (simp add: norm_cauchy_schwarz)
      also have "... = dist ((T^^l)(0)) ((T^^n) 0) - norm ((T^^n) 0)"
        using vi by (auto simp add: dist_norm)
      also have "... = dist ((T^^l)(0)) ((T^^l) ((T^^(n-l)) 0)) - norm ((T^^n) 0)"
        by (metis * funpow_add o_apply)
      also have "... \<le> dist 0 ((T^^(n-l)) 0) - norm ((T^^n) 0)"
        using semicontract_Tn[of l 0 "(T^^(n-l)) 0"] by auto
      also have "... = u (n-l) - u n"
        unfolding u_def by auto
      also have "... \<le> - (A - eps i) * l"
        using n(2)[of "n-l"] unfolding ** by (auto simp add: algebra_simps)
      finally show ?thesis by auto
    qed
    then show ?thesis using vi(1) by auto
  qed
  have "\<exists>V::(nat \<Rightarrow> 'a). \<forall>i. norm (V i) = 1 \<and> (\<forall>l\<le>i. V i \<bullet> (T ^^ l) 0 \<le> (- A + eps i) * l)"
    apply (rule choice) using vi by auto
  then obtain V::"nat \<Rightarrow> 'a" where V: "\<And>i. norm (V i) = 1" "\<And>l i. l \<le> i \<Longrightarrow> V i \<bullet> (T ^^ l) 0 \<le> (- A + eps i) * l"
    by auto

  have "compact (sphere (0::'a) 1)" by simp
  moreover have "V i \<in> sphere 0 1" for i using V(1) by auto
  ultimately have "\<exists>v \<in> sphere 0 1. \<exists>r. strict_mono r \<and> (V o r) \<longlonglongrightarrow> v"
    using compact_eq_seq_compact_metric seq_compact_def by metis
  then obtain v r where v: "v \<in> sphere 0 1" "strict_mono r" "(V o r) \<longlonglongrightarrow> v"
    by auto
  have "v \<bullet> (T ^^ l) 0 \<le> - A * l" for l
  proof -
    have *: "(\<lambda>i. (-A + eps (r i)) * l - V (r i) \<bullet> (T ^^ l) 0) \<longlonglongrightarrow> (-A + 0) * l - v \<bullet> (T ^^ l) 0"
      apply (intro tendsto_intros)
      using \<open>(V o r) \<longlonglongrightarrow> v\<close> \<open>eps \<longlonglongrightarrow> 0\<close> \<open>strict_mono r\<close> LIMSEQ_subseq_LIMSEQ unfolding comp_def by auto
    have "eventually (\<lambda>i. (-A + eps (r i)) * l - V (r i) \<bullet> (T ^^ l) 0 \<ge> 0) sequentially"
      unfolding eventually_sequentially apply (rule exI[of _ l])
      using V(2)[of l] seq_suble[OF \<open>strict_mono r\<close>] apply auto using le_trans by blast
    then have " (-A + 0) * l - v \<bullet> (T ^^ l) 0 \<ge> 0"
      using LIMSEQ_le_const[OF *, of 0] unfolding eventually_sequentially by auto
    then show ?thesis by auto
  qed
  then show ?thesis using \<open>v \<in> sphere 0 1\<close> by auto
qed

text \<open>We can now show the existence of an asymptotic translation vector for $T$. It is the vector
$-v$ of the previous proposition: the point $T^\ell(0)$ is in the half-space
at distance $A \ell$ of the origin directed by $v$, and has norm $\sim A \ell$, hence it has
to be essentially $-A v$ by strict convexity of the euclidean norm.\<close>

theorem KNK_thm:
  "convergent (\<lambda>n. ((T^^n) 0) /\<^sub>R n)"
proof -
  obtain v where v: "norm v = 1" "\<And>l. v \<bullet> (T ^^ l) 0 \<le> - A * l"
    using half_space by auto
  have "(\<lambda>n. norm(((T^^n) 0) /\<^sub>R n + A *\<^sub>R v)^2) \<longlonglongrightarrow> 0"
  proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. (norm((T^^n) 0) /\<^sub>R n)^2 - A^2"])
    have "norm(((T^^n) 0) /\<^sub>R n + A *\<^sub>R v)^2 \<le> (norm((T^^n) 0) /\<^sub>R n)^2 - A^2" if "n \<ge> 1" for n
    proof -
      have "norm(((T^^n) 0) /\<^sub>R n + A *\<^sub>R v)^2 = norm(((T^^n) 0) /\<^sub>R n)^2 + A * A * (norm v)^2 + 2 * A * inverse n * (v \<bullet> (T^^n) 0)"
        unfolding power2_norm_eq_inner by (auto simp add: inner_commute algebra_simps)
      also have "... \<le> norm(((T^^n) 0) /\<^sub>R n)^2 + A * A * (norm v)^2 + 2 * A * inverse n * (-A * n)"
        using mult_left_mono[OF v(2)[of n] Apos] \<open>n \<ge> 1\<close> by (auto, auto simp add: divide_simps)
      also have "... = norm(((T^^n) 0) /\<^sub>R n)^2 - A * A"
        using \<open>n \<ge> 1\<close> v(1) by auto
      finally show ?thesis by (simp add: power2_eq_square)
    qed
    then show "eventually (\<lambda>n. norm ((T ^^ n) 0 /\<^sub>R real n + A *\<^sub>R v)^2 \<le> (norm ((T ^^ n) 0) /\<^sub>R real n)\<^sup>2 - A^2) sequentially"
      unfolding eventually_sequentially by auto
    have "(\<lambda>n. (norm ((T ^^ n) 0) /\<^sub>R real n)^2) \<longlonglongrightarrow> A\<^sup>2"
      apply (intro tendsto_intros)
      using Alim unfolding u_def by (auto simp add: divide_simps)
    then show "(\<lambda>n. (norm ((T ^^ n) 0) /\<^sub>R real n)\<^sup>2 - A\<^sup>2) \<longlonglongrightarrow> 0"
      by (simp add: LIM_zero)
  qed (auto)
  then have "(\<lambda>n. sqrt((norm(((T^^n) 0) /\<^sub>R n + A *\<^sub>R v))^2)) \<longlonglongrightarrow> sqrt 0"
    by (intro tendsto_intros)
  then have "(\<lambda>n. norm((((T^^n) 0) /\<^sub>R n) - (- A *\<^sub>R v))) \<longlonglongrightarrow> 0"
    by auto
  then have "(\<lambda>n. ((T^^n) 0) /\<^sub>R n) \<longlonglongrightarrow> - A *\<^sub>R v"
    using Lim_null tendsto_norm_zero_iff by blast
  then show "convergent (\<lambda>n. ((T^^n) 0) /\<^sub>R n)"
    unfolding convergent_def by auto
qed

end

end (*of Kolberg_Neyman_Karlsson.thy*)


chapter {* R8: Deducción natural proposicional en Isabelle/HOL *}

theory R8_Deduccion_natural_proposicional
imports Main
begin

text {*
  Demostrar o refutar los siguientes lemas usando sólo las reglas
  básicas de deducción natural de la lógica proposicional, de los
  cuantificadores y de la igualdad:
  · conjI:      \<lbrakk>P; Q\<rbrakk> \<Longrightarrow> P \<and> Q
  · conjunct1:  P \<and> Q \<Longrightarrow> P
  · conjunct2:  P \<and> Q \<Longrightarrow> Q
  · notnotD:    \<not>\<not> P \<Longrightarrow> P
  · mp:         \<lbrakk>P \<longrightarrow> Q; P\<rbrakk> \<Longrightarrow> Q
  · impI:       (P \<Longrightarrow> Q) \<Longrightarrow> P \<longrightarrow> Q
  · disjI1:     P \<Longrightarrow> P \<or> Q
  · disjI2:     Q \<Longrightarrow> P \<or> Q
  · disjE:      \<lbrakk>P \<or> Q; P \<Longrightarrow> R; Q \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R
  · FalseE:     False \<Longrightarrow> P
  · notE:       \<lbrakk>\<not>P; P\<rbrakk> \<Longrightarrow> R
  · notI:       (P \<Longrightarrow> False) \<Longrightarrow> \<not>P
  · iffI:       \<lbrakk>P \<Longrightarrow> Q; Q \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P = Q
  · iffD1:      \<lbrakk>Q = P; Q\<rbrakk> \<Longrightarrow> P
  · iffD2:      \<lbrakk>P = Q; Q\<rbrakk> \<Longrightarrow> P
  · ccontr:     (\<not>P \<Longrightarrow> False) \<Longrightarrow> P

  · allI:       \<lbrakk>\<forall>x. P x; P x \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R
  · allE:       (\<And>x. P x) \<Longrightarrow> \<forall>x. P x
  · exI:        P x \<Longrightarrow> \<exists>x. P x
  · exE:        \<lbrakk>\<exists>x. P x; \<And>x. P x \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q

  · refl:       t = t
  · subst:      \<lbrakk>s = t; P s\<rbrakk> \<Longrightarrow> P t
  · trans:      \<lbrakk>r = s; s = t\<rbrakk> \<Longrightarrow> r = t
  · sym:        s = t \<Longrightarrow> t = s
  · not_sym:    t \<noteq> s \<Longrightarrow> s \<noteq> t
  · ssubst:     \<lbrakk>t = s; P s\<rbrakk> \<Longrightarrow> P t
  · box_equals: \<lbrakk>a = b; a = c; b = d\<rbrakk> \<Longrightarrow> a: = d
  · arg_cong:   x = y \<Longrightarrow> f x = f y
  · fun_cong:   f = g \<Longrightarrow> f x = g x
  · cong:       \<lbrakk>f = g; x = y\<rbrakk> \<Longrightarrow> f x = g y
*}

text {*
  Se usarán las reglas notnotI, mt y not_ex que demostramos a continuación.
  *}

lemma notnotI: "P \<Longrightarrow> \<not>\<not> P"
by auto

lemma mt: "\<lbrakk>F \<longrightarrow> G; \<not>G\<rbrakk> \<Longrightarrow> \<not>F"
by auto

lemma no_ex: "\<not>(\<exists>x. P(x)) \<Longrightarrow> \<forall>x. \<not>P(x)"
by auto

text {* ---------------------------------------------------------------
  Ejercicio 1. Demostrar
     \<not>q \<longrightarrow> \<not>p \<turnstile> p \<longrightarrow> q
  ------------------------------------------------------------------ *}

lemma ejercicio_1:
  assumes 1: "\<not>q \<longrightarrow> \<not>p"
  shows "p \<longrightarrow> q"
proof -
  {assume 2: "p"
   then have 3: "\<not>\<not>p" by (rule notnotI)
   have 4: "\<not>\<not>q" using 1 3 by (rule mt)
   then have 5: "q" by (rule notnotD)}
  then show "p \<longrightarrow> q" by (rule impI)
qed

lemma ejercicio_1_2:
  assumes "\<not>q \<longrightarrow> \<not>p"
          "p"
  shows "p \<longrightarrow> q"
using assms
by auto

text {* ---------------------------------------------------------------
  Ejercicio 2. Demostrar
     \<not>(\<not>p \<and> \<not>q) \<turnstile> p \<or> q
  ------------------------------------------------------------------ *}

lemma ejercicio_2:
  assumes 1: "\<not>(\<not>p \<and> \<not>q)"
  shows "p \<or> q"
proof -
  {assume 2: "(\<not>p \<and> \<not>q)"
   have 3: "p" using 1 2 by (rule notE)
   then have 4: "p \<or> q" by (rule disjI1)}
   then show "p \<or> q" by auto
qed

lemma ejercicio_2_2:
  assumes "\<not>(\<not>p \<and> \<not>q)" and
          "(\<not>p \<and> \<not>q)"
  shows "p \<or> q"
using assms
by auto

text {* ---------------------------------------------------------------
  Ejercicio 3. Demostrar
     \<not>(\<not>p \<or> \<not>q) \<turnstile> p \<and> q
  ------------------------------------------------------------------ *}

lemma ejercicio_3:
  assumes 1: "\<not>(\<not>p \<or> \<not>q)" and
          2: "(\<not>p \<or> \<not>q)"
  shows "p \<and> q"
proof -
   have 3: "p" using 1 2 by (rule notE)
   have 4: "q" using 1 2 by (rule notE)
   show "p \<and> q" using 3 4 by (rule conjI)
qed

lemma ejercicio_3_2:
  assumes "\<not>(\<not>p \<or> \<not>q)" and
          "(\<not>p \<or> \<not>q)"
  shows "p \<and> q"
using assms
by auto

text {* ---------------------------------------------------------------
  Ejercicio 4. Demostrar
     \<not>(p \<and> q) \<turnstile> \<not>p \<or> \<not>q
  ------------------------------------------------------------------ *}

lemma ejercicio_4:
  assumes 1: "\<not>(p \<and> q)" and
          2: "(p \<and> q)"
  shows "\<not>p \<or> \<not>q"
proof -
   have 3: "\<not>p" using 1 2 by (rule notE)
   show "\<not>p \<or> \<not>q" using 3 by (rule disjI1)
qed

lemma ejercicio_4_2:
  assumes "\<not>(p \<and> q)" and
          "(p \<and> q)"
  shows "\<not>p \<or> \<not>q"
using assms
by auto

text {* ---------------------------------------------------------------
  Ejercicio 5. Demostrar
     \<turnstile> (p \<longrightarrow> q) \<or> (q \<longrightarrow> p)
  ------------------------------------------------------------------ *}

lemma ejercicio_5:
  assumes 1: "q"
  shows "(p \<longrightarrow> q) \<or> (q \<longrightarrow> p)"
proof -
  have 2: "(p \<longrightarrow>q)" using 1 by (rule impI)
  show "(p \<longrightarrow> q) \<or> (q \<longrightarrow> p)" using 2 by (rule disjI1)
qed

lemma ejercicio_5_2:
  assumes "q"
  shows "(p \<longrightarrow> q) \<or> (q \<longrightarrow> p)"
using assms
by auto

end


(*  Title:      HOL/ex/MergeSort.thy
    Author:     Tobias Nipkow
    Copyright   2002 TU Muenchen
*)

section\<open>Merge Sort\<close>

theory MergeSort
imports "HOL-Library.Multiset"
begin

context linorder
begin

fun merge :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
where
  "merge (x#xs) (y#ys) =
         (if x \<le> y then x # merge xs (y#ys) else y # merge (x#xs) ys)"
| "merge xs [] = xs"
| "merge [] ys = ys"

lemma mset_merge [simp]:
  "mset (merge xs ys) = mset xs + mset ys"
  by (induct xs ys rule: merge.induct) (simp_all add: ac_simps)

lemma set_merge [simp]:
  "set (merge xs ys) = set xs \<union> set ys"
  by (induct xs ys rule: merge.induct) auto

lemma sorted_merge [simp]:
  "sorted (merge xs ys) \<longleftrightarrow> sorted xs \<and> sorted ys"
  by (induct xs ys rule: merge.induct) (auto simp add: ball_Un not_le less_le)

fun msort :: "'a list \<Rightarrow> 'a list"
where
  "msort [] = []"
| "msort [x] = [x]"
| "msort xs = merge (msort (take (size xs div 2) xs))
                    (msort (drop (size xs div 2) xs))"

lemma sorted_msort:
  "sorted (msort xs)"
  by (induct xs rule: msort.induct) simp_all

lemma mset_msort:
  "mset (msort xs) = mset xs"
  by (induct xs rule: msort.induct)
    (simp_all, metis append_take_drop_id mset.simps(2) mset_append)

theorem msort_sort:
  "sort = msort"
  by (rule ext, rule properties_for_sort) (fact mset_msort sorted_msort)+

end

end


(*  Author:  Florian Haftmann, TU Muenchen
*)

subsection \<open>Rounded division: modulus centered towards zero.\<close>

theory Rounded_Division
  imports Main
begin

lemma off_iff_abs_mod_2_eq_one:
  \<open>odd l \<longleftrightarrow> \<bar>l\<bar> mod 2 = 1\<close> for l :: int
  by (simp flip: odd_iff_mod_2_eq_one)

definition rounded_divide :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>  (infixl \<open>rdiv\<close> 70)
  where \<open>k rdiv l = sgn l * ((k + \<bar>l\<bar> div 2) div \<bar>l\<bar>)\<close>

definition rounded_modulo :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>  (infixl \<open>rmod\<close> 70)
  where \<open>k rmod l = (k + \<bar>l\<bar> div 2) mod \<bar>l\<bar> - \<bar>l\<bar> div 2\<close>

lemma rdiv_mult_rmod_eq:
  \<open>k rdiv l * l + k rmod l = k\<close>
proof -
  have *: \<open>l * (sgn l * j) = \<bar>l\<bar> * j\<close> for j
    by (simp add: ac_simps abs_sgn)
  show ?thesis
    by (simp add: rounded_divide_def rounded_modulo_def algebra_simps *)
qed

lemma mult_rdiv_rmod_eq:
  \<open>l * (k rdiv l) + k rmod l = k\<close>
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)

lemma rmod_rdiv_mult_eq:
  \<open>k rmod l + k rdiv l * l = k\<close>
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)

lemma rmod_mult_rdiv_eq:
  \<open>k rmod l + l * (k rdiv l) = k\<close>
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)

lemma minus_rdiv_mult_eq_rmod:
  \<open>k - k rdiv l * l = k rmod l\<close>
  by (rule add_implies_diff [symmetric]) (fact rmod_rdiv_mult_eq)

lemma minus_mult_rdiv_eq_rmod:
  \<open>k - l * (k rdiv l) = k rmod l\<close>
  by (rule add_implies_diff [symmetric]) (fact rmod_mult_rdiv_eq)

lemma minus_rmod_eq_rdiv_mult:
  \<open>k - k rmod l = k rdiv l * l\<close>
  by (rule add_implies_diff [symmetric]) (fact rdiv_mult_rmod_eq)

lemma minus_rmod_eq_mult_rdiv:
  \<open>k - k rmod l = l * (k rdiv l)\<close>
  by (rule add_implies_diff [symmetric]) (fact mult_rdiv_rmod_eq)

lemma rdiv_0_eq [simp]:
  \<open>k rdiv 0 = 0\<close>
  by (simp add: rounded_divide_def)

lemma rmod_0_eq [simp]:
  \<open>k rmod 0 = k\<close>
  by (simp add: rounded_modulo_def)

lemma rdiv_1_eq [simp]:
  \<open>k rdiv 1 = k\<close>
  by (simp add: rounded_divide_def)

lemma rmod_1_eq [simp]:
  \<open>k rmod 1 = 0\<close>
  by (simp add: rounded_modulo_def)

lemma zero_rdiv_eq [simp]:
  \<open>0 rdiv k = 0\<close>
  by (auto simp add: rounded_divide_def not_less zdiv_eq_0_iff)

lemma zero_rmod_eq [simp]:
  \<open>0 rmod k = 0\<close>
  by (auto simp add: rounded_modulo_def not_less zmod_trivial_iff)

lemma rdiv_minus_eq:
  \<open>k rdiv - l = - (k rdiv l)\<close>
  by (simp add: rounded_divide_def)

lemma rmod_minus_eq [simp]:
  \<open>k rmod - l = k rmod l\<close>
  by (simp add: rounded_modulo_def)

lemma rdiv_abs_eq:
  \<open>k rdiv \<bar>l\<bar> = sgn l * (k rdiv l)\<close>
  by (simp add: rounded_divide_def)

lemma rmod_abs_eq [simp]:
  \<open>k rmod \<bar>l\<bar> = k rmod l\<close>
  by (simp add: rounded_modulo_def)

lemma nonzero_mult_rdiv_cancel_right:
  \<open>k * l rdiv l = k\<close> if \<open>l \<noteq> 0\<close>
proof -
  have \<open>sgn l * k * \<bar>l\<bar> rdiv l = k\<close>
    using that by (simp add: rounded_divide_def)
  with that show ?thesis
    by (simp add: ac_simps abs_sgn)
qed

lemma rdiv_self_eq [simp]:
  \<open>k rdiv k = 1\<close> if \<open>k \<noteq> 0\<close>
  using that nonzero_mult_rdiv_cancel_right [of k 1] by simp

lemma rmod_self_eq [simp]:
  \<open>k rmod k = 0\<close>
proof -
  have \<open>(sgn k * \<bar>k\<bar> + \<bar>k\<bar> div 2) mod \<bar>k\<bar> = \<bar>k\<bar> div 2\<close>
    by (auto simp add: zmod_trivial_iff)
  also have \<open>sgn k * \<bar>k\<bar> = k\<close>
    by (simp add: abs_sgn)
  finally show ?thesis
    by (simp add: rounded_modulo_def algebra_simps)
qed

lemma signed_take_bit_eq_rmod:
  \<open>signed_take_bit n k = k rmod (2 ^ Suc n)\<close>
  by (simp only: rounded_modulo_def power_abs abs_numeral flip: take_bit_eq_mod)
    (simp add: signed_take_bit_eq_take_bit_shift)

lemma rmod_less_divisor:
  \<open>k rmod l < \<bar>l\<bar> - \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
  using that pos_mod_bound [of \<open>\<bar>l\<bar>\<close>] by (simp add: rounded_modulo_def)

lemma rmod_less_equal_divisor:
  \<open>k rmod l \<le> \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
proof -
  from that rmod_less_divisor [of l k]
  have \<open>k rmod l < \<bar>l\<bar> - \<bar>l\<bar> div 2\<close>
    by simp
  also have \<open>\<bar>l\<bar> - \<bar>l\<bar> div 2 = \<bar>l\<bar> div 2 + of_bool (odd l)\<close>
    by auto
  finally show ?thesis
    by (cases \<open>even l\<close>) simp_all
qed

lemma divisor_less_equal_rmod':
  \<open>\<bar>l\<bar> div 2 - \<bar>l\<bar> \<le> k rmod l\<close> if \<open>l \<noteq> 0\<close>
proof -
  have \<open>0 \<le> (k + \<bar>l\<bar> div 2) mod \<bar>l\<bar>\<close>
    using that pos_mod_sign [of \<open>\<bar>l\<bar>\<close>] by simp
  then show ?thesis
    by (simp_all add: rounded_modulo_def)
qed

lemma divisor_less_equal_rmod:
  \<open>- (\<bar>l\<bar> div 2) \<le> k rmod l\<close> if \<open>l \<noteq> 0\<close>
  using that divisor_less_equal_rmod' [of l k]
  by (simp add: rounded_modulo_def)

lemma abs_rmod_less_equal:
  \<open>\<bar>k rmod l\<bar> \<le> \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
  using that divisor_less_equal_rmod [of l k]
  by (simp add: abs_le_iff rmod_less_equal_divisor)

end


(* Author: Florian Haftmann, TU Muenchen *)

section \<open>Lexical order on functions\<close>

theory Fun_Lexorder
imports Main
begin

definition less_fun :: "('a::linorder \<Rightarrow> 'b::linorder) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
where
  "less_fun f g \<longleftrightarrow> (\<exists>k. f k < g k \<and> (\<forall>k' < k. f k' = g k'))"

lemma less_funI:
  assumes "\<exists>k. f k < g k \<and> (\<forall>k' < k. f k' = g k')"
  shows "less_fun f g"
  using assms by (simp add: less_fun_def)

lemma less_funE:
  assumes "less_fun f g"
  obtains k where "f k < g k" and "\<And>k'. k' < k \<Longrightarrow> f k' = g k'"
  using assms unfolding less_fun_def by blast

lemma less_fun_asym:
  assumes "less_fun f g"
  shows "\<not> less_fun g f"
proof
  from assms obtain k1 where k1: "f k1 < g k1" "k' < k1 \<Longrightarrow> f k' = g k'" for k'
    by (blast elim!: less_funE)
  assume "less_fun g f" then obtain k2 where k2: "g k2 < f k2" "k' < k2 \<Longrightarrow> g k' = f k'" for k'
    by (blast elim!: less_funE)
  show False proof (cases k1 k2 rule: linorder_cases)
    case equal with k1 k2 show False by simp
  next
    case less with k2 have "g k1 = f k1" by simp
    with k1 show False by simp
  next
    case greater with k1 have "f k2 = g k2" by simp
    with k2 show False by simp
  qed
qed

lemma less_fun_irrefl:
  "\<not> less_fun f f"
proof
  assume "less_fun f f"
  then obtain k where k: "f k < f k"
    by (blast elim!: less_funE)
  then show False by simp
qed

lemma less_fun_trans:
  assumes "less_fun f g" and "less_fun g h"
  shows "less_fun f h"
proof (rule less_funI)
  from \<open>less_fun f g\<close> obtain k1 where k1: "f k1 < g k1" "k' < k1 \<Longrightarrow> f k' = g k'" for k'
    by (blast elim!: less_funE)
  from \<open>less_fun g h\<close> obtain k2 where k2: "g k2 < h k2" "k' < k2 \<Longrightarrow> g k' = h k'" for k'
    by (blast elim!: less_funE)
  show "\<exists>k. f k < h k \<and> (\<forall>k'<k. f k' = h k')"
  proof (cases k1 k2 rule: linorder_cases)
    case equal with k1 k2 show ?thesis by (auto simp add: exI [of _ k2])
  next
    case less with k2 have "g k1 = h k1" "\<And>k'. k' < k1 \<Longrightarrow> g k' = h k'" by simp_all
    with k1 show ?thesis by (auto intro: exI [of _ k1])
  next
    case greater with k1 have "f k2 = g k2" "\<And>k'. k' < k2 \<Longrightarrow> f k' = g k'" by simp_all
    with k2 show ?thesis by (auto intro: exI [of _ k2])
  qed
qed

lemma order_less_fun:
  "class.order (\<lambda>f g. less_fun f g \<or> f = g) less_fun"
  by (rule order_strictI) (auto intro: less_fun_trans intro!: less_fun_irrefl less_fun_asym)

lemma less_fun_trichotomy:
  assumes "finite {k. f k \<noteq> g k}"
  shows "less_fun f g \<or> f = g \<or> less_fun g f"
proof -
  { define K where "K = {k. f k \<noteq> g k}"
    assume "f \<noteq> g"
    then obtain k' where "f k' \<noteq> g k'" by auto
    then have [simp]: "K \<noteq> {}" by (auto simp add: K_def)
    with assms have [simp]: "finite K" by (simp add: K_def)
    define q where "q = Min K"
    then have "q \<in> K" and "\<And>k. k \<in> K \<Longrightarrow> k \<ge> q" by auto
    then have "\<And>k. \<not> k \<ge> q \<Longrightarrow> k \<notin> K" by blast
    then have *: "\<And>k. k < q \<Longrightarrow> f k = g k" by (simp add: K_def)
    from \<open>q \<in> K\<close> have "f q \<noteq> g q" by (simp add: K_def)
    then have "f q < g q \<or> f q > g q" by auto
    with * have "less_fun f g \<or> less_fun g f"
      by (auto intro!: less_funI)
  } then show ?thesis by blast
qed

end


(*
  File:     Power_Sum_Puzzle.thy
  Author:   Manuel Eberl, TU München
*)
section \<open>Power sum puzzles\<close>
theory Power_Sum_Puzzle
imports
  Power_Sum_Polynomials
  "Polynomial_Factorization.Rational_Root_Test"
begin

subsection \<open>General setting and results\<close>

text \<open>
  We now consider the following situation: Given unknown complex numbers $x_1,\ldots,x_n$,
  define $p_k = x_1^k + \ldots + x_n^k$. Also, define $e_k := e_k(x_1,\ldots,x_n)$ where
  $e_k(X_1,\ldots,X_n)$ is the $k$-th elementary symmetric polynomial.

  What is the relationship between the sequences $e_k$ and $p_k$; in particular,
  how can we determine one from the other?
\<close>
locale power_sum_puzzle =
  fixes x :: "nat \<Rightarrow> complex"
  fixes n :: nat
begin

text \<open>
  We first introduce the notation $p_k := x_1 ^ k + \ldots + x_n ^ k$:
\<close>
definition p where "p k = (\<Sum>i<n. x i ^ k)"

lemma p_0 [simp]: "p 0 = of_nat n"
  by (simp add: p_def)

lemma p_altdef: "p k = insertion x (powsum_mpoly {..<n} k)"
  by (simp add: p_def)

text \<open>
  Similarly, we introduce the notation $e_k = e_k(x_1,\ldots, x_n)$ where
  $e_k(X_1,\ldots,X_n)$ is the $k$-th elementary symmetric polynomial (i.\,e. the sum of
  all monomials that can be formed by taking the product of exactly $k$ distinct variables).
\<close>
definition e where "e k = (\<Sum>Y | Y \<subseteq> {..<n} \<and> card Y = k. prod x Y)"

lemma e_altdef: "e k = insertion x (sym_mpoly {..<n} k)"
  by (simp add: e_def insertion_sym_mpoly)

text \<open>
  It is clear that $e_k$ vanishes for $k > n$.
\<close>
lemma e_eq_0 [simp]: "k > n \<Longrightarrow> e k = 0"
  by (simp add: e_altdef)

lemma e_0 [simp]: "e 0 = 1"
  by (simp add: e_altdef)

text \<open>
  The recurrences we got from the Girard--Newton Theorem earlier now directly give us
  analogous recurrences for $e_k$ and $p_k$:
\<close>
lemma e_recurrence:
  assumes k: "k > 0"
  shows   "e k = -(\<Sum>i=1..k. (- 1) ^ i * e (k - i) * p i) / of_nat k"
  using assms unfolding e_altdef p_altdef
  by (subst sym_mpoly_recurrence)
     (auto simp: insertion_sum insertion_add insertion_mult insertion_power insertion_sym_mpoly)

lemma p_recurrence:
  assumes k: "k > 0"
  shows   "p k = -of_nat k * (-1) ^ k * e k - (\<Sum>i=1..<k. (-1) ^ i * e i * p (k - i))"
  using assms unfolding e_altdef p_altdef
  by (subst powsum_mpoly_recurrence)
     (auto simp: insertion_sum insertion_add insertion_mult insertion_diff
                 insertion_power insertion_sym_mpoly)

lemma p_recurrence'':
  assumes k: "k > n"
  shows   "p k = -(\<Sum>i=1..n. (-1) ^ i * e i * p (k - i))"
  using assms unfolding e_altdef p_altdef
  by (subst powsum_mpoly_recurrence')
     (auto simp: insertion_sum insertion_add insertion_mult insertion_diff
                 insertion_power insertion_sym_mpoly)

text \<open>
  It is clear from this recurrence that if $p_1$ to $p_n$ are rational, then so are the $e_k$:
\<close>
lemma e_in_Rats:
  assumes "\<And>k. k \<in> {1..n} \<Longrightarrow> p k \<in> \<rat>"
  shows   "e k \<in> \<rat>"
proof (cases "k \<le> n")
  case True
  thus ?thesis
  proof (induction k rule: less_induct)
    case (less k)
    show ?case
    proof (cases "k = 0")
      case False
      thus ?thesis using assms less
        by (subst e_recurrence) (auto intro!: Rats_divide)
    qed auto
  qed
qed auto

text \<open>
  Analogously, if $p_1$ to $p_n$ are rational, then so are all the other $p_k$:
\<close>
lemma p_in_Rats:
  assumes "\<And>k. k \<in> {1..n} \<Longrightarrow> p k \<in> \<rat>"
  shows   "p k \<in> \<rat>"
proof (induction k rule: less_induct)
  case (less k)
  consider "k = 0" | "k \<in> {1..n}" | "k > n"
    by force
  thus ?case
  proof cases
    assume "k > n"
    thus ?thesis
      using less assms by (subst p_recurrence'') (auto intro!: sum_in_Rats Rats_mult e_in_Rats)
  qed (use assms in auto)
qed

text \<open>
  Next, we define the unique monic polynomial that has $x_1, \ldots, x_n$ as its roots
  (respecting multiplicity):
\<close>
definition Q :: "complex poly" where "Q = (\<Prod>i<n. [:-x i, 1:])"

lemma degree_Q [simp]: "Polynomial.degree Q = n"
  by (simp add: Q_def degree_prod_eq_sum_degree)

lemma lead_coeff_Q [simp]: "Polynomial.coeff Q n = 1"
  using monic_prod[of "{..<n}" "\<lambda>i. [:-x i, 1:]"]
  by (simp add: Q_def degree_prod_eq_sum_degree)

text \<open>
  By Vieta's Theorem, we then have:
  \[Q(X) = \sum_{k=0}^n (-1)^{n-k} e_{n-k} X^k\]
  In other words: The above allows us to determine the $x_1, \ldots, x_n$ explicitly.
  They are, in fact, precisely the roots of the above polynomial (respecting multiplicity).
  Since this polynomial depends only on the $e_k$, which are in turn determined by
  $p_1, \ldots, p_n$, this means that these are the \<^emph>\<open>only\<close> solutions of this puzzle
  (up to permutation of the $x_i$).
\<close>
lemma coeff_Q: "Polynomial.coeff Q k = (if k > n then 0 else (-1) ^ (n - k) * e (n - k))"
proof (cases "k \<le> n")
  case True
  thus ?thesis
    using coeff_poly_from_roots[of "{..<n}" k x] by (auto simp: Q_def e_def)
qed (auto simp: Polynomial.coeff_eq_0)

lemma Q_altdef: "Q = (\<Sum>k\<le>n. Polynomial.monom ((-1) ^ (n - k) * e (n - k)) k)"
  by (subst poly_as_sum_of_monoms [symmetric]) (simp add: coeff_Q)

text \<open>
  The following theorem again shows that $x_1, \ldots, x_n$ are precisely the roots
  of \<^term>\<open>Q\<close>, respecting multiplicity.
\<close>
theorem mset_x_eq_poly_roots_Q: "{#x i. i \<in># mset_set {..<n}#} = poly_roots Q"
proof -
  have "poly_roots Q = (\<Sum>i<n. {#x i#})"
    by (simp add: Q_def poly_roots_prod)
  also have "\<dots> = {#x i. i \<in># mset_set {..<n}#}"
    by (induction n) (auto simp: lessThan_Suc)
  finally show ?thesis ..
qed

end

subsection \<open>Existence of solutions\<close>

text \<open>
  So far, we have assumed a solution to the puzzle and then shown the properties that this
  solution must fulfil. However, we have not yet shown that there \<^emph>\<open>is\<close> a solution.
  We will do that now.

  Let $n$ be a natural number and $f_k$ some sequence of complex numbers. We will show that
  there are $x_1, \ldots, x_n$ so that $x_1 ^ k + \ldots + x_n ^ k = f_k$ for any $1\leq k\leq n$.
\<close>
locale power_sum_puzzle_existence =
  fixes f :: "nat \<Rightarrow> complex" and n :: nat
begin

text \<open>
  First, we define a sequence of numbers \<open>e'\<close> analogously to the sequence \<open>e\<close> before,
  except that we replace all occurrences of the power sum $p_k$ with $f_k$ (recall that in the end
  we want $p_k = f_k$).
\<close>
fun e' :: "nat \<Rightarrow> complex"
  where "e' k = (if k = 0 then 1 else if k > n then 0
                 else -(\<Sum>i=1..k. (-1) ^ i * e' (k - i) * f i) / of_nat k)"

lemmas [simp del] = e'.simps

lemma e'_0 [simp]: "e' 0 = 1"
  by (simp add: e'.simps)

lemma e'_eq_0 [simp]: "k > n \<Longrightarrow> e' k = 0"
  by (auto simp: e'.simps)

text \<open>
  Just as before, we can show the following recurrence for \<open>f\<close> in terms of \<open>e'\<close>:
\<close>
lemma f_recurrence:
  assumes k: "k > 0" "k \<le> n"
  shows   "f k = -of_nat k * (-1) ^ k * e' k - (\<Sum>i=1..<k. (- 1) ^ i * e' i * f (k - i))"
proof -
  have "-of_nat k * e' k = (\<Sum>i=1..k. (- 1) ^ i * e' (k - i) * f i)"
    using assms by (subst e'.simps) (simp add: field_simps)
  hence "(-1)^k * (-of_nat k * e' k) = (-1)^k * (\<Sum>i=1..k. (- 1) ^ i * e' (k - i) * f i)"
    by simp
  also have "\<dots> = f k + (-1) ^ k * (\<Sum>i=1..<k. (- 1) ^ i * e' (k - i) * f i)"
    using assms by (subst sum.last_plus) (auto simp: minus_one_power_iff)
  also have "(-1) ^ k * (\<Sum>i=1..<k. (- 1) ^ i * e' (k - i) * f i) =
             (\<Sum>i=1..<k. (- 1) ^ (k - i) * e' (k - i) * f i)"
    unfolding sum_distrib_left by (intro sum.cong) (auto simp: minus_one_power_iff)
  also have "\<dots> = (\<Sum>i=1..<k. (- 1) ^ i * e' i * f (k - i))"
    by (intro sum.reindex_bij_witness[of _ "\<lambda>i. k - i" "\<lambda>i. k - i"]) auto
  finally show ?thesis
    by (simp add: algebra_simps)
qed

text \<open>
  We now define a polynomial whose roots will be precisely the solution $x_1, \ldots, x_n$ to our
  problem.
\<close>
lift_definition Q' :: "complex poly" is "\<lambda>k. if k > n then 0 else (-1) ^ (n - k) * e' (n - k)"
  using eventually_gt_at_top[of n] unfolding cofinite_eq_sequentially
  by eventually_elim auto

lemma coeff_Q': "Polynomial.coeff Q' k = (if k > n then 0 else (-1) ^ (n - k) * e' (n - k))"
  by transfer auto

lemma lead_coeff_Q': "Polynomial.coeff Q' n = 1"
  by (simp add: coeff_Q')

lemma degree_Q' [simp]: "Polynomial.degree Q' = n"
proof (rule antisym)
  show "Polynomial.degree Q' \<ge> n"
    by (rule le_degree) (auto simp: coeff_Q')
  show "Polynomial.degree Q' \<le> n"
    by (rule degree_le) (auto simp: coeff_Q')
qed

text \<open>
  Since the complex numbers are algebraically closed, this polynomial splits into
  linear factors:
\<close>
definition Root :: "nat \<Rightarrow> complex"
  where "Root = (SOME Root. Q' = (\<Prod>i<n. [:-Root i, 1:]))"

text \<open>
  We can therefore now use the results from before for these $x_1, \ldots, x_n$.
\<close>
sublocale power_sum_puzzle Root n .

text \<open>
  Vieta's theorem gives us an expression for the coefficients of \<open>Q'\<close> in terms of
  $e_k(x_1,\ldots,x_n)$. This shows that our \<open>e'\<close> is indeed exactly the same as \<open>e\<close>.
\<close>
lemma e'_eq_e: "e' k = e k"
proof (cases "k \<le> n")
  case True
  from True have "e' k = (-1) ^ k * poly.coeff Q' (n - k)"
    by (simp add: coeff_Q')
  also have "Q' = (\<Prod>x<n. [:-Root x, 1:])"
    using Root by simp
  also have "(-1) ^ k * poly.coeff \<dots> (n - k) = e k"
    using True coeff_poly_from_roots[of "{..<n}" "n - k" Root]
    by (simp add: insertion_sym_mpoly e_altdef)
  finally show "e' k = e k" .
qed auto

text \<open>
  It then follows by a simple induction that $p_k = f_k$ for $1\leq k\leq n$, as intended:
\<close>
lemma p_eq_f:
  assumes "k > 0" "k \<le> n"
  shows   "p k = f k"
  using assms
proof (induction k rule: less_induct)
  case (less k)
  thus "p k = f k"
    using p_recurrence[of k] f_recurrence[of k] less by (simp add: e'_eq_e)
qed

end

text \<open>
  Here is a more condensed form of the above existence theorem:
\<close>
theorem power_sum_puzzle_has_solution:
  fixes f :: "nat \<Rightarrow> complex"
  shows "\<exists>Root. \<forall>k\<in>{1..n}. (\<Sum>i<n. Root i ^ k) = f k"
proof -
  interpret power_sum_puzzle_existence f .
  from p_eq_f have "\<forall>k\<in>{1..n}. (\<Sum>i<n. Root i ^ k) = f k"
    by (auto simp: p_def)
  thus ?thesis by blast
qed

subsection \<open>A specific puzzle\<close>

text \<open>
  We now look at one particular instance of this puzzle, which was given as an exercise in
  \<^emph>\<open>Abstract Algebra\<close> by Dummit and Foote (Exercise 23 in Section 14.6)~\cite{dummit}.

 Suppose we know that
  $x + y + z = 1$, $x^2 + y^2 + z^2 = 2$, and $x^3 + y^3 + z^3 = 3$. Then what is
  $x^5+y^5+z^5$? What about any arbitrary $x^n+y^n+z^n$?
\<close>
locale power_sum_puzzle_example =
  fixes x y z :: complex
  assumes xyz: "x   + y   + z   = 1"
               "x^2 + y^2 + z^2 = 2"
               "x^3 + y^3 + z^3 = 3"
begin

text \<open>
  We reuse the results we have shown in the general case before.
\<close>
definition f where "f n = [x,y,z] ! n"

sublocale power_sum_puzzle f 3 .

text \<open>
  We can simplify \<^term>\<open>p\<close> a bit more now.
\<close>
lemma p_altdef': "p k = x ^ k + y ^ k + z ^ k"
  unfolding p_def f_def by (simp add: eval_nat_numeral)

lemma p_base [simp]: "p (Suc 0) = 1" "p 2 = 2" "p 3 = 3"
  using xyz by (simp_all add: p_altdef')

text \<open>
  We can easily compute all the non-zero values of \<^term>\<open>e\<close> recursively:
\<close>
lemma e_Suc_0 [simp]: "e (Suc 0) = 1"
  by (subst e_recurrence; simp)

lemma e_2 [simp]: "e 2 = -1/2"
  by (subst e_recurrence; simp add: atLeastAtMost_nat_numeral)

lemma e_3 [simp]: "e 3 = 1/6"
  by (subst e_recurrence; simp add: atLeastAtMost_nat_numeral)

text \<open>
  Plugging in all the values, the recurrence relation for \<^term>\<open>p\<close> now looks like this:
\<close>
lemma p_recurrence''': "k > 3 \<Longrightarrow> p k = p (k-3) / 6 + p (k-2) / 2 + p (k-1)"
  using p_recurrence''[of k] by (simp add: atLeastAtMost_nat_numeral)

text \<open>
  Also note again that all $p_k$ are rational:
\<close>
lemma p_in_Rats': "p k \<in> \<rat>"
proof -
  have *: "{1..3} = {1, 2, (3::nat)}"
    by auto
  also have "\<forall>k\<in>\<dots>. p k \<in> \<rat>"
    by auto
  finally show ?thesis
    using p_in_Rats[of k] by simp
qed

text \<open>
  The above recurrence has the characteristic polynomial $X^3 - X^2 - \frac{1}{2} X - \frac{1}{6}$
  (which is exactly our \<^term>\<open>Q\<close>), so we know that can now specify $x$, $y$, and $z$
  more precisely: They are the roots of that polynomial (in unspecified order).
\<close>

lemma xyz_eq: "{#x, y, z#} = poly_roots [:-1/6, -1/2, -1, 1:]"
proof -
  have "image_mset f (mset_set {..<3}) = poly_roots Q"
    using mset_x_eq_poly_roots_Q .
  also have "image_mset f (mset_set {..<3}) = {#x, y, z#}"
    by (simp add: numeral_3_eq_3 lessThan_Suc f_def Multiset.union_ac)
  also have "Q = [:-1/6, -1/2, -1, 1:]"
    by (simp add: Q_altdef atMost_nat_numeral Polynomial.monom_altdef
                  power3_eq_cube power2_eq_square)
  finally show ?thesis .
qed

text \<open>
  Using the rational root test, we can easily show that $x$, $y$, and $z$ are irrational.
\<close>
lemma xyz_irrational: "set_mset (poly_roots [:-1/6, -1/2, -1, 1::complex:]) \<inter> \<rat> = {}"
proof -
  define p :: "rat poly" where "p = [:-1/6, -1/2, -1, 1:]"
  have "rational_root_test p = None"
    unfolding p_def by code_simp
  hence "\<not>(\<exists>x::rat. poly p x = 0)"
    by (rule rational_root_test)
  hence "\<not>(\<exists>x\<in>\<rat>. poly (map_poly of_rat p) x = (0 :: complex))"
    by (auto simp: Rats_def)
  also have "map_poly of_rat p = [:-1/6, -1/2, -1, 1 :: complex:]"
    by (simp add: p_def of_rat_minus of_rat_divide)
  finally show ?thesis
    by auto
qed

text \<open>
  This polynomial is \<^emph>\<open>squarefree\<close>, so these three roots are, in fact, unique (so that there are
  indeed $3! = 6$ possible permutations).
\<close>
lemma rsquarefree: "rsquarefree [:-1/6, -1/2, -1, 1 :: complex:]"
  by (rule coprime_pderiv_imp_rsquarefree)
     (auto simp: pderiv_pCons coprime_iff_gcd_eq_1 gcd_poly_code gcd_poly_code_def content_def
                 primitive_part_def gcd_poly_code_aux_reduce pseudo_mod_def pseudo_divmod_def
                 Let_def Polynomial.monom_altdef normalize_poly_def)

lemma distinct_xyz: "distinct [x, y, z]"
  by (rule rsquarefree_imp_distinct_roots[OF rsquarefree]) (simp_all add: xyz_eq)

text \<open>
  While these roots \<^emph>\<open>can\<close> be written more explicitly in radical form, they are not very pleasant
  to look at. We therefore only compute a few values of \<open>p\<close> just for fun:
\<close>
lemma "p 4 = 25 / 6" and "p 5 = 6" and "p 10 = 15539 / 432"
  by (simp_all add: p_recurrence''')

text \<open>
  Lastly, let us (informally) examine the asymptotics of this problem.

  Two of the roots have a norm of roughly $\beta \approx 0.341$, while the remaining root
  \<open>\<alpha>\<close> is roughly 1.431. Consequently, $x^n + y^n + z^n$ is asymptotically equivalent to $\alpha^n$,
  with the error being bounded by $2\cdot \beta^n$ and therefore goes to 0 very quickly.

  For $p(10) = \frac{15539}{432} \approx 35.97$, for instance, this approximation is correct
  up to 6 decimals (a relative error of about 0.0001\,\%).
\<close>

end

text \<open>
  To really emphasise that the above puzzle has a solution and the locale is not `vacuous',
  here is an interpretation of the locale using the existence theorem from before:
\<close>
notepad
begin
  define f :: "nat \<Rightarrow> complex" where "f = (\<lambda>k. [1,2,3] ! (k - 1))"
  obtain Root :: "nat \<Rightarrow> complex" where Root: "\<And>k. k \<in> {1..3} \<Longrightarrow> (\<Sum>i<3. Root i ^ k) = f k"
    using power_sum_puzzle_has_solution[of 3 f] by metis
  define x y z where "x = Root 0" "y = Root 1" "z = Root 2"
  have "x + y + z = 1" and "x^2 + y^2 + z^2 = 2" and "x^3 + y^3 + z^3 = 3"
    using Root[of 1] Root[of 2] Root[of 3] by (simp_all add: eval_nat_numeral x_y_z_def f_def)
  then interpret power_sum_puzzle_example x y z
    by unfold_locales
  have "p 5 = 6"
    by (simp add: p_recurrence''')
end

end


(*  Title:      HOL/ex/Sqrt.thy
    Author:     Markus Wenzel, Tobias Nipkow, TU Muenchen
*)

section \<open>Square roots of primes are irrational\<close>

theory Sqrt
imports Complex_Main "HOL-Computational_Algebra.Primes"
begin

text \<open>The square root of any prime number (including 2) is irrational.\<close>

theorem sqrt_prime_irrational:
  assumes "prime (p::nat)"
  shows "sqrt p \<notin> \<rat>"
proof
  from \<open>prime p\<close> have p: "1 < p" by (simp add: prime_nat_iff)
  assume "sqrt p \<in> \<rat>"
  then obtain m n :: nat where
      n: "n \<noteq> 0" and sqrt_rat: "\<bar>sqrt p\<bar> = m / n"
    and "coprime m n" by (rule Rats_abs_nat_div_natE)
  have eq: "m\<^sup>2 = p * n\<^sup>2"
  proof -
    from n and sqrt_rat have "m = \<bar>sqrt p\<bar> * n" by simp
    then have "m\<^sup>2 = (sqrt p)\<^sup>2 * n\<^sup>2"
      by (auto simp add: power2_eq_square)
    also have "(sqrt p)\<^sup>2 = p" by simp
    also have "\<dots> * n\<^sup>2 = p * n\<^sup>2" by simp
    finally show ?thesis using of_nat_eq_iff by blast
  qed
  have "p dvd m \<and> p dvd n"
  proof
    from eq have "p dvd m\<^sup>2" ..
    with \<open>prime p\<close> show "p dvd m" by (rule prime_dvd_power_nat)
    then obtain k where "m = p * k" ..
    with eq have "p * n\<^sup>2 = p\<^sup>2 * k\<^sup>2" by (auto simp add: power2_eq_square ac_simps)
    with p have "n\<^sup>2 = p * k\<^sup>2" by (simp add: power2_eq_square)
    then have "p dvd n\<^sup>2" ..
    with \<open>prime p\<close> show "p dvd n" by (rule prime_dvd_power_nat)
  qed
  then have "p dvd gcd m n" by simp
  with \<open>coprime m n\<close> have "p = 1" by simp
  with p show False by simp
qed

corollary sqrt_2_not_rat: "sqrt 2 \<notin> \<rat>"
  using sqrt_prime_irrational[of 2] by simp

subsection \<open>Variations\<close>

text \<open>
  Here is an alternative version of the main proof, using mostly
  linear forward-reasoning.  While this results in less top-down
  structure, it is probably closer to proofs seen in mathematics.
\<close>

theorem
  assumes "prime (p::nat)"
  shows "sqrt p \<notin> \<rat>"
proof
  from \<open>prime p\<close> have p: "1 < p" by (simp add: prime_nat_iff)
  assume "sqrt p \<in> \<rat>"
  then obtain m n :: nat where
      n: "n \<noteq> 0" and sqrt_rat: "\<bar>sqrt p\<bar> = m / n"
    and "coprime m n" by (rule Rats_abs_nat_div_natE)
  from n and sqrt_rat have "m = \<bar>sqrt p\<bar> * n" by simp
  then have "m\<^sup>2 = (sqrt p)\<^sup>2 * n\<^sup>2"
    by (auto simp add: power2_eq_square)
  also have "(sqrt p)\<^sup>2 = p" by simp
  also have "\<dots> * n\<^sup>2 = p * n\<^sup>2" by simp
  finally have eq: "m\<^sup>2 = p * n\<^sup>2" using of_nat_eq_iff by blast
  then have "p dvd m\<^sup>2" ..
  with \<open>prime p\<close> have dvd_m: "p dvd m" by (rule prime_dvd_power_nat)
  then obtain k where "m = p * k" ..
  with eq have "p * n\<^sup>2 = p\<^sup>2 * k\<^sup>2" by (auto simp add: power2_eq_square ac_simps)
  with p have "n\<^sup>2 = p * k\<^sup>2" by (simp add: power2_eq_square)
  then have "p dvd n\<^sup>2" ..
  with \<open>prime p\<close> have "p dvd n" by (rule prime_dvd_power_nat)
  with dvd_m have "p dvd gcd m n" by (rule gcd_greatest)
  with \<open>coprime m n\<close> have "p = 1" by simp
  with p show False by simp
qed

text \<open>Another old chestnut, which is a consequence of the irrationality of 2.\<close>

lemma "\<exists>a b::real. a \<notin> \<rat> \<and> b \<notin> \<rat> \<and> a powr b \<in> \<rat>" (is "\<exists>a b. ?P a b")
proof cases
  assume "sqrt 2 powr sqrt 2 \<in> \<rat>"
  then have "?P (sqrt 2) (sqrt 2)"
    by (metis sqrt_2_not_rat)
  then show ?thesis by blast
next
  assume 1: "sqrt 2 powr sqrt 2 \<notin> \<rat>"
  have "(sqrt 2 powr sqrt 2) powr sqrt 2 = 2"
    using powr_realpow [of _ 2]
    by (simp add: powr_powr power2_eq_square [symmetric])
  then have "?P (sqrt 2 powr sqrt 2) (sqrt 2)"
    by (metis 1 Rats_number_of sqrt_2_not_rat)
  then show ?thesis by blast
qed

end