section \<open>Graphs\<close>

theory Graph imports Main begin

text \<open>
  Let us now define digraphs, graphs, walks, paths, and related concepts.
\<close>

text \<open>@{typ 'a} is the vertex type.\<close>
type_synonym 'a Edge = "'a \<times> 'a"
type_synonym 'a Walk = "'a list"

record 'a Graph =
  verts :: "'a set" ("V\<index>")
  arcs :: "'a Edge set" ("E\<index>")
abbreviation is_arc :: "('a, 'b) Graph_scheme \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "\<rightarrow>\<index>" 60) where
  "v \<rightarrow>\<^bsub>G\<^esub> w \<equiv> (v,w) \<in> E\<^bsub>G\<^esub>"

text \<open>
  We consider directed and undirected finite graphs.  Our graphs do not have multi-edges.
\<close>
locale Digraph =
  fixes G :: "('a, 'b) Graph_scheme" (structure)
  assumes finite_vertex_set: "finite V"
      and valid_edge_set: "E \<subseteq> V \<times> V"

context Digraph begin

lemma finite_edge_set [simp]: "finite E" using finite_vertex_set valid_edge_set
  by (simp add: finite_subset)
lemma edges_are_in_V: assumes "v\<rightarrow>w" shows "v \<in> V" "w \<in> V"
  using assms valid_edge_set by blast+

subsection \<open>Walks\<close>

text \<open>A walk is sequence of vertices connected by edges.\<close>
inductive walk :: "'a Walk \<Rightarrow> bool" where
Nil [simp]: "walk []"
| Singleton [simp]: "v \<in> V \<Longrightarrow> walk [v]"
| Cons: "v\<rightarrow>w \<Longrightarrow> walk (w # vs) \<Longrightarrow> walk (v # w # vs)"

text \<open>
  Show a few composition/decomposition lemmas for walks.  These will greatly simplify the proofs
  that follow.\<close>
lemma walk_2 [simp]: "v\<rightarrow>w \<Longrightarrow> walk [v,w]" by (simp add: edges_are_in_V(2) walk.intros(3))
lemma walk_comp: "\<lbrakk> walk xs; walk ys; xs = Nil \<or> ys = Nil \<or> last xs\<rightarrow>hd ys \<rbrakk> \<Longrightarrow> walk (xs @ ys)"
  by (induct rule: walk.induct, simp_all add: walk.intros(3))
     (metis list.exhaust_sel walk.intros(2) walk.intros(3))
lemma walk_tl: "walk xs \<Longrightarrow> walk (tl xs)" by (induct rule: walk.induct) simp_all
lemma walk_drop: "walk xs \<Longrightarrow> walk (drop n xs)" by (induct n, simp) (metis drop_Suc tl_drop walk_tl)
lemma walk_take: "walk xs \<Longrightarrow> walk (take n xs)"
  by (induct arbitrary: n rule: walk.induct)
     (simp, metis Digraph.walk.simps Digraph_axioms take_Cons' take_eq_Nil,
      metis Digraph.walk.simps Digraph_axioms edges_are_in_V(1) take_Cons')
lemma walk_decomp: assumes "walk (xs @ ys)" shows "walk xs" "walk ys"
  using assms append_eq_conv_conj[of xs ys "xs @ ys"] walk_take walk_drop by metis+
lemma walk_in_V: "walk xs \<Longrightarrow> set xs \<subseteq> V" by (induct rule: walk.induct; simp add: edges_are_in_V)
lemma walk_first_edge: "walk (v # w # xs) \<Longrightarrow> v\<rightarrow>w" using walk.cases by fastforce
lemma walk_first_edge': "\<lbrakk> walk (v # xs); xs \<noteq> Nil \<rbrakk> \<Longrightarrow> v\<rightarrow>hd xs"
  using walk_first_edge by (metis list.exhaust_sel)
lemma walk_middle_edge: "walk (xs @ v # w # ys) \<Longrightarrow> v\<rightarrow>w"
  by (induct "xs @ v # w # ys" arbitrary: xs rule: walk.induct, simp, simp)
     (metis list.sel(1,3) self_append_conv2 tl_append2)
lemma walk_last_edge: "\<lbrakk> walk (xs @ ys); xs \<noteq> Nil; ys \<noteq> Nil \<rbrakk> \<Longrightarrow> last xs\<rightarrow>hd ys"
  using walk_middle_edge[of "butlast xs" "last xs" "hd ys" "tl ys"]
  by (metis Cons_eq_appendI append_butlast_last_id append_eq_append_conv2 list.exhaust_sel self_append_conv)

subsection \<open>Paths\<close>

text \<open>
  A path is a walk without repeated vertices.  This is simple enough, so most of the above lemmas
  transfer directly to paths.
\<close>

abbreviation path :: "'a Walk \<Rightarrow> bool" where "path xs \<equiv> walk xs \<and> distinct xs"

lemma path_singleton [simp]: "v \<in> V \<Longrightarrow> path [v]" by simp
lemma path_2 [simp]: "\<lbrakk> v\<rightarrow>w; v \<noteq> w \<rbrakk> \<Longrightarrow> path [v,w]" by simp
lemma path_cons: "\<lbrakk> path xs; xs \<noteq> Nil; v\<rightarrow>hd xs; v \<notin> set xs \<rbrakk> \<Longrightarrow> path (v # xs)"
  by (metis distinct.simps(2) list.exhaust_sel walk.Cons)
lemma path_comp: "\<lbrakk> walk xs; walk ys; xs = Nil \<or> ys = Nil \<or> last xs\<rightarrow>hd ys; distinct (xs @ ys) \<rbrakk>
  \<Longrightarrow> path (xs @ ys)" using walk_comp by blast

subsection \<open>The Set of All Paths\<close>

definition all_paths where "all_paths \<equiv> { xs | xs. path xs }"

text \<open>
  Because paths have no repeated vertices, every graph has at most finitely many distinct paths.
  This will be useful later to easily derive that any set of paths is finite.
\<close>

lemma finitely_many_paths: "finite all_paths" proof-
  have "all_paths \<subseteq> {xs. set xs \<subseteq> V \<and> length xs \<le> card V}"
    unfolding all_paths_def using path_length by (simp add: Collect_mono path_in_V)
  thus ?thesis using finite_lists_length_le[OF finite_vertex_set] walk_in_V infinite_super by blast
qed

end \<comment> \<open>context Digraph\<close>

text \<open>We introduce shorthand notation for a path connecting two vertices.\<close>

definition path_from_to :: "('a, 'b) Graph_scheme \<Rightarrow> 'a \<Rightarrow> 'a Walk \<Rightarrow> 'a \<Rightarrow> bool"
  ("_ \<leadsto>_\<leadsto>\<index> _" [71, 71, 71] 70) where
  "path_from_to G v xs w \<equiv> Digraph.path G xs \<and> xs \<noteq> Nil \<and> hd xs = v \<and> last xs = w"

context Digraph begin

lemma path_from_toI [intro]: "\<lbrakk> path xs; xs \<noteq> Nil; hd xs = v; last xs = w \<rbrakk> \<Longrightarrow> v \<leadsto>xs\<leadsto> w"
  and path_from_toE [dest]: "v \<leadsto>xs\<leadsto> w \<Longrightarrow> path xs \<and> xs \<noteq> Nil \<and> hd xs = v \<and> last xs = w"
  unfolding path_from_to_def by blast+

lemma path_from_to_ends: "v \<leadsto>(xs @ w # ys)\<leadsto> w \<Longrightarrow> ys = Nil"
  by (metis path_from_toE distinct.simps(2) last.simps last_appendR last_in_set list.discI path_decomp(2))

lemma path_from_to_combine:
  assumes "v \<leadsto>(xs @ x # xs')\<leadsto> w" "v' \<leadsto>(ys @ x # ys')\<leadsto> w'" "set xs \<inter> set ys' = {}"
  shows "v \<leadsto>(xs @ x # ys') \<leadsto> w'"
proof
  show "path (xs @ x # ys')"
    by (metis path_from_toE assms(1,2,3) disjoint_insert(1) distinct_append list.sel(1) list.set(2)
        list.simps(3) path_decomp(2) walk_comp walk_decomp(1) walk_last_edge)
  show "hd (xs @ x # ys') = v" by (metis path_from_toE assms(1) hd_append list.sel(1))
  show "last (xs @ x # ys') = w'" using assms(2) by auto
qed simp

lemma path_from_to_first: "v \<leadsto>xs\<leadsto> w \<Longrightarrow> v \<notin> set (tl xs)"
  by (metis path_from_toE list.collapse path_first_vertex)

lemma path_from_to_first': "v \<leadsto>(xs @ x # xs')\<leadsto> w \<Longrightarrow> v \<notin> set xs'"
  by (metis path_from_toE append_eq_append_conv2 distinct.simps(2) hd_append list.exhaust_sel
      list.sel(3) list.set_sel(1,2) list.simps(3) path_disjoint self_append_conv)

lemma path_from_to_last: "v \<leadsto>xs\<leadsto> w \<Longrightarrow> w \<notin> set (butlast xs)"
  by (metis path_from_toE append_butlast_last_id distinct_append not_distinct_conv_prefix)

lemma path_from_to_last': "v \<leadsto>(xs @ x # xs')\<leadsto> w \<Longrightarrow> w \<notin> set xs"
  by (metis path_from_toE bex_empty last_appendR last_in_set list.set(1) list.simps(3) path_disjoint)

text \<open>Every walk contains a path connecting the same vertices.\<close>

lemma walk_to_path:
  assumes "walk xs" "xs \<noteq> Nil" "hd xs = v" "last xs = w"
  shows "\<exists>ys. v \<leadsto>ys\<leadsto> w \<and> set ys \<subseteq> set xs"
proof-
  text \<open>We prove this by removing loops from @{term xs} until @{term xs} is a path.
    We want to perform induction over @{term "length xs"}, but @{term xs} in
    @{term "set ys \<subseteq> set xs"} should not be part of the induction hypothesis. To accomplish this,
    we hide @{term "set xs"} behind a definition for this specific part of the goal.\<close>
  define target_set where "target_set \<equiv> set xs"
  hence "set xs \<subseteq> target_set" by simp
  thus "\<exists>ys. v \<leadsto>ys\<leadsto> w \<and> set ys \<subseteq> target_set"
  using assms proof (induct "length xs" arbitrary: xs rule: infinite_descent0)
    case (smaller n)
    then obtain xs where
      xs: "n = length xs" "walk xs" "xs \<noteq> Nil" "hd xs = v" "last xs = w" "set xs \<subseteq> target_set" and
      hyp: "\<not>(\<exists>ys. v \<leadsto>ys\<leadsto> w \<and> set ys \<subseteq> target_set)" by blast
    text \<open>If @{term xs} is not a path, then @{term xs} is not distinct and we can decompose it.\<close>
    then obtain ys rest u
      where xs_decomp: "u \<in> set ys" "distinct ys" "xs = ys @ u # rest"
      using not_distinct_conv_prefix by (metis path_from_toI)
    text \<open>@{term u} appears in @{term ys}, so we have a loop in @{term xs} starting from an
      occurrence of @{term u} in @{term ys} ending in the vertex @{term u} in @{term "u # rest"}.
      We define @{term zs} as @{term xs} without this loop.\<close>
    obtain ys' ys_suffix where
      ys_decomp: "ys = ys' @ u # ys_suffix" by (meson split_list xs_decomp(1))
    define zs where "zs \<equiv> ys' @ u # rest"
    have "walk zs" unfolding zs_def using xs(2) xs_decomp(3) ys_decomp
      by (metis walk_decomp list.sel(1) list.simps(3) walk_comp walk_last_edge)
    moreover have "length zs < n" unfolding zs_def by (simp add: xs(1) xs_decomp(3) ys_decomp)
    moreover have "hd zs = v" unfolding zs_def
      by (metis append_is_Nil_conv hd_append list.sel(1) xs(4) xs_decomp(3) ys_decomp)
    moreover have "last zs = w" unfolding zs_def using xs(5) xs_decomp(3) by auto
    moreover have "set zs \<subseteq> target_set" unfolding zs_def using xs(6) xs_decomp(3) ys_decomp by auto
    ultimately show ?case using zs_def hyp by blast
  qed simp
qed

subsection \<open>Edges of Walks\<close>

text \<open>The set of edges on a walk.  Note that this is empty for walks of length 0 or 1.\<close>

definition edges_of_walk :: "'a Walk \<Rightarrow> 'a Edge set" where
  "edges_of_walk xs = { (v,w) | v w xs_pre xs_post. xs = xs_pre @ v # w # xs_post }"

lemma edges_of_walkE: "(v,w) \<in> edges_of_walk xs \<Longrightarrow> \<exists>xs_pre xs_post. xs = xs_pre @ v # w # xs_post"
  unfolding edges_of_walk_def by blast

lemma edges_of_walk_in_E: "walk xs \<Longrightarrow> edges_of_walk xs \<subseteq> E"
  unfolding edges_of_walk_def using walk_middle_edge by auto

lemma edges_of_walk_finite: "walk xs \<Longrightarrow> finite (edges_of_walk xs)"
  using edges_of_walk_in_E finite_edge_set finite_subset by blast

lemma edges_of_walk_empty: "edges_of_walk [] = {}" "edges_of_walk [v] = {}"
  unfolding edges_of_walk_def by simp_all

lemma edges_of_walk_2: "edges_of_walk [v,w] = {(v,w)}" proof
  {
    fix v' w' assume "(v', w') \<in> edges_of_walk [v,w]"
    then obtain xs_pre xs_post where xs_decomp: "[v,w] = xs_pre @ v' # w' # xs_post"
      using edges_of_walkE[of v' w' "[v,w]"] by blast
    then have "xs_pre = Nil"
      by (metis Nil_is_append_conv butlast.simps(2) butlast_append list.discI)
    then have "(v',w') \<in> {(v,w)}" using xs_decomp by simp
  }
  then show "edges_of_walk [v, w] \<subseteq> {(v, w)}" by (simp add: subrelI)
  show "{(v, w)} \<subseteq> edges_of_walk [v, w]" unfolding edges_of_walk_def by blast
qed

lemma edges_of_walk_edge: "\<lbrakk> walk xs; (v,w) \<in> edges_of_walk xs \<rbrakk> \<Longrightarrow> v\<rightarrow>w"
  using edges_of_walkE walk_middle_edge by fastforce

lemma edges_of_walk_middle [simp]: "(v,w) \<in> edges_of_walk (xs @ v # w # xs')"
  unfolding edges_of_walk_def by blast

lemma edges_of_comp1: "edges_of_walk xs \<subseteq> edges_of_walk (xs @ ys)"
  unfolding edges_of_walk_def by force
lemma edges_of_comp2: "edges_of_walk ys \<subseteq> edges_of_walk (xs @ ys)" proof-
  {
    fix v w assume "(v,w) \<in> edges_of_walk ys"
    then have "\<exists>ys_pre ys_post. ys = ys_pre @ v # w # ys_post" by (meson edges_of_walkE)
    then have "(v,w) \<in> edges_of_walk (xs @ ys)"
      by (metis (mono_tags, lifting) append.assoc edges_of_walk_def mem_Collect_eq)
  }
  then show ?thesis by (simp add: subrelI)
qed

lemma walk_edges_decomp_simple:
  "edges_of_walk (v # w # xs) = {(v,w)} \<union> edges_of_walk (w # xs)" (is "?A = ?B")
proof
  have "edges_of_walk (w # xs) \<subseteq> ?A" using edges_of_comp2[of "w # xs" "[v]"] by simp
  moreover have "(v,w) \<in> ?A" by (metis append_eq_Cons_conv edges_of_walk_middle)
  ultimately show "?B \<subseteq> ?A" by blast
  {
    fix v' w' assume "(v',w') \<in> ?A"
    then obtain xs_pre xs_post where xs_decomp: "v # w # xs = xs_pre @ v' # w' # xs_post"
      using edges_of_walkE by blast
    have "(v',w') \<in> ?B" proof (cases)
      assume "xs_pre = Nil" then show ?thesis using xs_decomp by auto
    next
      assume "xs_pre \<noteq> Nil" then show ?thesis
        by (metis Cons_eq_append_conv UnI2 edges_of_walk_middle xs_decomp)
    qed
  }
  then show "?A \<subseteq> ?B" by auto
qed

lemma walk_edges_decomp:
  "edges_of_walk (xs @ x # xs') = edges_of_walk (xs @ [x]) \<union> edges_of_walk (x # xs')"
proof (induct xs)
  case (Cons v xs)
  show ?case proof (cases)
    assume "xs = Nil"
    then show ?thesis using edges_of_walk_2 walk_edges_decomp_simple by auto
  next
    assume "xs \<noteq> Nil"
    then obtain w xs_post where "xs = w # xs_post" using list.exhaust_sel by blast
    then show ?thesis using Cons.hyps walk_edges_decomp_simple by auto
  qed
qed (simp add: edges_of_walk_empty(2))

lemma walk_edges_vertices: assumes "(v, w) \<in> edges_of_walk xs" shows "v \<in> set xs" "w \<in> set xs"
  using assms edges_of_walkE by force+

lemma walk_edges_subset:
  assumes edges_subsets: "edges_of_walk xs \<subseteq> edges_of_walk ys"
    and non_trivial: "tl xs \<noteq> Nil"
  shows "set xs \<subseteq> set ys"
proof
  fix v assume "v \<in> set xs"
  then obtain xs_pre xs_post where
    xs_decomp: "xs = xs_pre @ v # xs_post" by (meson split_list)
  show "v \<in> set ys" proof (cases)
    assume "xs_pre = Nil"
    then have "xs_post \<noteq> Nil" using xs_decomp non_trivial by auto
    then have "xs = xs_pre @ v # hd xs_post # tl xs_post" by (simp add: xs_decomp)
    then have "(v, hd xs_post) \<in> edges_of_walk xs" using edges_of_walk_def by auto
    then show ?thesis using walk_edges_vertices(1) edges_subsets by fastforce
  next
    assume "xs_pre \<noteq> Nil"
    then have "xs = butlast xs_pre @ last xs_pre # v # xs_post" by (simp add: xs_decomp)
    then have "(last xs_pre, v) \<in> edges_of_walk xs" using edges_of_walk_def by auto
    then show ?thesis using walk_edges_vertices(2) edges_subsets by fastforce
  qed
qed

text \<open>
  A path has no repeated vertices, so if we split a path at an edge we find that the two pieces
  do not contain this edge any more.
\<close>

lemma path_edges:
  assumes "path xs" "(v,w) \<in> edges_of_walk xs"
  shows "\<exists>xs_pre xs_post. xs = xs_pre @ v # w # xs_post
    \<and> (v,w) \<notin> edges_of_walk (xs_pre @ [v])
    \<and> (v,w) \<notin> edges_of_walk (w # xs_post)"
proof-
  obtain xs_pre xs_post where
    xs_decomp: "xs = xs_pre @ v # w # xs_post" by (meson assms(2) edges_of_walkE)
  then have "(v,w) \<notin> edges_of_walk (xs_pre @ [v])" using assms(1) edges_of_walkE
    by (metis path_from_to_ends list.discI path_decomp' path_from_toI snoc_eq_iff_butlast)
  moreover have "(v,w) \<notin> edges_of_walk (w # xs_post)" using  assms(1)
    by (metis edges_of_walkE in_set_conv_decomp path_decomp(2) path_first_vertex xs_decomp)
  ultimately show ?thesis using xs_decomp by blast
qed

lemma path_edges_remove_prefix:
  assumes "path (xs @ x # xs')"
  shows "edges_of_walk (xs @ [x]) = edges_of_walk (xs @ x # xs') - edges_of_walk (x # xs')"
proof-
  {
    fix v w assume *: "(v,w) \<in> edges_of_walk (xs @ [x])"
    then have 1: "(v,w) \<in> edges_of_walk (xs @ x # xs')"
      using walk_edges_decomp[of xs x xs'] by force
    moreover have "(v,w) \<notin> edges_of_walk (x # xs')" proof
      assume contra: "(v,w) \<in> edges_of_walk (x # xs')"
      then have "w \<in> set (x # xs')" by (meson walk_edges_vertices(2))
      moreover have "w \<noteq> x" using assms contra * 1
        by (metis path_decomp(2) UnE edges_of_walkE edges_of_walk_edge list.set_intros(1)
            path_2 path_disjoint path_first_vertex self_append_conv2 set_append walk_edges_vertices(1))
      moreover have "w \<in> set (xs @ [x])" by (meson * walk_edges_vertices(2))
      ultimately show False using assms by auto
    qed
    ultimately have "(v,w) \<in> edges_of_walk (xs @ x # xs') - edges_of_walk (x # xs')" by blast
  }
  then show ?thesis using walk_edges_decomp[of xs x xs'] by auto
qed

subsection \<open>The First Edge of a Walk\<close>

text \<open>
  In the proof of Menger's Theorem, we will often talk about the first edge of a path.  Let us
  define this concept.
\<close>

fun first_edge_of_walk where
  "first_edge_of_walk (v # w # xs) = (v, w)"
| "first_edge_of_walk [v] = undefined"
| "first_edge_of_walk [] = undefined"

lemma first_edge_in_edges: "tl xs \<noteq> Nil \<Longrightarrow> first_edge_of_walk xs \<in> edges_of_walk xs"
  unfolding edges_of_walk_def by (induct rule: first_edge_of_walk.induct) auto

lemma first_edge_hd_tl: "\<lbrakk> v \<leadsto>xs\<leadsto> w; tl xs \<noteq> Nil \<rbrakk> \<Longrightarrow> first_edge_of_walk xs = (v, hd (tl xs))"
  by (induct "xs" rule: first_edge_of_walk.induct) auto

lemma first_edge_first:
  assumes "v \<leadsto>xs\<leadsto> w" "(v,w') \<in> edges_of_walk xs"
  shows "first_edge_of_walk xs = (v,w')"
using assms proof (induct rule: first_edge_of_walk.induct)
  case (1 v w xs)
  then show ?case
    by (metis path_decomp(1) append_self_conv2 edges_of_walkE first_edge_of_walk.simps(1)
        hd_append hd_in_set not_distinct_conv_prefix path_from_toE)
next
  case (2 v)
  then show ?case using path_edges by fastforce
qed blast

subsection \<open>Distance\<close>

text \<open>
  The distance between two vertices is the minimum length of a path.  Note that this is not a
  symmetric function because we are on digraphs.
\<close>
definition distance :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where
  "distance v w \<equiv> Min { length xs | xs. v\<leadsto>xs\<leadsto>w }"

text \<open>
  The @{const Min} operator applies only to finite sets, so let us prove that this is the case.
\<close>
lemma distance_lengths_finite: "finite { length xs | xs. v\<leadsto>xs\<leadsto>w }" proof-
  have "{ length xs | xs. v\<leadsto>xs\<leadsto>w } \<subseteq> { n | n. n \<le> card V }" using path_length by blast
  then show ?thesis using finite_Collect_le_nat by (meson finite_subset)
qed

text \<open>
  If we have a concrete path from @{term v} to @{term w}, then the length of this path bounds the
  distance from @{term v} to @{term w}.
\<close>

lemma distance_upper_bound: "v\<leadsto>xs\<leadsto>w \<Longrightarrow> distance v w \<le> length xs"
  unfolding distance_def using Min_le[OF distance_lengths_finite] by blast

text \<open>
  Another characterization of @{const distance}: If we have a concrete minimal path from @{term v}
  to @{term w}, this defines the distance.
\<close>

lemma distance_witness:
  assumes xs: "v \<leadsto>xs\<leadsto> w"
      and xs_min: "\<And>xs'. v \<leadsto>xs'\<leadsto> w \<Longrightarrow> length xs \<le> length xs'"
  shows "distance v w = length xs"
proof-
  have "\<And>d. d \<in> {length xs | xs. v \<leadsto>xs\<leadsto> w} \<Longrightarrow> length xs \<le> d" using xs_min by blast
  then show ?thesis unfolding distance_def using Min_eqI
    by (metis (mono_tags, lifting) distance_lengths_finite xs mem_Collect_eq)
qed

subsection \<open>Subgraphs\<close>

text \<open>We only need one kind of subgraph: The subgraph obtained by removing a single vertex.\<close>

definition remove_vertex :: "'a \<Rightarrow> ('a, 'b) Graph_scheme" where
  "remove_vertex x \<equiv> G\<lparr> verts := V - {x}, arcs := Restr E (V - {x}) \<rparr>"

lemma remove_vertex_V: "V\<^bsub>remove_vertex x\<^esub> = V - {x}" unfolding remove_vertex_def by auto
lemma remove_vertex_V': "V\<^bsub>remove_vertex x\<^esub> \<subseteq> V" unfolding remove_vertex_def by auto
lemma remove_vertex_E: "E\<^bsub>remove_vertex x\<^esub> = Restr E (V - {x})" unfolding remove_vertex_def by simp
lemma remove_vertex_E': "v \<rightarrow>\<^bsub>remove_vertex x\<^esub> w \<Longrightarrow> v\<rightarrow>w" by (simp add: remove_vertex_E)
lemma remove_vertex_E'': "\<lbrakk> v\<rightarrow>w; v \<noteq> x; w \<noteq> x \<rbrakk> \<Longrightarrow> v \<rightarrow>\<^bsub>remove_vertex x\<^esub> w"
  by (simp add: edges_are_in_V remove_vertex_E)

text \<open>Of course, this is still a digraph.\<close>
lemma remove_vertex_Digraph: "Digraph (remove_vertex v)" proof
  let ?V = "V\<^bsub>remove_vertex v\<^esub>" let ?E = "E\<^bsub>remove_vertex v\<^esub>"
  show "finite ?V" unfolding remove_vertex_def using finite_vertex_set by simp
  show "?E \<subseteq> ?V \<times> ?V" proof
    fix e assume "e \<in> ?E"
    then have "e \<in> (V - {v}) \<times> (V - {v})" by (metis Int_iff remove_vertex_E)
    then show "e \<in> ?V \<times> ?V" using remove_vertex_V by auto
  qed
  have "\<And>x y. \<lbrakk> (x,y) \<in> ?E; (x,y) \<notin> E \<rbrakk> \<Longrightarrow> (y,x) \<in> ?E" unfolding remove_vertex_def by simp
qed

text \<open>
  We are also going to need a few lemmas about how walks and paths behave when we remove a vertex.

  First, if we remove a vertex that is not on a walk @{term xs}, then @{term xs} is still a walk
  after removing this vertex.
\<close>

lemma remove_vertex_walk:
  assumes "walk xs" "x \<notin> set xs"
  shows "Digraph.walk (remove_vertex x) xs"
proof-
  interpret H: Digraph "remove_vertex x" using remove_vertex_Digraph by blast
  show ?thesis using assms proof (induct rule: walk.induct)
    case (Singleton v)
    then have "v \<in> V - {x}" by simp
    then show ?case using remove_vertex_V by simp
  next
    case (Cons v w vs)
    then have "v \<rightarrow>\<^bsub>remove_vertex x\<^esub> w" using remove_vertex_E'' by auto
    then show ?case
      by (meson Cons.hyps(3) Cons.prems(1) H.Cons assms(2) list.set_intros(2))
  qed simp
qed

text \<open>The same holds for paths.\<close>

lemma remove_vertex_path_from_to:
  "\<lbrakk> v \<leadsto>xs\<leadsto> w; x \<in> V; x \<notin> set xs \<rbrakk> \<Longrightarrow> v \<leadsto>xs\<leadsto>\<^bsub>remove_vertex x\<^esub> w"
  using path_from_to_def remove_vertex_walk by fastforce

text \<open>
  Conversely, if something was a walk or a path in the subgraph, then it is also a walk or a path
  in the supergraph.
\<close>
lemma remove_vertex_walk_add:
  assumes "Digraph.walk (remove_vertex x) xs"
  shows "walk xs"
proof-
  interpret H: Digraph "remove_vertex x" using remove_vertex_Digraph by blast
  show ?thesis using assms proof (induct rule: H.walk.induct)
    case (Singleton v)
    then show ?case by (meson Digraph.Singleton Digraph_axioms remove_vertex_V' subsetD)
  next
    case (Cons v w vs)
    then show ?case by (meson Digraph.Cons Digraph_axioms remove_vertex_E')
  qed simp
qed

lemma remove_vertex_path_from_to_add: "v \<leadsto>xs\<leadsto>\<^bsub>remove_vertex x\<^esub> w \<Longrightarrow> v \<leadsto>xs\<leadsto> w"
  using path_from_to_def remove_vertex_walk_add by fastforce

end \<comment> \<open>context Digraph\<close>

subsection \<open>Two Distinguished Distinct Non-adjacent Vertices.\<close>

text \<open>
  The setup for Menger's Theorem requires two distinguished distinct non-adjacent vertices
  @{term v0} and @{term v1}.  Let us pin down this concept with the following locale.
\<close>

locale v0_v1_Digraph = Digraph +
  fixes v0 v1 :: "'a"
  assumes v0_V: "v0 \<in> V" and v1_V: "v1 \<in> V"
    and v0_nonadj_v1: "\<not>v0\<rightarrow>v1"
    and v0_neq_v1: "v0 \<noteq> v1"

text \<open>
  The only lemma we need about @{locale v0_v1_Digraph} for now is that it is closed under removing
  a vertex that is not @{term v0} or @{term v1}.
\<close>
lemma (in v0_v1_Digraph) remove_vertices_v0_v1_Digraph:
  assumes "v \<noteq> v0" "v \<noteq> v1"
  shows "v0_v1_Digraph (remove_vertex v) v0 v1"
proof (rule v0_v1_Digraph.intro)
  show "v0_v1_Digraph_axioms (remove_vertex v) v0 v1"
    using assms v0_nonadj_v1 v0_neq_v1 v0_V v1_V remove_vertex_V remove_vertex_E'
    by unfold_locales blast+
qed (simp add: remove_vertex_Digraph)

subsection \<open>Undirected Graphs\<close>

text \<open>
  We represent undirecteded graphs as a special case of digraphs where every undirected edge
  is represented as an edge in both directions.  We also exclude loops because loops are uncommon
  in undirected graphs.

  As we will explain in the next paragraph, all of this has no bearing on the validity of
  Menger's Theorem for undirected graphs.
\<close>

locale Graph = Digraph +
  assumes undirected: "v\<rightarrow>w = w\<rightarrow>v"
      and no_loops: "\<not>v\<rightarrow>v"

text \<open>
  We observe that this makes @{locale Digraph} a sublocale of @{locale Graph}, meaning that every
  theorem we prove for digraphs automatically holds for undirected graphs, although it may not make
  sense because for example ``connectedness'' (if we were to define it) would need different
  definitions for directed and undirected graphs.

  Fortunately, the notions of ``separator'' and ``internally vertex-disjoint paths'' on directed
  graphs are the same for undirected graphs.  So Menger's Theorem, when we eventually prove it in
  the @{locale Digraph} locale, will apply automatically to the @{locale Graph} locale without
  any additional work.

  For this reason we will not use the @{term Graph} locale again in this proof development and it
  exists merely to show that undirected graphs are covered as a special case by our definitions.
\<close>

end


(*
  File:   Master_Theorem_Examples.thy
  Author: Manuel Eberl <manuel@pruvisto.org>

  Examples for the application of the Master theorem and related proof methods.
*)

section \<open>Examples\<close>
theory Master_Theorem_Examples
imports
  Complex_Main
  Akra_Bazzi_Method
  Akra_Bazzi_Approximation
begin

subsection \<open>Merge sort\<close>

(* A merge sort cost function that is parametrised with the recombination costs *)
function merge_sort_cost :: "(nat \<Rightarrow> real) \<Rightarrow> nat \<Rightarrow> real" where
  "merge_sort_cost t 0 = 0"
| "merge_sort_cost t 1 = 1"
| "n \<ge> 2 \<Longrightarrow> merge_sort_cost t n =
     merge_sort_cost t (nat \<lfloor>real n / 2\<rfloor>) + merge_sort_cost t (nat \<lceil>real n / 2\<rceil>) + t n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma merge_sort_nonneg[simp]: "(\<And>n. t n \<ge> 0) \<Longrightarrow> merge_sort_cost t x \<ge> 0"
  by (induction t x rule: merge_sort_cost.induct) (simp_all del: One_nat_def)

lemma "t \<in> \<Theta>(\<lambda>n. real n) \<Longrightarrow> (\<And>n. t n \<ge> 0) \<Longrightarrow> merge_sort_cost t \<in> \<Theta>(\<lambda>n. real n * ln (real n))"
  by (master_theorem 2.3) simp_all

subsection \<open>Karatsuba multiplication\<close>

function karatsuba_cost :: "nat \<Rightarrow> real" where
  "karatsuba_cost 0 = 0"
| "karatsuba_cost 1 = 1"
| "n \<ge> 2 \<Longrightarrow> karatsuba_cost n =
     3 * karatsuba_cost (nat \<lceil>real n / 2\<rceil>) + real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma karatsuba_cost_nonneg[simp]: "karatsuba_cost n \<ge> 0"
  by (induction n rule: karatsuba_cost.induct) (simp_all del: One_nat_def)

lemma "karatsuba_cost \<in> O(\<lambda>n. real n powr log 2 3)"
   by (master_theorem 1 p': 1) (simp_all add: powr_divide)

lemma karatsuba_cost_pos: "n \<ge> 1 \<Longrightarrow> karatsuba_cost n > 0"
  by (induction n rule: karatsuba_cost.induct) (auto intro!: add_nonneg_pos simp del: One_nat_def)

lemma "karatsuba_cost \<in> \<Theta>(\<lambda>n. real n powr log 2 3)"
  using karatsuba_cost_pos
  by (master_theorem 1 p': 1) (auto simp add: powr_divide eventually_at_top_linorder)

subsection \<open>Strassen matrix multiplication\<close>

function strassen_cost :: "nat \<Rightarrow> real" where
  "strassen_cost 0 = 0"
| "strassen_cost 1 = 1"
| "n \<ge> 2 \<Longrightarrow> strassen_cost n = 7 * strassen_cost (nat \<lceil>real n / 2\<rceil>) + real (n^2)"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma strassen_cost_nonneg[simp]: "strassen_cost n \<ge> 0"
  by (induction n rule: strassen_cost.induct) (simp_all del: One_nat_def)

lemma "strassen_cost \<in> O(\<lambda>n. real n powr log 2 7)"
  by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder)

lemma strassen_cost_pos: "n \<ge> 1 \<Longrightarrow> strassen_cost n > 0"
  by (cases n rule: strassen_cost.cases) (simp_all add: add_nonneg_pos del: One_nat_def)

lemma "strassen_cost \<in> \<Theta>(\<lambda>n. real n powr log 2 7)"
  using strassen_cost_pos
  by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder)

subsection \<open>Deterministic select\<close>

(* This is not possible with the standard Master theorem from literature *)
function select_cost :: "nat \<Rightarrow> real" where
  "n \<le> 20 \<Longrightarrow> select_cost n = 0"
| "n > 20 \<Longrightarrow> select_cost n =
     select_cost (nat \<lfloor>real n / 5\<rfloor>) + select_cost (nat \<lfloor>7 * real n / 10\<rfloor> + 6) + 12 * real n / 5"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "select_cost \<in> \<Theta>(\<lambda>n. real n)"
  by (master_theorem 3) auto

subsection \<open>Decreasing function\<close>

function dec_cost :: "nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> dec_cost n = 1"
| "n > 2 \<Longrightarrow> dec_cost n = 0.5*dec_cost (nat \<lfloor>real n / 2\<rfloor>) + 1 / real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "dec_cost \<in> \<Theta>(\<lambda>x::nat. ln x / x)"
  by (master_theorem 2.3) simp_all

subsection \<open>Example taken from Drmota and Szpakowski\<close>

function drmota1 :: "nat \<Rightarrow> real" where
  "n < 20 \<Longrightarrow> drmota1 n = 1"
| "n \<ge> 20 \<Longrightarrow> drmota1 n = 2 * drmota1 (nat \<lfloor>real n/2\<rfloor>) + 8/9 * drmota1 (nat \<lfloor>3*real n/4\<rfloor>) + real n^2 / ln (real n)"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "drmota1 \<in> \<Theta>(\<lambda>n::real. n^2 * ln (ln n))"
  by (master_theorem 2.2) (simp_all add: power_divide)

function drmota2 :: "nat \<Rightarrow> real" where
  "n < 20 \<Longrightarrow> drmota2 n = 1"
| "n \<ge> 20 \<Longrightarrow> drmota2 n = 1/3 * drmota2 (nat \<lfloor>real n/3 + 1/2\<rfloor>) + 2/3 * drmota2 (nat \<lfloor>2*real n/3 - 1/2\<rfloor>) + 1"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma "drmota2 \<in> \<Theta>(\<lambda>x. ln (real x))"
  by master_theorem simp_all

(* Average phrase length of Boncelet arithmetic coding. See Drmota and Szpankowski. *)
lemma boncelet_phrase_length:
  fixes p \<delta> :: real assumes p: "p > 0" "p < 1" and \<delta>: "\<delta> > 0" "\<delta> < 1" "2*p + \<delta> < 2"
  fixes d :: "nat \<Rightarrow> real"
  defines "q \<equiv> 1 - p"
  assumes d_nonneg: "\<And>n. d n \<ge> 0"
  assumes d_rec: "\<And>n. n \<ge> 2 \<Longrightarrow> d n = 1 + p * d (nat \<lfloor>p * real n + \<delta>\<rfloor>) + q * d (nat \<lfloor>q * real n - \<delta>\<rfloor>)"
  shows   "d \<in> \<Theta>(\<lambda>x. ln x)"
  using assms by (master_theorem recursion: d_rec, simp_all)

subsection \<open>Transcendental exponents\<close>

(* Certain number-theoretic conjectures would imply that if all the parameters are rational,
   the Akra-Bazzi parameter is either rational or transcendental. That makes this case
   probably transcendental *)
function foo_cost :: "nat \<Rightarrow> real" where
  "n < 200 \<Longrightarrow> foo_cost n = 0"
| "n \<ge> 200 \<Longrightarrow> foo_cost n =
     foo_cost (nat \<lfloor>real n / 3\<rfloor>) + foo_cost (nat \<lfloor>3 * real n / 4\<rfloor> + 42) + real n"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma foo_cost_nonneg [simp]: "foo_cost n \<ge> 0"
  by (induction n rule: foo_cost.induct) simp_all

lemma "foo_cost \<in> \<Theta>(\<lambda>n. real n powr akra_bazzi_exponent [1,1] [1/3,3/4])"
proof (master_theorem 1 p': 1)
  have "\<forall>n\<ge>200. foo_cost n > 0" by (simp add: add_nonneg_pos)
  thus "eventually (\<lambda>n. foo_cost n > 0) at_top" unfolding eventually_at_top_linorder by blast
qed simp_all

lemma "akra_bazzi_exponent [1,1] [1/3,3/4] \<in> {1.1519623..1.1519624}"
  by (akra_bazzi_approximate 29)

subsection \<open>Functions in locale contexts\<close>

locale det_select =
  fixes b :: real
  assumes b: "b > 0" "b < 7/10"
begin

function select_cost' :: "nat \<Rightarrow> real" where
  "n \<le> 20 \<Longrightarrow> select_cost' n = 0"
| "n > 20 \<Longrightarrow> select_cost' n =
     select_cost' (nat \<lfloor>real n / 5\<rfloor>) + select_cost' (nat \<lfloor>b * real n\<rfloor> + 6) + 6 * real n + 5"
by force simp_all
termination using b by akra_bazzi_termination simp_all

lemma "a \<ge> 0 \<Longrightarrow> select_cost' \<in> \<Theta>(\<lambda>n. real n)"
  using b by (master_theorem 3, force+)

end

subsection \<open>Non-curried functions\<close>

(* Note: either a or b could be seen as recursion variables. *)
function baz_cost :: "nat \<times> nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> baz_cost (a, n) = 0"
| "n > 2 \<Longrightarrow> baz_cost (a, n) = 3 * baz_cost (a, nat \<lfloor>real n / 2\<rfloor>) + real a"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma baz_cost_nonneg [simp]: "a \<ge> 0 \<Longrightarrow> baz_cost (a, n) \<ge> 0"
  by (induction a n rule: baz_cost.induct[split_format (complete)]) simp_all

lemma
  assumes "a > 0"
  shows   "(\<lambda>x. baz_cost (a, x)) \<in> \<Theta>(\<lambda>x. x powr log 2 3)"
proof (master_theorem 1 p': 0)
  from assms have "\<forall>x\<ge>3. baz_cost (a, x) > 0" by (auto intro: add_nonneg_pos)
  thus "eventually (\<lambda>x. baz_cost (a, x) > 0) at_top" by (force simp: eventually_at_top_linorder)
qed (insert assms, simp_all add: powr_divide)

(* Non-"Akra-Bazzi" variables may even be modified without impacting the termination proof.
   However, the Akra-Bazzi theorem and the Master theorem itself do not apply anymore,
   because bar_cost cannot be seen as a recursive function with one parameter *)
function bar_cost :: "nat \<times> nat \<Rightarrow> real" where
  "n \<le> 2 \<Longrightarrow> bar_cost (a, n) = 0"
| "n > 2 \<Longrightarrow> bar_cost (a, n) = 3 * bar_cost (2 * a, nat \<lfloor>real n / 2\<rfloor>) + real a"
by force simp_all
termination by akra_bazzi_termination simp_all

subsection \<open>Ham-sandwich trees\<close>
(* f(n) = f(n/4) + f(n/2) + 1 *)
function ham_sandwich_cost :: "nat \<Rightarrow> real" where
  "n < 4 \<Longrightarrow> ham_sandwich_cost n = 1"
| "n \<ge> 4 \<Longrightarrow> ham_sandwich_cost n =
      ham_sandwich_cost (nat \<lfloor>n/4\<rfloor>) + ham_sandwich_cost (nat \<lfloor>n/2\<rfloor>) + 1"
by force simp_all
termination by akra_bazzi_termination simp_all

lemma ham_sandwich_cost_pos [simp]: "ham_sandwich_cost n > 0"
  by (induction n rule: ham_sandwich_cost.induct) simp_all

text \<open>The golden ratio\<close>

definition "\<phi> = ((1 + sqrt 5) / 2 :: real)"

lemma \<phi>_pos [simp]: "\<phi> > 0" and \<phi>_nonneg [simp]: "\<phi> \<ge> 0" and \<phi>_nonzero [simp]: "\<phi> \<noteq> 0"
proof-
  show "\<phi> > 0" unfolding \<phi>_def by (simp add: add_pos_nonneg)
  thus "\<phi> \<ge> 0" "\<phi> \<noteq> 0" by simp_all
qed

lemma "ham_sandwich_cost \<in> \<Theta>(\<lambda>n. n powr (log 2 \<phi>))"
proof (master_theorem 1 p': 0)
  have "(1 / 4) powr log 2 \<phi> + (1 / 2) powr log 2 \<phi> =
            inverse (2 powr log 2 \<phi>)^2 + inverse (2 powr log 2 \<phi>)"
        by (simp add: powr_divide field_simps powr_powr power2_eq_square powr_mult[symmetric]
                 del: powr_log_cancel)
  also have "... = inverse (\<phi>^2) + inverse \<phi>" by (simp add: power2_eq_square)
  also have "\<phi> + 1 = \<phi>*\<phi>" by (simp add: \<phi>_def field_simps)
  hence "inverse (\<phi>^2) + inverse \<phi> = 1" by (simp add: field_simps power2_eq_square)
  finally show "(1 / 4) powr log 2 \<phi> + (1 / 2) powr log 2 \<phi> = 1" by simp
qed simp_all

end


theory Indexing
  imports Complex_Main
begin

section \<open>Indexing\<close>

subsection \<open>Sqrt Floor and Ceiling\<close>

definition lg :: "real \<Rightarrow> real" where
  "lg \<equiv> log 2"

definition sqrt_ceiling :: "nat \<Rightarrow> nat" ("sqrt\<up> _" [1000]) where
  "sqrt\<up> u = 2^(nat \<lceil>lg u / 2\<rceil>)"

definition sqrt_floor :: "nat \<Rightarrow> nat" ("sqrt\<down> _" [1000]) where
  "sqrt\<down> u = 2^(nat \<lfloor>lg u / 2\<rfloor>)"

lemma odd_ceiling_div2_add1:
  fixes k :: nat
  assumes "odd k"
  shows "nat \<lceil>k / 2\<rceil> = k div 2 + 1"
proof -
  have 0: "k / 2 = k div 2 + 1/2"
    using odd_two_times_div_two_succ[OF assms] by simp
  have "k / 2 \<noteq> of_int \<lfloor>k / 2\<rfloor>"
    by (simp add: 0)
  thus ?thesis
    unfolding ceiling_altdef by (auto, linarith)
qed

lemma sqrt_floor_div2:
  "sqrt\<down> (2^k) = 2^(k div 2)"
proof -
  have "(2::nat)^nat \<lfloor>log 2 (2 ^ k) / 2\<rfloor> = 2^nat \<lfloor>k / 2\<rfloor>"
    by simp
  also have "... = 2^(k div 2)"
    by (metis floor_divide_of_nat_eq nat_int of_nat_numeral)
  finally show ?thesis
    unfolding sqrt_floor_def lg_def by simp
qed

lemma sqrt_ceiling_div2:
  "even k \<Longrightarrow> sqrt\<up> (2^k) = 2^(k div 2)"
  unfolding sqrt_ceiling_def lg_def by auto

lemma sqrt_ceiling_div2_add1:
  "odd k \<Longrightarrow> sqrt\<up> (2^k) = 2^(k div 2 + 1)"
  unfolding sqrt_ceiling_def lg_def using odd_ceiling_div2_add1 by auto

lemma sqrt_ceiling_mul_floor:
  assumes "u = 2^k"
  shows "u = sqrt\<up> u * sqrt\<down> u"
proof -
  have 0: "sqrt\<up> u * sqrt\<down> u = 2^(nat \<lceil>k / 2\<rceil>) * 2^(nat \<lfloor>k / 2\<rfloor>)"
    using assms unfolding lg_def sqrt_ceiling_def sqrt_floor_def by simp
  show ?thesis
  proof (cases "even k")
    case True
    hence "(2::nat)^(nat \<lceil>k / 2\<rceil>) * 2^(nat \<lfloor>k / 2\<rfloor>) = 2^(k div 2 + k div 2)"
      by (auto simp: power_add)
    thus ?thesis
      using 0 True assms by auto
  next
    case False
    hence "(2::nat)^(nat \<lceil>k / 2\<rceil>) * 2^(nat \<lfloor>k / 2\<rfloor>) = 2^(k div 2 + 1) * 2^(k div 2)"
      using odd_ceiling_div2_add1 by (metis floor_divide_of_nat_eq nat_int of_nat_numeral)
    also have "... = 2^(k div 2 + 1 + k div 2)"
      by (auto simp: power_add)
    finally show ?thesis
      using 0 assms False by (metis False add.commute left_add_twice odd_two_times_div_two_succ)
  qed
qed

subsection "Index, High and Low"

definition high :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "high i u = i div (sqrt\<down> u)"

definition low :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "low i u = i mod (sqrt\<down> u)"

definition index :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
  "index i j u = i * sqrt\<down> u + j"

lemma index_high_low:
  "index (high i u) (low i u) u = i"
  unfolding index_def high_def low_def by simp

lemma index_eq_high_low:
  assumes "l < sqrt\<down> u" "i = index h l u"
  shows "h = high i u" "l = low i u"
  using assms unfolding index_def high_def low_def by auto

lemma index_low_mono:
  "j < k \<longleftrightarrow> index i j u < index i k u"
  unfolding index_def by simp

lemma index_high_mono:
  "i < k \<Longrightarrow> j < sqrt\<down> u \<Longrightarrow> index i j u < index k l u"
  unfolding index_def using mult_le_mono1[of "i+1" k "sqrt\<down> u"] discrete by simp

lemma high_mono:
  "i \<le> j \<Longrightarrow> high i u \<le> high j u"
  unfolding high_def using div_le_mono by blast

lemma high_lt_sqrt_ceiling:
  "i < sqrt\<down> u \<Longrightarrow> high i u < sqrt\<up> u"
  unfolding high_def sqrt_ceiling_def by simp

lemma high_lt_k:
  "i < k * sqrt\<down> u \<Longrightarrow> high i u < k"
  using less_mult_imp_div_less unfolding high_def by blast

lemma high_geq_index_h0:
  "index h 0 u \<le> i \<Longrightarrow> h \<le> high i u"
  unfolding index_def high_def sqrt_floor_def using nat_le_iff_add by auto

lemma low_lt_sqrt_floor:
  "low i u < sqrt\<down> u"
  unfolding low_def sqrt_floor_def by simp

lemma index_lt_u:
  assumes "u = 2^k" "i < sqrt\<up> u" "j < sqrt\<down> u"
  shows "index i j u < u"
proof -
  have 0: "sqrt\<down> u = 2^(k div 2)"
    by (simp add: assms(1) sqrt_floor_div2)
  show ?thesis
  proof (cases "even k")
    case True
    have "index i j u \<le> (sqrt\<up> u - 1) * sqrt\<down> u + j"
      using assms(2) index_def by auto
    also have "... \<le> (sqrt\<up> u - 1) * sqrt\<down> u + (sqrt\<down> u - 1)"
      using assms(3) by linarith
    also have "... = (2^(k div 2) - 1) * 2^(k div 2) + (2^(k div 2) - 1)"
      using 0 True assms(1) sqrt_ceiling_div2 by simp
    also have "... = 2^(k div 2 + k div 2) - 1"
      by (simp add: add.commute mult_eq_if power_add)
    also have "... = u - 1"
      using True assms(1) by (metis even_two_times_div_two mult_2)
    finally have "index i j u \<le> u - 1" .
    thus ?thesis
      using assms(1) by (simp add: Nat.le_diff_conv2)
  next
    case False
    have "index i j u \<le> (sqrt\<up> u - 1) * sqrt\<down> u + j"
      using assms(2) index_def by auto
    also have "... \<le> (sqrt\<up> u - 1) * sqrt\<down> u + (sqrt\<down> u - 1)"
      using assms(3) by linarith
    also have "... = (2^(k div 2 + 1) - 1) * 2^(k div 2) + (2^(k div 2) - 1)"
      using 0 False assms(1) sqrt_ceiling_div2_add1 by simp
    also have "... = 2^(k div 2 + 1) * 2^(k div 2) - 1"
      by (simp add: add.commute mult_eq_if)
    also have "... = u - 1"
      using False assms(1) 0 sqrt_ceiling_div2_add1 sqrt_ceiling_mul_floor by force
    finally have "index i j u \<le> u - 1" .
    thus ?thesis
      using assms(1) by (simp add: Nat.le_diff_conv2)
  qed
qed

end


(*  Title       : Series.thy
    Author      : Jacques D. Fleuriot
    Copyright   : 1998  University of Cambridge

Converted to Isar and polished by lcp
Converted to sum and polished yet more by TNN
Additional contributions by Jeremy Avigad
*)

section \<open>Infinite Series\<close>

theory Series
imports Limits Inequalities
begin

subsection \<open>Definition of infinite summability\<close>

definition sums :: "(nat \<Rightarrow> 'a::{topological_space, comm_monoid_add}) \<Rightarrow> 'a \<Rightarrow> bool"
    (infixr "sums" 80)
  where "f sums s \<longleftrightarrow> (\<lambda>n. \<Sum>i<n. f i) \<longlonglongrightarrow> s"

definition summable :: "(nat \<Rightarrow> 'a::{topological_space, comm_monoid_add}) \<Rightarrow> bool"
  where "summable f \<longleftrightarrow> (\<exists>s. f sums s)"

definition suminf :: "(nat \<Rightarrow> 'a::{topological_space, comm_monoid_add}) \<Rightarrow> 'a"
    (binder "\<Sum>" 10)
  where "suminf f = (THE s. f sums s)"

text\<open>Variants of the definition\<close>
lemma sums_def': "f sums s \<longleftrightarrow> (\<lambda>n. \<Sum>i = 0..n. f i) \<longlonglongrightarrow> s"
  apply (simp add: sums_def)
  apply (subst LIMSEQ_Suc_iff [symmetric])
  apply (simp only: lessThan_Suc_atMost atLeast0AtMost)
  done

lemma sums_def_le: "f sums s \<longleftrightarrow> (\<lambda>n. \<Sum>i\<le>n. f i) \<longlonglongrightarrow> s"
  by (simp add: sums_def' atMost_atLeast0)

subsection \<open>Infinite summability on topological monoids\<close>

lemma sums_subst[trans]: "f = g \<Longrightarrow> g sums z \<Longrightarrow> f sums z"
  by simp

lemma sums_cong: "(\<And>n. f n = g n) \<Longrightarrow> f sums c \<longleftrightarrow> g sums c"
  by (drule ext) simp

lemma sums_summable: "f sums l \<Longrightarrow> summable f"
  by (simp add: sums_def summable_def, blast)

lemma summable_iff_convergent: "summable f \<longleftrightarrow> convergent (\<lambda>n. \<Sum>i<n. f i)"
  by (simp add: summable_def sums_def convergent_def)

lemma summable_iff_convergent': "summable f \<longleftrightarrow> convergent (\<lambda>n. sum f {..n})"
  by (simp_all only: summable_iff_convergent convergent_def
        lessThan_Suc_atMost [symmetric] LIMSEQ_Suc_iff[of "\<lambda>n. sum f {..<n}"])

lemma suminf_eq_lim: "suminf f = lim (\<lambda>n. \<Sum>i<n. f i)"
  by (simp add: suminf_def sums_def lim_def)

lemma sums_zero[simp, intro]: "(\<lambda>n. 0) sums 0"
  unfolding sums_def by simp

lemma summable_zero[simp, intro]: "summable (\<lambda>n. 0)"
  by (rule sums_zero [THEN sums_summable])

lemma sums_group: "f sums s \<Longrightarrow> 0 < k \<Longrightarrow> (\<lambda>n. sum f {n * k ..< n * k + k}) sums s"
  apply (simp only: sums_def sum_nat_group tendsto_def eventually_sequentially)
  apply safe
  apply (erule_tac x=S in allE)
  apply safe
  apply (rule_tac x="N" in exI, safe)
  apply (drule_tac x="n*k" in spec)
  apply (erule mp)
  apply (erule order_trans)
  apply simp
  done

lemma suminf_cong: "(\<And>n. f n = g n) \<Longrightarrow> suminf f = suminf g"
  by (rule arg_cong[of f g], rule ext) simp

lemma summable_cong:
  fixes f g :: "nat \<Rightarrow> 'a::real_normed_vector"
  assumes "eventually (\<lambda>x. f x = g x) sequentially"
  shows "summable f = summable g"
proof -
  from assms obtain N where N: "\<forall>n\<ge>N. f n = g n"
    by (auto simp: eventually_at_top_linorder)
  define C where "C = (\<Sum>k<N. f k - g k)"
  from eventually_ge_at_top[of N]
  have "eventually (\<lambda>n. sum f {..<n} = C + sum g {..<n}) sequentially"
  proof eventually_elim
    case (elim n)
    then have "{..<n} = {..<N} \<union> {N..<n}"
      by auto
    also have "sum f ... = sum f {..<N} + sum f {N..<n}"
      by (intro sum.union_disjoint) auto
    also from N have "sum f {N..<n} = sum g {N..<n}"
      by (intro sum.cong) simp_all
    also have "sum f {..<N} + sum g {N..<n} = C + (sum g {..<N} + sum g {N..<n})"
      unfolding C_def by (simp add: algebra_simps sum_subtractf)
    also have "sum g {..<N} + sum g {N..<n} = sum g ({..<N} \<union> {N..<n})"
      by (intro sum.union_disjoint [symmetric]) auto
    also from elim have "{..<N} \<union> {N..<n} = {..<n}"
      by auto
    finally show "sum f {..<n} = C + sum g {..<n}" .
  qed
  from convergent_cong[OF this] show ?thesis
    by (simp add: summable_iff_convergent convergent_add_const_iff)
qed

lemma sums_finite:
  assumes [simp]: "finite N"
    and f: "\<And>n. n \<notin> N \<Longrightarrow> f n = 0"
  shows "f sums (\<Sum>n\<in>N. f n)"
proof -
  have eq: "sum f {..<n + Suc (Max N)} = sum f N" for n
  proof (cases "N = {}")
    case True
    with f have "f = (\<lambda>x. 0)" by auto
    then show ?thesis by simp
  next
    case [simp]: False
    show ?thesis
    proof (safe intro!: sum.mono_neutral_right f)
      fix i
      assume "i \<in> N"
      then have "i \<le> Max N" by simp
      then show "i < n + Suc (Max N)" by simp
    qed
  qed
  show ?thesis
    unfolding sums_def
    by (rule LIMSEQ_offset[of _ "Suc (Max N)"])
       (simp add: eq atLeast0LessThan del: add_Suc_right)
qed

corollary sums_0: "(\<And>n. f n = 0) \<Longrightarrow> (f sums 0)"
    by (metis (no_types) finite.emptyI sum.empty sums_finite)

lemma summable_finite: "finite N \<Longrightarrow> (\<And>n. n \<notin> N \<Longrightarrow> f n = 0) \<Longrightarrow> summable f"
  by (rule sums_summable) (rule sums_finite)

lemma sums_If_finite_set: "finite A \<Longrightarrow> (\<lambda>r. if r \<in> A then f r else 0) sums (\<Sum>r\<in>A. f r)"
  using sums_finite[of A "(\<lambda>r. if r \<in> A then f r else 0)"] by simp

lemma summable_If_finite_set[simp, intro]: "finite A \<Longrightarrow> summable (\<lambda>r. if r \<in> A then f r else 0)"
  by (rule sums_summable) (rule sums_If_finite_set)

lemma sums_If_finite: "finite {r. P r} \<Longrightarrow> (\<lambda>r. if P r then f r else 0) sums (\<Sum>r | P r. f r)"
  using sums_If_finite_set[of "{r. P r}"] by simp

lemma summable_If_finite[simp, intro]: "finite {r. P r} \<Longrightarrow> summable (\<lambda>r. if P r then f r else 0)"
  by (rule sums_summable) (rule sums_If_finite)

lemma sums_single: "(\<lambda>r. if r = i then f r else 0) sums f i"
  using sums_If_finite[of "\<lambda>r. r = i"] by simp

lemma summable_single[simp, intro]: "summable (\<lambda>r. if r = i then f r else 0)"
  by (rule sums_summable) (rule sums_single)

context
  fixes f :: "nat \<Rightarrow> 'a::{t2_space,comm_monoid_add}"
begin

lemma summable_sums[intro]: "summable f \<Longrightarrow> f sums (suminf f)"
  by (simp add: summable_def sums_def suminf_def)
     (metis convergent_LIMSEQ_iff convergent_def lim_def)

lemma summable_LIMSEQ: "summable f \<Longrightarrow> (\<lambda>n. \<Sum>i<n. f i) \<longlonglongrightarrow> suminf f"
  by (rule summable_sums [unfolded sums_def])

lemma sums_unique: "f sums s \<Longrightarrow> s = suminf f"
  by (metis limI suminf_eq_lim sums_def)

lemma sums_iff: "f sums x \<longleftrightarrow> summable f \<and> suminf f = x"
  by (metis summable_sums sums_summable sums_unique)

lemma summable_sums_iff: "summable f \<longleftrightarrow> f sums suminf f"
  by (auto simp: sums_iff summable_sums)

lemma sums_unique2: "f sums a \<Longrightarrow> f sums b \<Longrightarrow> a = b"
  for a b :: 'a
  by (simp add: sums_iff)

lemma suminf_finite:
  assumes N: "finite N"
    and f: "\<And>n. n \<notin> N \<Longrightarrow> f n = 0"
  shows "suminf f = (\<Sum>n\<in>N. f n)"
  using sums_finite[OF assms, THEN sums_unique] by simp

end

lemma suminf_zero[simp]: "suminf (\<lambda>n. 0::'a::{t2_space, comm_monoid_add}) = 0"
  by (rule sums_zero [THEN sums_unique, symmetric])

subsection \<open>Infinite summability on ordered, topological monoids\<close>

lemma sums_le: "\<forall>n. f n \<le> g n \<Longrightarrow> f sums s \<Longrightarrow> g sums t \<Longrightarrow> s \<le> t"
  for f g :: "nat \<Rightarrow> 'a::{ordered_comm_monoid_add,linorder_topology}"
  by (rule LIMSEQ_le) (auto intro: sum_mono simp: sums_def)

context
  fixes f :: "nat \<Rightarrow> 'a::{ordered_comm_monoid_add,linorder_topology}"
begin

lemma suminf_le: "\<forall>n. f n \<le> g n \<Longrightarrow> summable f \<Longrightarrow> summable g \<Longrightarrow> suminf f \<le> suminf g"
  by (auto dest: sums_summable intro: sums_le)

lemma sum_le_suminf: "summable f \<Longrightarrow> \<forall>m\<ge>n. 0 \<le> f m \<Longrightarrow> sum f {..<n} \<le> suminf f"
  by (rule sums_le[OF _ sums_If_finite_set summable_sums]) auto

lemma suminf_nonneg: "summable f \<Longrightarrow> \<forall>n. 0 \<le> f n \<Longrightarrow> 0 \<le> suminf f"
  using sum_le_suminf[of 0] by simp

lemma suminf_le_const: "summable f \<Longrightarrow> (\<And>n. sum f {..<n} \<le> x) \<Longrightarrow> suminf f \<le> x"
  by (metis LIMSEQ_le_const2 summable_LIMSEQ)

lemma suminf_eq_zero_iff: "summable f \<Longrightarrow> \<forall>n. 0 \<le> f n \<Longrightarrow> suminf f = 0 \<longleftrightarrow> (\<forall>n. f n = 0)"
proof
  assume "summable f" "suminf f = 0" and pos: "\<forall>n. 0 \<le> f n"
  then have f: "(\<lambda>n. \<Sum>i<n. f i) \<longlonglongrightarrow> 0"
    using summable_LIMSEQ[of f] by simp
  then have "\<And>i. (\<Sum>n\<in>{i}. f n) \<le> 0"
  proof (rule LIMSEQ_le_const)
    show "\<exists>N. \<forall>n\<ge>N. (\<Sum>n\<in>{i}. f n) \<le> sum f {..<n}" for i
      using pos by (intro exI[of _ "Suc i"] allI impI sum_mono2) auto
  qed
  with pos show "\<forall>n. f n = 0"
    by (auto intro!: antisym)
qed (metis suminf_zero fun_eq_iff)

lemma suminf_pos_iff: "summable f \<Longrightarrow> \<forall>n. 0 \<le> f n \<Longrightarrow> 0 < suminf f \<longleftrightarrow> (\<exists>i. 0 < f i)"
  using sum_le_suminf[of 0] suminf_eq_zero_iff by (simp add: less_le)

lemma suminf_pos2:
  assumes "summable f" "\<forall>n. 0 \<le> f n" "0 < f i"
  shows "0 < suminf f"
proof -
  have "0 < (\<Sum>n<Suc i. f n)"
    using assms by (intro sum_pos2[where i=i]) auto
  also have "\<dots> \<le> suminf f"
    using assms by (intro sum_le_suminf) auto
  finally show ?thesis .
qed

lemma suminf_pos: "summable f \<Longrightarrow> \<forall>n. 0 < f n \<Longrightarrow> 0 < suminf f"
  by (intro suminf_pos2[where i=0]) (auto intro: less_imp_le)

end

context
  fixes f :: "nat \<Rightarrow> 'a::{ordered_cancel_comm_monoid_add,linorder_topology}"
begin

lemma sum_less_suminf2:
  "summable f \<Longrightarrow> \<forall>m\<ge>n. 0 \<le> f m \<Longrightarrow> n \<le> i \<Longrightarrow> 0 < f i \<Longrightarrow> sum f {..<n} < suminf f"
  using sum_le_suminf[of f "Suc i"]
    and add_strict_increasing[of "f i" "sum f {..<n}" "sum f {..<i}"]
    and sum_mono2[of "{..<i}" "{..<n}" f]
  by (auto simp: less_imp_le ac_simps)

lemma sum_less_suminf: "summable f \<Longrightarrow> \<forall>m\<ge>n. 0 < f m \<Longrightarrow> sum f {..<n} < suminf f"
  using sum_less_suminf2[of n n] by (simp add: less_imp_le)

end

lemma summableI_nonneg_bounded:
  fixes f :: "nat \<Rightarrow> 'a::{ordered_comm_monoid_add,linorder_topology,conditionally_complete_linorder}"
  assumes pos[simp]: "\<And>n. 0 \<le> f n"
    and le: "\<And>n. (\<Sum>i<n. f i) \<le> x"
  shows "summable f"
  unfolding summable_def sums_def [abs_def]
proof (rule exI LIMSEQ_incseq_SUP)+
  show "bdd_above (range (\<lambda>n. sum f {..<n}))"
    using le by (auto simp: bdd_above_def)
  show "incseq (\<lambda>n. sum f {..<n})"
    by (auto simp: mono_def intro!: sum_mono2)
qed

lemma summableI[intro, simp]: "summable f"
  for f :: "nat \<Rightarrow> 'a::{canonically_ordered_monoid_add,linorder_topology,complete_linorder}"
  by (intro summableI_nonneg_bounded[where x=top] zero_le top_greatest)

subsection \<open>Infinite summability on topological monoids\<close>

context
  fixes f g :: "nat \<Rightarrow> 'a::{t2_space,topological_comm_monoid_add}"
begin

lemma sums_Suc:
  assumes "(\<lambda>n. f (Suc n)) sums l"
  shows "f sums (l + f 0)"
proof  -
  have "(\<lambda>n. (\<Sum>i<n. f (Suc i)) + f 0) \<longlonglongrightarrow> l + f 0"
    using assms by (auto intro!: tendsto_add simp: sums_def)
  moreover have "(\<Sum>i<n. f (Suc i)) + f 0 = (\<Sum>i<Suc n. f i)" for n
    unfolding lessThan_Suc_eq_insert_0
    by (simp add: ac_simps sum_atLeast1_atMost_eq image_Suc_lessThan)
  ultimately show ?thesis
    by (auto simp: sums_def simp del: sum_lessThan_Suc intro: LIMSEQ_Suc_iff[THEN iffD1])
qed

lemma sums_add: "f sums a \<Longrightarrow> g sums b \<Longrightarrow> (\<lambda>n. f n + g n) sums (a + b)"
  unfolding sums_def by (simp add: sum.distrib tendsto_add)

lemma summable_add: "summable f \<Longrightarrow> summable g \<Longrightarrow> summable (\<lambda>n. f n + g n)"
  unfolding summable_def by (auto intro: sums_add)

lemma suminf_add: "summable f \<Longrightarrow> summable g \<Longrightarrow> suminf f + suminf g = (\<Sum>n. f n + g n)"
  by (intro sums_unique sums_add summable_sums)

end

context
  fixes f :: "'i \<Rightarrow> nat \<Rightarrow> 'a::{t2_space,topological_comm_monoid_add}"
    and I :: "'i set"
begin

lemma sums_sum: "(\<And>i. i \<in> I \<Longrightarrow> (f i) sums (x i)) \<Longrightarrow> (\<lambda>n. \<Sum>i\<in>I. f i n) sums (\<Sum>i\<in>I. x i)"
  by (induct I rule: infinite_finite_induct) (auto intro!: sums_add)

lemma suminf_sum: "(\<And>i. i \<in> I \<Longrightarrow> summable (f i)) \<Longrightarrow> (\<Sum>n. \<Sum>i\<in>I. f i n) = (\<Sum>i\<in>I. \<Sum>n. f i n)"
  using sums_unique[OF sums_sum, OF summable_sums] by simp

lemma summable_sum: "(\<And>i. i \<in> I \<Longrightarrow> summable (f i)) \<Longrightarrow> summable (\<lambda>n. \<Sum>i\<in>I. f i n)"
  using sums_summable[OF sums_sum[OF summable_sums]] .

end

subsection \<open>Infinite summability on real normed vector spaces\<close>

context
  fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
begin

lemma sums_Suc_iff: "(\<lambda>n. f (Suc n)) sums s \<longleftrightarrow> f sums (s + f 0)"
proof -
  have "f sums (s + f 0) \<longleftrightarrow> (\<lambda>i. \<Sum>j<Suc i. f j) \<longlonglongrightarrow> s + f 0"
    by (subst LIMSEQ_Suc_iff) (simp add: sums_def)
  also have "\<dots> \<longleftrightarrow> (\<lambda>i. (\<Sum>j<i. f (Suc j)) + f 0) \<longlonglongrightarrow> s + f 0"
    by (simp add: ac_simps lessThan_Suc_eq_insert_0 image_Suc_lessThan sum_atLeast1_atMost_eq)
  also have "\<dots> \<longleftrightarrow> (\<lambda>n. f (Suc n)) sums s"
  proof
    assume "(\<lambda>i. (\<Sum>j<i. f (Suc j)) + f 0) \<longlonglongrightarrow> s + f 0"
    with tendsto_add[OF this tendsto_const, of "- f 0"] show "(\<lambda>i. f (Suc i)) sums s"
      by (simp add: sums_def)
  qed (auto intro: tendsto_add simp: sums_def)
  finally show ?thesis ..
qed

lemma summable_Suc_iff: "summable (\<lambda>n. f (Suc n)) = summable f"
proof
  assume "summable f"
  then have "f sums suminf f"
    by (rule summable_sums)
  then have "(\<lambda>n. f (Suc n)) sums (suminf f - f 0)"
    by (simp add: sums_Suc_iff)
  then show "summable (\<lambda>n. f (Suc n))"
    unfolding summable_def by blast
qed (auto simp: sums_Suc_iff summable_def)

lemma sums_Suc_imp: "f 0 = 0 \<Longrightarrow> (\<lambda>n. f (Suc n)) sums s \<Longrightarrow> (\<lambda>n. f n) sums s"
  using sums_Suc_iff by simp

end

context (* Separate contexts are necessary to allow general use of the results above, here. *)
  fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
begin

lemma sums_diff: "f sums a \<Longrightarrow> g sums b \<Longrightarrow> (\<lambda>n. f n - g n) sums (a - b)"
  unfolding sums_def by (simp add: sum_subtractf tendsto_diff)

lemma summable_diff: "summable f \<Longrightarrow> summable g \<Longrightarrow> summable (\<lambda>n. f n - g n)"
  unfolding summable_def by (auto intro: sums_diff)

lemma suminf_diff: "summable f \<Longrightarrow> summable g \<Longrightarrow> suminf f - suminf g = (\<Sum>n. f n - g n)"
  by (intro sums_unique sums_diff summable_sums)

lemma sums_minus: "f sums a \<Longrightarrow> (\<lambda>n. - f n) sums (- a)"
  unfolding sums_def by (simp add: sum_negf tendsto_minus)

lemma summable_minus: "summable f \<Longrightarrow> summable (\<lambda>n. - f n)"
  unfolding summable_def by (auto intro: sums_minus)

lemma suminf_minus: "summable f \<Longrightarrow> (\<Sum>n. - f n) = - (\<Sum>n. f n)"
  by (intro sums_unique [symmetric] sums_minus summable_sums)

lemma sums_iff_shift: "(\<lambda>i. f (i + n)) sums s \<longleftrightarrow> f sums (s + (\<Sum>i<n. f i))"
proof (induct n arbitrary: s)
  case 0
  then show ?case by simp
next
  case (Suc n)
  then have "(\<lambda>i. f (Suc i + n)) sums s \<longleftrightarrow> (\<lambda>i. f (i + n)) sums (s + f n)"
    by (subst sums_Suc_iff) simp
  with Suc show ?case
    by (simp add: ac_simps)
qed

corollary sums_iff_shift': "(\<lambda>i. f (i + n)) sums (s - (\<Sum>i<n. f i)) \<longleftrightarrow> f sums s"
  by (simp add: sums_iff_shift)

lemma sums_zero_iff_shift:
  assumes "\<And>i. i < n \<Longrightarrow> f i = 0"
  shows "(\<lambda>i. f (i+n)) sums s \<longleftrightarrow> (\<lambda>i. f i) sums s"
  by (simp add: assms sums_iff_shift)

lemma summable_iff_shift: "summable (\<lambda>n. f (n + k)) \<longleftrightarrow> summable f"
  by (metis diff_add_cancel summable_def sums_iff_shift [abs_def])

lemma sums_split_initial_segment: "f sums s \<Longrightarrow> (\<lambda>i. f (i + n)) sums (s - (\<Sum>i<n. f i))"
  by (simp add: sums_iff_shift)

lemma summable_ignore_initial_segment: "summable f \<Longrightarrow> summable (\<lambda>n. f(n + k))"
  by (simp add: summable_iff_shift)

lemma suminf_minus_initial_segment: "summable f \<Longrightarrow> (\<Sum>n. f (n + k)) = (\<Sum>n. f n) - (\<Sum>i<k. f i)"
  by (rule sums_unique[symmetric]) (auto simp: sums_iff_shift)

lemma suminf_split_initial_segment: "summable f \<Longrightarrow> suminf f = (\<Sum>n. f(n + k)) + (\<Sum>i<k. f i)"
  by (auto simp add: suminf_minus_initial_segment)

lemma suminf_split_head: "summable f \<Longrightarrow> (\<Sum>n. f (Suc n)) = suminf f - f 0"
  using suminf_split_initial_segment[of 1] by simp

lemma suminf_exist_split:
  fixes r :: real
  assumes "0 < r" and "summable f"
  shows "\<exists>N. \<forall>n\<ge>N. norm (\<Sum>i. f (i + n)) < r"
proof -
  from LIMSEQ_D[OF summable_LIMSEQ[OF \<open>summable f\<close>] \<open>0 < r\<close>]
  obtain N :: nat where "\<forall> n \<ge> N. norm (sum f {..<n} - suminf f) < r"
    by auto
  then show ?thesis
    by (auto simp: norm_minus_commute suminf_minus_initial_segment[OF \<open>summable f\<close>])
qed

lemma summable_LIMSEQ_zero: "summable f \<Longrightarrow> f \<longlonglongrightarrow> 0"
  apply (drule summable_iff_convergent [THEN iffD1])
  apply (drule convergent_Cauchy)
  apply (simp only: Cauchy_iff LIMSEQ_iff)
  apply safe
  apply (drule_tac x="r" in spec)
  apply safe
  apply (rule_tac x="M" in exI)
  apply safe
  apply (drule_tac x="Suc n" in spec)
  apply simp
  apply (drule_tac x="n" in spec)
  apply simp
  done

lemma summable_imp_convergent: "summable f \<Longrightarrow> convergent f"
  by (force dest!: summable_LIMSEQ_zero simp: convergent_def)

lemma summable_imp_Bseq: "summable f \<Longrightarrow> Bseq f"
  by (simp add: convergent_imp_Bseq summable_imp_convergent)

end

lemma summable_minus_iff: "summable (\<lambda>n. - f n) \<longleftrightarrow> summable f"
  for f :: "nat \<Rightarrow> 'a::real_normed_vector"
  by (auto dest: summable_minus)  (* used two ways, hence must be outside the context above *)

lemma (in bounded_linear) sums: "(\<lambda>n. X n) sums a \<Longrightarrow> (\<lambda>n. f (X n)) sums (f a)"
  unfolding sums_def by (drule tendsto) (simp only: sum)

lemma (in bounded_linear) summable: "summable (\<lambda>n. X n) \<Longrightarrow> summable (\<lambda>n. f (X n))"
  unfolding summable_def by (auto intro: sums)

lemma (in bounded_linear) suminf: "summable (\<lambda>n. X n) \<Longrightarrow> f (\<Sum>n. X n) = (\<Sum>n. f (X n))"
  by (intro sums_unique sums summable_sums)

lemmas sums_of_real = bounded_linear.sums [OF bounded_linear_of_real]
lemmas summable_of_real = bounded_linear.summable [OF bounded_linear_of_real]
lemmas suminf_of_real = bounded_linear.suminf [OF bounded_linear_of_real]

lemmas sums_scaleR_left = bounded_linear.sums[OF bounded_linear_scaleR_left]
lemmas summable_scaleR_left = bounded_linear.summable[OF bounded_linear_scaleR_left]
lemmas suminf_scaleR_left = bounded_linear.suminf[OF bounded_linear_scaleR_left]

lemmas sums_scaleR_right = bounded_linear.sums[OF bounded_linear_scaleR_right]
lemmas summable_scaleR_right = bounded_linear.summable[OF bounded_linear_scaleR_right]
lemmas suminf_scaleR_right = bounded_linear.suminf[OF bounded_linear_scaleR_right]

lemma summable_const_iff: "summable (\<lambda>_. c) \<longleftrightarrow> c = 0"
  for c :: "'a::real_normed_vector"
proof -
  have "\<not> summable (\<lambda>_. c)" if "c \<noteq> 0"
  proof -
    from that have "filterlim (\<lambda>n. of_nat n * norm c) at_top sequentially"
      by (subst mult.commute)
        (auto intro!: filterlim_tendsto_pos_mult_at_top filterlim_real_sequentially)
    then have "\<not> convergent (\<lambda>n. norm (\<Sum>k<n. c))"
      by (intro filterlim_at_infinity_imp_not_convergent filterlim_at_top_imp_at_infinity)
        (simp_all add: sum_constant_scaleR)
    then show ?thesis
      unfolding summable_iff_convergent using convergent_norm by blast
  qed
  then show ?thesis by auto
qed

subsection \<open>Infinite summability on real normed algebras\<close>

context
  fixes f :: "nat \<Rightarrow> 'a::real_normed_algebra"
begin

lemma sums_mult: "f sums a \<Longrightarrow> (\<lambda>n. c * f n) sums (c * a)"
  by (rule bounded_linear.sums [OF bounded_linear_mult_right])

lemma summable_mult: "summable f \<Longrightarrow> summable (\<lambda>n. c * f n)"
  by (rule bounded_linear.summable [OF bounded_linear_mult_right])

lemma suminf_mult: "summable f \<Longrightarrow> suminf (\<lambda>n. c * f n) = c * suminf f"
  by (rule bounded_linear.suminf [OF bounded_linear_mult_right, symmetric])

lemma sums_mult2: "f sums a \<Longrightarrow> (\<lambda>n. f n * c) sums (a * c)"
  by (rule bounded_linear.sums [OF bounded_linear_mult_left])

lemma summable_mult2: "summable f \<Longrightarrow> summable (\<lambda>n. f n * c)"
  by (rule bounded_linear.summable [OF bounded_linear_mult_left])

lemma suminf_mult2: "summable f \<Longrightarrow> suminf f * c = (\<Sum>n. f n * c)"
  by (rule bounded_linear.suminf [OF bounded_linear_mult_left])

end

lemma sums_mult_iff:
  fixes f :: "nat \<Rightarrow> 'a::{real_normed_algebra,field}"
  assumes "c \<noteq> 0"
  shows "(\<lambda>n. c * f n) sums (c * d) \<longleftrightarrow> f sums d"
  using sums_mult[of f d c] sums_mult[of "\<lambda>n. c * f n" "c * d" "inverse c"]
  by (force simp: field_simps assms)

lemma sums_mult2_iff:
  fixes f :: "nat \<Rightarrow> 'a::{real_normed_algebra,field}"
  assumes "c \<noteq> 0"
  shows   "(\<lambda>n. f n * c) sums (d * c) \<longleftrightarrow> f sums d"
  using sums_mult_iff[OF assms, of f d] by (simp add: mult.commute)

lemma sums_of_real_iff:
  "(\<lambda>n. of_real (f n) :: 'a::real_normed_div_algebra) sums of_real c \<longleftrightarrow> f sums c"
  by (simp add: sums_def of_real_sum[symmetric] tendsto_of_real_iff del: of_real_sum)

subsection \<open>Infinite summability on real normed fields\<close>

context
  fixes c :: "'a::real_normed_field"
begin

lemma sums_divide: "f sums a \<Longrightarrow> (\<lambda>n. f n / c) sums (a / c)"
  by (rule bounded_linear.sums [OF bounded_linear_divide])

lemma summable_divide: "summable f \<Longrightarrow> summable (\<lambda>n. f n / c)"
  by (rule bounded_linear.summable [OF bounded_linear_divide])

lemma suminf_divide: "summable f \<Longrightarrow> suminf (\<lambda>n. f n / c) = suminf f / c"
  by (rule bounded_linear.suminf [OF bounded_linear_divide, symmetric])

lemma sums_mult_D: "(\<lambda>n. c * f n) sums a \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> f sums (a/c)"
  using sums_mult_iff by fastforce

lemma summable_mult_D: "summable (\<lambda>n. c * f n) \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> summable f"
  by (auto dest: summable_divide)

text \<open>Sum of a geometric progression.\<close>

lemma geometric_sums:
  assumes less_1: "norm c < 1"
  shows "(\<lambda>n. c^n) sums (1 / (1 - c))"
proof -
  from less_1 have neq_1: "c \<noteq> 1" by auto
  then have neq_0: "c - 1 \<noteq> 0" by simp
  from less_1 have lim_0: "(\<lambda>n. c^n) \<longlonglongrightarrow> 0"
    by (rule LIMSEQ_power_zero)
  then have "(\<lambda>n. c ^ n / (c - 1) - 1 / (c - 1)) \<longlonglongrightarrow> 0 / (c - 1) - 1 / (c - 1)"
    using neq_0 by (intro tendsto_intros)
  then have "(\<lambda>n. (c ^ n - 1) / (c - 1)) \<longlonglongrightarrow> 1 / (1 - c)"
    by (simp add: nonzero_minus_divide_right [OF neq_0] diff_divide_distrib)
  then show "(\<lambda>n. c ^ n) sums (1 / (1 - c))"
    by (simp add: sums_def geometric_sum neq_1)
qed

lemma summable_geometric: "norm c < 1 \<Longrightarrow> summable (\<lambda>n. c^n)"
  by (rule geometric_sums [THEN sums_summable])

lemma suminf_geometric: "norm c < 1 \<Longrightarrow> suminf (\<lambda>n. c^n) = 1 / (1 - c)"
  by (rule sums_unique[symmetric]) (rule geometric_sums)

lemma summable_geometric_iff: "summable (\<lambda>n. c ^ n) \<longleftrightarrow> norm c < 1"
proof
  assume "summable (\<lambda>n. c ^ n :: 'a :: real_normed_field)"
  then have "(\<lambda>n. norm c ^ n) \<longlonglongrightarrow> 0"
    by (simp add: norm_power [symmetric] tendsto_norm_zero_iff summable_LIMSEQ_zero)
  from order_tendstoD(2)[OF this zero_less_one] obtain n where "norm c ^ n < 1"
    by (auto simp: eventually_at_top_linorder)
  then show "norm c < 1" using one_le_power[of "norm c" n]
    by (cases "norm c \<ge> 1") (linarith, simp)
qed (rule summable_geometric)

end

lemma power_half_series: "(\<lambda>n. (1/2::real)^Suc n) sums 1"
proof -
  have 2: "(\<lambda>n. (1/2::real)^n) sums 2"
    using geometric_sums [of "1/2::real"] by auto
  have "(\<lambda>n. (1/2::real)^Suc n) = (\<lambda>n. (1 / 2) ^ n / 2)"
    by (simp add: mult.commute)
  then show ?thesis
    using sums_divide [OF 2, of 2] by simp
qed

subsection \<open>Telescoping\<close>

lemma telescope_sums:
  fixes c :: "'a::real_normed_vector"
  assumes "f \<longlonglongrightarrow> c"
  shows "(\<lambda>n. f (Suc n) - f n) sums (c - f 0)"
  unfolding sums_def
proof (subst LIMSEQ_Suc_iff [symmetric])
  have "(\<lambda>n. \<Sum>k<Suc n. f (Suc k) - f k) = (\<lambda>n. f (Suc n) - f 0)"
    by (simp add: lessThan_Suc_atMost atLeast0AtMost [symmetric] sum_Suc_diff)
  also have "\<dots> \<longlonglongrightarrow> c - f 0"
    by (intro tendsto_diff LIMSEQ_Suc[OF assms] tendsto_const)
  finally show "(\<lambda>n. \<Sum>n<Suc n. f (Suc n) - f n) \<longlonglongrightarrow> c - f 0" .
qed

lemma telescope_sums':
  fixes c :: "'a::real_normed_vector"
  assumes "f \<longlonglongrightarrow> c"
  shows "(\<lambda>n. f n - f (Suc n)) sums (f 0 - c)"
  using sums_minus[OF telescope_sums[OF assms]] by (simp add: algebra_simps)

lemma telescope_summable:
  fixes c :: "'a::real_normed_vector"
  assumes "f \<longlonglongrightarrow> c"
  shows "summable (\<lambda>n. f (Suc n) - f n)"
  using telescope_sums[OF assms] by (simp add: sums_iff)

lemma telescope_summable':
  fixes c :: "'a::real_normed_vector"
  assumes "f \<longlonglongrightarrow> c"
  shows "summable (\<lambda>n. f n - f (Suc n))"
  using summable_minus[OF telescope_summable[OF assms]] by (simp add: algebra_simps)

subsection \<open>Infinite summability on Banach spaces\<close>

text \<open>Cauchy-type criterion for convergence of series (c.f. Harrison).\<close>

lemma summable_Cauchy: "summable f \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m\<ge>N. \<forall>n. norm (sum f {m..<n}) < e)"
  for f :: "nat \<Rightarrow> 'a::banach"
  apply (simp only: summable_iff_convergent Cauchy_convergent_iff [symmetric] Cauchy_iff)
  apply safe
   apply (drule spec)
   apply (drule (1) mp)
   apply (erule exE)
   apply (rule_tac x="M" in exI)
   apply clarify
   apply (rule_tac x="m" and y="n" in linorder_le_cases)
    apply (frule (1) order_trans)
    apply (drule_tac x="n" in spec)
    apply (drule (1) mp)
    apply (drule_tac x="m" in spec)
    apply (drule (1) mp)
    apply (simp_all add: sum_diff [symmetric])
  apply (drule spec)
  apply (drule (1) mp)
  apply (erule exE)
  apply (rule_tac x="N" in exI)
  apply clarify
  apply (rule_tac x="m" and y="n" in linorder_le_cases)
   apply (subst norm_minus_commute)
   apply (simp_all add: sum_diff [symmetric])
  done

context
  fixes f :: "nat \<Rightarrow> 'a::banach"
begin

text \<open>Absolute convergence imples normal convergence.\<close>

lemma summable_norm_cancel: "summable (\<lambda>n. norm (f n)) \<Longrightarrow> summable f"
  apply (simp only: summable_Cauchy)
  apply safe
  apply (drule_tac x="e" in spec)
  apply safe
  apply (rule_tac x="N" in exI)
  apply safe
  apply (drule_tac x="m" in spec)
  apply safe
  apply (rule order_le_less_trans [OF norm_sum])
  apply (rule order_le_less_trans [OF abs_ge_self])
  apply simp
  done

lemma summable_norm: "summable (\<lambda>n. norm (f n)) \<Longrightarrow> norm (suminf f) \<le> (\<Sum>n. norm (f n))"
  by (auto intro: LIMSEQ_le tendsto_norm summable_norm_cancel summable_LIMSEQ norm_sum)

text \<open>Comparison tests.\<close>

lemma summable_comparison_test: "\<exists>N. \<forall>n\<ge>N. norm (f n) \<le> g n \<Longrightarrow> summable g \<Longrightarrow> summable f"
  apply (simp add: summable_Cauchy)
  apply safe
  apply (drule_tac x="e" in spec)
  apply safe
  apply (rule_tac x = "N + Na" in exI)
  apply safe
  apply (rotate_tac 2)
  apply (drule_tac x = m in spec)
  apply auto
  apply (rotate_tac 2)
  apply (drule_tac x = n in spec)
  apply (rule_tac y = "\<Sum>k=m..<n. norm (f k)" in order_le_less_trans)
   apply (rule norm_sum)
  apply (rule_tac y = "sum g {m..<n}" in order_le_less_trans)
   apply (auto intro: sum_mono simp add: abs_less_iff)
  done

lemma summable_comparison_test_ev:
  "eventually (\<lambda>n. norm (f n) \<le> g n) sequentially \<Longrightarrow> summable g \<Longrightarrow> summable f"
  by (rule summable_comparison_test) (auto simp: eventually_at_top_linorder)

text \<open>A better argument order.\<close>
lemma summable_comparison_test': "summable g \<Longrightarrow> (\<And>n. n \<ge> N \<Longrightarrow> norm (f n) \<le> g n) \<Longrightarrow> summable f"
  by (rule summable_comparison_test) auto

subsection \<open>The Ratio Test\<close>

lemma summable_ratio_test:
  assumes "c < 1" "\<And>n. n \<ge> N \<Longrightarrow> norm (f (Suc n)) \<le> c * norm (f n)"
  shows "summable f"
proof (cases "0 < c")
  case True
  show "summable f"
  proof (rule summable_comparison_test)
    show "\<exists>N'. \<forall>n\<ge>N'. norm (f n) \<le> (norm (f N) / (c ^ N)) * c ^ n"
    proof (intro exI allI impI)
      fix n
      assume "N \<le> n"
      then show "norm (f n) \<le> (norm (f N) / (c ^ N)) * c ^ n"
      proof (induct rule: inc_induct)
        case base
        with True show ?case by simp
      next
        case (step m)
        have "norm (f (Suc m)) / c ^ Suc m * c ^ n \<le> norm (f m) / c ^ m * c ^ n"
          using \<open>0 < c\<close> \<open>c < 1\<close> assms(2)[OF \<open>N \<le> m\<close>] by (simp add: field_simps)
        with step show ?case by simp
      qed
    qed
    show "summable (\<lambda>n. norm (f N) / c ^ N * c ^ n)"
      using \<open>0 < c\<close> \<open>c < 1\<close> by (intro summable_mult summable_geometric) simp
  qed
next
  case False
  have "f (Suc n) = 0" if "n \<ge> N" for n
  proof -
    from that have "norm (f (Suc n)) \<le> c * norm (f n)"
      by (rule assms(2))
    also have "\<dots> \<le> 0"
      using False by (simp add: not_less mult_nonpos_nonneg)
    finally show ?thesis
      by auto
  qed
  then show "summable f"
    by (intro sums_summable[OF sums_finite, of "{.. Suc N}"]) (auto simp: not_le Suc_less_eq2)
qed

end

text \<open>Relations among convergence and absolute convergence for power series.\<close>

lemma Abel_lemma:
  fixes a :: "nat \<Rightarrow> 'a::real_normed_vector"
  assumes r: "0 \<le> r"
    and r0: "r < r0"
    and M: "\<And>n. norm (a n) * r0^n \<le> M"
  shows "summable (\<lambda>n. norm (a n) * r^n)"
proof (rule summable_comparison_test')
  show "summable (\<lambda>n. M * (r / r0) ^ n)"
    using assms
    by (auto simp add: summable_mult summable_geometric)
  show "norm (norm (a n) * r ^ n) \<le> M * (r / r0) ^ n" for n
    using r r0 M [of n]
    apply (auto simp add: abs_mult field_simps)
    apply (cases "r = 0")
     apply simp
     apply (cases n)
      apply auto
    done
qed

text \<open>Summability of geometric series for real algebras.\<close>

lemma complete_algebra_summable_geometric:
  fixes x :: "'a::{real_normed_algebra_1,banach}"
  assumes "norm x < 1"
  shows "summable (\<lambda>n. x ^ n)"
proof (rule summable_comparison_test)
  show "\<exists>N. \<forall>n\<ge>N. norm (x ^ n) \<le> norm x ^ n"
    by (simp add: norm_power_ineq)
  from assms show "summable (\<lambda>n. norm x ^ n)"
    by (simp add: summable_geometric)
qed

subsection \<open>Cauchy Product Formula\<close>

text \<open>
  Proof based on Analysis WebNotes: Chapter 07, Class 41
  \<^url>\<open>http://www.math.unl.edu/~webnotes/classes/class41/prp77.htm\<close>
\<close>

lemma Cauchy_product_sums:
  fixes a b :: "nat \<Rightarrow> 'a::{real_normed_algebra,banach}"
  assumes a: "summable (\<lambda>k. norm (a k))"
    and b: "summable (\<lambda>k. norm (b k))"
  shows "(\<lambda>k. \<Sum>i\<le>k. a i * b (k - i)) sums ((\<Sum>k. a k) * (\<Sum>k. b k))"
proof -
  let ?S1 = "\<lambda>n::nat. {..<n} \<times> {..<n}"
  let ?S2 = "\<lambda>n::nat. {(i,j). i + j < n}"
  have S1_mono: "\<And>m n. m \<le> n \<Longrightarrow> ?S1 m \<subseteq> ?S1 n" by auto
  have S2_le_S1: "\<And>n. ?S2 n \<subseteq> ?S1 n" by auto
  have S1_le_S2: "\<And>n. ?S1 (n div 2) \<subseteq> ?S2 n" by auto
  have finite_S1: "\<And>n. finite (?S1 n)" by simp
  with S2_le_S1 have finite_S2: "\<And>n. finite (?S2 n)" by (rule finite_subset)

  let ?g = "\<lambda>(i,j). a i * b j"
  let ?f = "\<lambda>(i,j). norm (a i) * norm (b j)"
  have f_nonneg: "\<And>x. 0 \<le> ?f x" by auto
  then have norm_sum_f: "\<And>A. norm (sum ?f A) = sum ?f A"
    unfolding real_norm_def
    by (simp only: abs_of_nonneg sum_nonneg [rule_format])

  have "(\<lambda>n. (\<Sum>k<n. a k) * (\<Sum>k<n. b k)) \<longlonglongrightarrow> (\<Sum>k. a k) * (\<Sum>k. b k)"
    by (intro tendsto_mult summable_LIMSEQ summable_norm_cancel [OF a] summable_norm_cancel [OF b])
  then have 1: "(\<lambda>n. sum ?g (?S1 n)) \<longlonglongrightarrow> (\<Sum>k. a k) * (\<Sum>k. b k)"
    by (simp only: sum_product sum.Sigma [rule_format] finite_lessThan)

  have "(\<lambda>n. (\<Sum>k<n. norm (a k)) * (\<Sum>k<n. norm (b k))) \<longlonglongrightarrow> (\<Sum>k. norm (a k)) * (\<Sum>k. norm (b k))"
    using a b by (intro tendsto_mult summable_LIMSEQ)
  then have "(\<lambda>n. sum ?f (?S1 n)) \<longlonglongrightarrow> (\<Sum>k. norm (a k)) * (\<Sum>k. norm (b k))"
    by (simp only: sum_product sum.Sigma [rule_format] finite_lessThan)
  then have "convergent (\<lambda>n. sum ?f (?S1 n))"
    by (rule convergentI)
  then have Cauchy: "Cauchy (\<lambda>n. sum ?f (?S1 n))"
    by (rule convergent_Cauchy)
  have "Zfun (\<lambda>n. sum ?f (?S1 n - ?S2 n)) sequentially"
  proof (rule ZfunI, simp only: eventually_sequentially norm_sum_f)
    fix r :: real
    assume r: "0 < r"
    from CauchyD [OF Cauchy r] obtain N
      where "\<forall>m\<ge>N. \<forall>n\<ge>N. norm (sum ?f (?S1 m) - sum ?f (?S1 n)) < r" ..
    then have "\<And>m n. N \<le> n \<Longrightarrow> n \<le> m \<Longrightarrow> norm (sum ?f (?S1 m - ?S1 n)) < r"
      by (simp only: sum_diff finite_S1 S1_mono)
    then have N: "\<And>m n. N \<le> n \<Longrightarrow> n \<le> m \<Longrightarrow> sum ?f (?S1 m - ?S1 n) < r"
      by (simp only: norm_sum_f)
    show "\<exists>N. \<forall>n\<ge>N. sum ?f (?S1 n - ?S2 n) < r"
    proof (intro exI allI impI)
      fix n
      assume "2 * N \<le> n"
      then have n: "N \<le> n div 2" by simp
      have "sum ?f (?S1 n - ?S2 n) \<le> sum ?f (?S1 n - ?S1 (n div 2))"
        by (intro sum_mono2 finite_Diff finite_S1 f_nonneg Diff_mono subset_refl S1_le_S2)
      also have "\<dots> < r"
        using n div_le_dividend by (rule N)
      finally show "sum ?f (?S1 n - ?S2 n) < r" .
    qed
  qed
  then have "Zfun (\<lambda>n. sum ?g (?S1 n - ?S2 n)) sequentially"
    apply (rule Zfun_le [rule_format])
    apply (simp only: norm_sum_f)
    apply (rule order_trans [OF norm_sum sum_mono])
    apply (auto simp add: norm_mult_ineq)
    done
  then have 2: "(\<lambda>n. sum ?g (?S1 n) - sum ?g (?S2 n)) \<longlonglongrightarrow> 0"
    unfolding tendsto_Zfun_iff diff_0_right
    by (simp only: sum_diff finite_S1 S2_le_S1)
  with 1 have "(\<lambda>n. sum ?g (?S2 n)) \<longlonglongrightarrow> (\<Sum>k. a k) * (\<Sum>k. b k)"
    by (rule Lim_transform2)
  then show ?thesis
    by (simp only: sums_def sum_triangle_reindex)
qed

lemma Cauchy_product:
  fixes a b :: "nat \<Rightarrow> 'a::{real_normed_algebra,banach}"
  assumes "summable (\<lambda>k. norm (a k))"
    and "summable (\<lambda>k. norm (b k))"
  shows "(\<Sum>k. a k) * (\<Sum>k. b k) = (\<Sum>k. \<Sum>i\<le>k. a i * b (k - i))"
  using assms by (rule Cauchy_product_sums [THEN sums_unique])

lemma summable_Cauchy_product:
  fixes a b :: "nat \<Rightarrow> 'a::{real_normed_algebra,banach}"
  assumes "summable (\<lambda>k. norm (a k))"
    and "summable (\<lambda>k. norm (b k))"
  shows "summable (\<lambda>k. \<Sum>i\<le>k. a i * b (k - i))"
  using Cauchy_product_sums[OF assms] by (simp add: sums_iff)

subsection \<open>Series on @{typ real}s\<close>

lemma summable_norm_comparison_test:
  "\<exists>N. \<forall>n\<ge>N. norm (f n) \<le> g n \<Longrightarrow> summable g \<Longrightarrow> summable (\<lambda>n. norm (f n))"
  by (rule summable_comparison_test) auto

lemma summable_rabs_comparison_test: "\<exists>N. \<forall>n\<ge>N. \<bar>f n\<bar> \<le> g n \<Longrightarrow> summable g \<Longrightarrow> summable (\<lambda>n. \<bar>f n\<bar>)"
  for f :: "nat \<Rightarrow> real"
  by (rule summable_comparison_test) auto

lemma summable_rabs_cancel: "summable (\<lambda>n. \<bar>f n\<bar>) \<Longrightarrow> summable f"
  for f :: "nat \<Rightarrow> real"
  by (rule summable_norm_cancel) simp

lemma summable_rabs: "summable (\<lambda>n. \<bar>f n\<bar>) \<Longrightarrow> \<bar>suminf f\<bar> \<le> (\<Sum>n. \<bar>f n\<bar>)"
  for f :: "nat \<Rightarrow> real"
  by (fold real_norm_def) (rule summable_norm)

lemma summable_zero_power [simp]: "summable (\<lambda>n. 0 ^ n :: 'a::{comm_ring_1,topological_space})"
proof -
  have "(\<lambda>n. 0 ^ n :: 'a) = (\<lambda>n. if n = 0 then 0^0 else 0)"
    by (intro ext) (simp add: zero_power)
  moreover have "summable \<dots>" by simp
  ultimately show ?thesis by simp
qed

lemma summable_zero_power' [simp]: "summable (\<lambda>n. f n * 0 ^ n :: 'a::{ring_1,topological_space})"
proof -
  have "(\<lambda>n. f n * 0 ^ n :: 'a) = (\<lambda>n. if n = 0 then f 0 * 0^0 else 0)"
    by (intro ext) (simp add: zero_power)
  moreover have "summable \<dots>" by simp
  ultimately show ?thesis by simp
qed

lemma summable_power_series:
  fixes z :: real
  assumes le_1: "\<And>i. f i \<le> 1"
    and nonneg: "\<And>i. 0 \<le> f i"
    and z: "0 \<le> z" "z < 1"
  shows "summable (\<lambda>i. f i * z^i)"
proof (rule summable_comparison_test[OF _ summable_geometric])
  show "norm z < 1"
    using z by (auto simp: less_imp_le)
  show "\<And>n. \<exists>N. \<forall>na\<ge>N. norm (f na * z ^ na) \<le> z ^ na"
    using z
    by (auto intro!: exI[of _ 0] mult_left_le_one_le simp: abs_mult nonneg power_abs less_imp_le le_1)
qed

lemma summable_0_powser: "summable (\<lambda>n. f n * 0 ^ n :: 'a::real_normed_div_algebra)"
proof -
  have A: "(\<lambda>n. f n * 0 ^ n) = (\<lambda>n. if n = 0 then f n else 0)"
    by (intro ext) auto
  then show ?thesis
    by (subst A) simp_all
qed

lemma summable_powser_split_head:
  "summable (\<lambda>n. f (Suc n) * z ^ n :: 'a::real_normed_div_algebra) = summable (\<lambda>n. f n * z ^ n)"
proof -
  have "summable (\<lambda>n. f (Suc n) * z ^ n) \<longleftrightarrow> summable (\<lambda>n. f (Suc n) * z ^ Suc n)"
    (is "?lhs \<longleftrightarrow> ?rhs")
  proof
    show ?rhs if ?lhs
      using summable_mult2[OF that, of z]
      by (simp add: power_commutes algebra_simps)
    show ?lhs if ?rhs
      using summable_mult2[OF that, of "inverse z"]
      by (cases "z \<noteq> 0", subst (asm) power_Suc2) (simp_all add: algebra_simps)
  qed
  also have "\<dots> \<longleftrightarrow> summable (\<lambda>n. f n * z ^ n)" by (rule summable_Suc_iff)
  finally show ?thesis .
qed

lemma powser_split_head:
  fixes f :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
  assumes "summable (\<lambda>n. f n * z ^ n)"
  shows "suminf (\<lambda>n. f n * z ^ n) = f 0 + suminf (\<lambda>n. f (Suc n) * z ^ n) * z"
    and "suminf (\<lambda>n. f (Suc n) * z ^ n) * z = suminf (\<lambda>n. f n * z ^ n) - f 0"
    and "summable (\<lambda>n. f (Suc n) * z ^ n)"
proof -
  from assms show "summable (\<lambda>n. f (Suc n) * z ^ n)"
    by (subst summable_powser_split_head)
  from suminf_mult2[OF this, of z]
    have "(\<Sum>n. f (Suc n) * z ^ n) * z = (\<Sum>n. f (Suc n) * z ^ Suc n)"
    by (simp add: power_commutes algebra_simps)
  also from assms have "\<dots> = suminf (\<lambda>n. f n * z ^ n) - f 0"
    by (subst suminf_split_head) simp_all
  finally show "suminf (\<lambda>n. f n * z ^ n) = f 0 + suminf (\<lambda>n. f (Suc n) * z ^ n) * z"
    by simp
  then show "suminf (\<lambda>n. f (Suc n) * z ^ n) * z = suminf (\<lambda>n. f n * z ^ n) - f 0"
    by simp
qed

lemma summable_partial_sum_bound:
  fixes f :: "nat \<Rightarrow> 'a :: banach"
    and e :: real
  assumes summable: "summable f"
    and e: "e > 0"
  obtains N where "\<And>m n. m \<ge> N \<Longrightarrow> norm (\<Sum>k=m..n. f k) < e"
proof -
  from summable have "Cauchy (\<lambda>n. \<Sum>k<n. f k)"
    by (simp add: Cauchy_convergent_iff summable_iff_convergent)
  from CauchyD [OF this e] obtain N
    where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> norm ((\<Sum>k<m. f k) - (\<Sum>k<n. f k)) < e"
    by blast
  have "norm (\<Sum>k=m..n. f k) < e" if m: "m \<ge> N" for m n
  proof (cases "n \<ge> m")
    case True
    with m have "norm ((\<Sum>k<Suc n. f k) - (\<Sum>k<m. f k)) < e"
      by (intro N) simp_all
    also from True have "(\<Sum>k<Suc n. f k) - (\<Sum>k<m. f k) = (\<Sum>k=m..n. f k)"
      by (subst sum_diff [symmetric]) (simp_all add: sum_last_plus)
    finally show ?thesis .
  next
    case False
    with e show ?thesis by simp_all
  qed
  then show ?thesis by (rule that)
qed

lemma powser_sums_if:
  "(\<lambda>n. (if n = m then (1 :: 'a::{ring_1,topological_space}) else 0) * z^n) sums z^m"
proof -
  have "(\<lambda>n. (if n = m then 1 else 0) * z^n) = (\<lambda>n. if n = m then z^n else 0)"
    by (intro ext) auto
  then show ?thesis
    by (simp add: sums_single)
qed

lemma
  fixes f :: "nat \<Rightarrow> real"
  assumes "summable f"
    and "inj g"
    and pos: "\<And>x. 0 \<le> f x"
  shows summable_reindex: "summable (f \<circ> g)"
    and suminf_reindex_mono: "suminf (f \<circ> g) \<le> suminf f"
    and suminf_reindex: "(\<And>x. x \<notin> range g \<Longrightarrow> f x = 0) \<Longrightarrow> suminf (f \<circ> g) = suminf f"
proof -
  from \<open>inj g\<close> have [simp]: "\<And>A. inj_on g A"
    by (rule subset_inj_on) simp

  have smaller: "\<forall>n. (\<Sum>i<n. (f \<circ> g) i) \<le> suminf f"
  proof
    fix n
    have "\<forall> n' \<in> (g ` {..<n}). n' < Suc (Max (g ` {..<n}))"
      by (metis Max_ge finite_imageI finite_lessThan not_le not_less_eq)
    then obtain m where n: "\<And>n'. n' < n \<Longrightarrow> g n' < m"
      by blast

    have "(\<Sum>i<n. f (g i)) = sum f (g ` {..<n})"
      by (simp add: sum.reindex)
    also have "\<dots> \<le> (\<Sum>i<m. f i)"
      by (rule sum_mono3) (auto simp add: pos n[rule_format])
    also have "\<dots> \<le> suminf f"
      using \<open>summable f\<close> by (rule sum_le_suminf) (simp add: pos)
    finally show "(\<Sum>i<n. (f \<circ>  g) i) \<le> suminf f"
      by simp
  qed

  have "incseq (\<lambda>n. \<Sum>i<n. (f \<circ> g) i)"
    by (rule incseq_SucI) (auto simp add: pos)
  then obtain  L where L: "(\<lambda> n. \<Sum>i<n. (f \<circ> g) i) \<longlonglongrightarrow> L"
    using smaller by(rule incseq_convergent)
  then have "(f \<circ> g) sums L"
    by (simp add: sums_def)
  then show "summable (f \<circ> g)"
    by (auto simp add: sums_iff)

  then have "(\<lambda>n. \<Sum>i<n. (f \<circ> g) i) \<longlonglongrightarrow> suminf (f \<circ> g)"
    by (rule summable_LIMSEQ)
  then show le: "suminf (f \<circ> g) \<le> suminf f"
    by(rule LIMSEQ_le_const2)(blast intro: smaller[rule_format])

  assume f: "\<And>x. x \<notin> range g \<Longrightarrow> f x = 0"

  from \<open>summable f\<close> have "suminf f \<le> suminf (f \<circ> g)"
  proof (rule suminf_le_const)
    fix n
    have "\<forall> n' \<in> (g -` {..<n}). n' < Suc (Max (g -` {..<n}))"
      by(auto intro: Max_ge simp add: finite_vimageI less_Suc_eq_le)
    then obtain m where n: "\<And>n'. g n' < n \<Longrightarrow> n' < m"
      by blast
    have "(\<Sum>i<n. f i) = (\<Sum>i\<in>{..<n} \<inter> range g. f i)"
      using f by(auto intro: sum.mono_neutral_cong_right)
    also have "\<dots> = (\<Sum>i\<in>g -` {..<n}. (f \<circ> g) i)"
      by (rule sum.reindex_cong[where l=g])(auto)
    also have "\<dots> \<le> (\<Sum>i<m. (f \<circ> g) i)"
      by (rule sum_mono3)(auto simp add: pos n)
    also have "\<dots> \<le> suminf (f \<circ> g)"
      using \<open>summable (f \<circ> g)\<close> by (rule sum_le_suminf) (simp add: pos)
    finally show "sum f {..<n} \<le> suminf (f \<circ> g)" .
  qed
  with le show "suminf (f \<circ> g) = suminf f"
    by (rule antisym)
qed

lemma sums_mono_reindex:
  assumes subseq: "subseq g"
    and zero: "\<And>n. n \<notin> range g \<Longrightarrow> f n = 0"
  shows "(\<lambda>n. f (g n)) sums c \<longleftrightarrow> f sums c"
  unfolding sums_def
proof
  assume lim: "(\<lambda>n. \<Sum>k<n. f k) \<longlonglongrightarrow> c"
  have "(\<lambda>n. \<Sum>k<n. f (g k)) = (\<lambda>n. \<Sum>k<g n. f k)"
  proof
    fix n :: nat
    from subseq have "(\<Sum>k<n. f (g k)) = (\<Sum>k\<in>g`{..<n}. f k)"
      by (subst sum.reindex) (auto intro: subseq_imp_inj_on)
    also from subseq have "\<dots> = (\<Sum>k<g n. f k)"
      by (intro sum.mono_neutral_left ballI zero)
        (auto dest: subseq_strict_mono simp: strict_mono_less strict_mono_less_eq)
    finally show "(\<Sum>k<n. f (g k)) = (\<Sum>k<g n. f k)" .
  qed
  also from LIMSEQ_subseq_LIMSEQ[OF lim subseq] have "\<dots> \<longlonglongrightarrow> c"
    by (simp only: o_def)
  finally show "(\<lambda>n. \<Sum>k<n. f (g k)) \<longlonglongrightarrow> c" .
next
  assume lim: "(\<lambda>n. \<Sum>k<n. f (g k)) \<longlonglongrightarrow> c"
  define g_inv where "g_inv n = (LEAST m. g m \<ge> n)" for n
  from filterlim_subseq[OF subseq] have g_inv_ex: "\<exists>m. g m \<ge> n" for n
    by (auto simp: filterlim_at_top eventually_at_top_linorder)
  then have g_inv: "g (g_inv n) \<ge> n" for n
    unfolding g_inv_def by (rule LeastI_ex)
  have g_inv_least: "m \<ge> g_inv n" if "g m \<ge> n" for m n
    using that unfolding g_inv_def by (rule Least_le)
  have g_inv_least': "g m < n" if "m < g_inv n" for m n
    using that g_inv_least[of n m] by linarith
  have "(\<lambda>n. \<Sum>k<n. f k) = (\<lambda>n. \<Sum>k<g_inv n. f (g k))"
  proof
    fix n :: nat
    {
      fix k
      assume k: "k \<in> {..<n} - g`{..<g_inv n}"
      have "k \<notin> range g"
      proof (rule notI, elim imageE)
        fix l
        assume l: "k = g l"
        have "g l < g (g_inv n)"
          by (rule less_le_trans[OF _ g_inv]) (use k l in simp_all)
        with subseq have "l < g_inv n"
          by (simp add: subseq_strict_mono strict_mono_less)
        with k l show False
          by simp
      qed
      then have "f k = 0"
        by (rule zero)
    }
    with g_inv_least' g_inv have "(\<Sum>k<n. f k) = (\<Sum>k\<in>g`{..<g_inv n}. f k)"
      by (intro sum.mono_neutral_right) auto
    also from subseq have "\<dots> = (\<Sum>k<g_inv n. f (g k))"
      using subseq_imp_inj_on by (subst sum.reindex) simp_all
    finally show "(\<Sum>k<n. f k) = (\<Sum>k<g_inv n. f (g k))" .
  qed
  also {
    fix K n :: nat
    assume "g K \<le> n"
    also have "n \<le> g (g_inv n)"
      by (rule g_inv)
    finally have "K \<le> g_inv n"
      using subseq by (simp add: strict_mono_less_eq subseq_strict_mono)
  }
  then have "filterlim g_inv at_top sequentially"
    by (auto simp: filterlim_at_top eventually_at_top_linorder)
  with lim have "(\<lambda>n. \<Sum>k<g_inv n. f (g k)) \<longlonglongrightarrow> c"
    by (rule filterlim_compose)
  finally show "(\<lambda>n. \<Sum>k<n. f k) \<longlonglongrightarrow> c" .
qed

lemma summable_mono_reindex:
  assumes subseq: "subseq g"
    and zero: "\<And>n. n \<notin> range g \<Longrightarrow> f n = 0"
  shows "summable (\<lambda>n. f (g n)) \<longleftrightarrow> summable f"
  using sums_mono_reindex[of g f, OF assms] by (simp add: summable_def)

lemma suminf_mono_reindex:
  fixes f :: "nat \<Rightarrow> 'a::{t2_space,comm_monoid_add}"
  assumes "subseq g" "\<And>n. n \<notin> range g \<Longrightarrow> f n = 0"
  shows   "suminf (\<lambda>n. f (g n)) = suminf f"
proof (cases "summable f")
  case True
  with sums_mono_reindex [of g f, OF assms]
    and summable_mono_reindex [of g f, OF assms]
  show ?thesis
    by (simp add: sums_iff)
next
  case False
  then have "\<not>(\<exists>c. f sums c)"
    unfolding summable_def by blast
  then have "suminf f = The (\<lambda>_. False)"
    by (simp add: suminf_def)
  moreover from False have "\<not> summable (\<lambda>n. f (g n))"
    using summable_mono_reindex[of g f, OF assms] by simp
  then have "\<not>(\<exists>c. (\<lambda>n. f (g n)) sums c)"
    unfolding summable_def by blast
  then have "suminf (\<lambda>n. f (g n)) = The (\<lambda>_. False)"
    by (simp add: suminf_def)
  ultimately show ?thesis by simp
qed

end