(*  Title:      HOL/UNITY/ListOrder.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1998  University of Cambridge

Lists are partially ordered by Charpentier's Generalized Prefix Relation
   (xs,ys) : genPrefix(r)
     if ys = xs' @ zs where length xs = length xs'
     and corresponding elements of xs, xs' are pairwise related by r

Also overloads <= and < for lists!
*)

section {*The Prefix Ordering on Lists*}

theory ListOrder
imports Main
begin

inductive_set
  genPrefix :: "('a * 'a)set => ('a list * 'a list)set"
  for r :: "('a * 'a)set"
 where
   Nil:     "([],[]) : genPrefix(r)"

 | prepend: "[| (xs,ys) : genPrefix(r);  (x,y) : r |] ==>
             (x#xs, y#ys) : genPrefix(r)"

 | append:  "(xs,ys) : genPrefix(r) ==> (xs, ys@zs) : genPrefix(r)"

instantiation list :: (type) ord
begin

definition
  prefix_def:        "xs <= zs \<longleftrightarrow>  (xs, zs) : genPrefix Id"

definition
  strict_prefix_def: "xs < zs  \<longleftrightarrow>  xs \<le> zs \<and> \<not> zs \<le> (xs :: 'a list)"

instance ..

(*Constants for the <= and >= relations, used below in translations*)

end

definition Le :: "(nat*nat) set" where
    "Le == {(x,y). x <= y}"

definition  Ge :: "(nat*nat) set" where
    "Ge == {(x,y). y <= x}"

abbreviation
  pfixLe :: "[nat list, nat list] => bool"  (infixl "pfixLe" 50)  where
  "xs pfixLe ys == (xs,ys) : genPrefix Le"

abbreviation
  pfixGe :: "[nat list, nat list] => bool"  (infixl "pfixGe" 50)  where
  "xs pfixGe ys == (xs,ys) : genPrefix Ge"

subsection{*preliminary lemmas*}

lemma Nil_genPrefix [iff]: "([], xs) : genPrefix r"
by (cut_tac genPrefix.Nil [THEN genPrefix.append], auto)

lemma genPrefix_length_le: "(xs,ys) : genPrefix r ==> length xs <= length ys"
by (erule genPrefix.induct, auto)

lemma cdlemma:
     "[| (xs', ys'): genPrefix r |]
      ==> (ALL x xs. xs' = x#xs --> (EX y ys. ys' = y#ys & (x,y) : r & (xs, ys) : genPrefix r))"
apply (erule genPrefix.induct, blast, blast)
apply (force intro: genPrefix.append)
done

(*As usual converting it to an elimination rule is tiresome*)
lemma cons_genPrefixE [elim!]:
     "[| (x#xs, zs): genPrefix r;
         !!y ys. [| zs = y#ys;  (x,y) : r;  (xs, ys) : genPrefix r |] ==> P
      |] ==> P"
by (drule cdlemma, simp, blast)

lemma Cons_genPrefix_Cons [iff]:
     "((x#xs,y#ys) : genPrefix r) = ((x,y) : r & (xs,ys) : genPrefix r)"
by (blast intro: genPrefix.prepend)

subsection{*genPrefix is a partial order*}

lemma refl_genPrefix: "refl r ==> refl (genPrefix r)"
apply (unfold refl_on_def, auto)
apply (induct_tac "x")
prefer 2 apply (blast intro: genPrefix.prepend)
apply (blast intro: genPrefix.Nil)
done

lemma genPrefix_refl [simp]: "refl r ==> (l,l) : genPrefix r"
by (erule refl_onD [OF refl_genPrefix UNIV_I])

lemma genPrefix_mono: "r<=s ==> genPrefix r <= genPrefix s"
apply clarify
apply (erule genPrefix.induct)
apply (auto intro: genPrefix.append)
done

(** Transitivity **)

(*A lemma for proving genPrefix_trans_O*)
lemma append_genPrefix:
     "(xs @ ys, zs) : genPrefix r \<Longrightarrow> (xs, zs) : genPrefix r"
  by (induct xs arbitrary: zs) auto

(*Lemma proving transitivity and more*)
lemma genPrefix_trans_O:
  assumes "(x, y) : genPrefix r"
  shows "\<And>z. (y, z) : genPrefix s \<Longrightarrow> (x, z) : genPrefix (r O s)"
  apply (atomize (full))
  using assms
  apply induct
    apply blast
   apply (blast intro: genPrefix.prepend)
  apply (blast dest: append_genPrefix)
  done

lemma genPrefix_trans:
  "(x, y) : genPrefix r \<Longrightarrow> (y, z) : genPrefix r \<Longrightarrow> trans r
    \<Longrightarrow> (x, z) : genPrefix r"
  apply (rule trans_O_subset [THEN genPrefix_mono, THEN subsetD])
   apply assumption
  apply (blast intro: genPrefix_trans_O)
  done

lemma prefix_genPrefix_trans:
  "[| x<=y;  (y,z) : genPrefix r |] ==> (x, z) : genPrefix r"
apply (unfold prefix_def)
apply (drule genPrefix_trans_O, assumption)
apply simp
done

lemma genPrefix_prefix_trans:
  "[| (x,y) : genPrefix r;  y<=z |] ==> (x,z) : genPrefix r"
apply (unfold prefix_def)
apply (drule genPrefix_trans_O, assumption)
apply simp
done

lemma trans_genPrefix: "trans r ==> trans (genPrefix r)"
by (blast intro: transI genPrefix_trans)

(** Antisymmetry **)

lemma genPrefix_antisym:
  assumes 1: "(xs, ys) : genPrefix r"
    and 2: "antisym r"
    and 3: "(ys, xs) : genPrefix r"
  shows "xs = ys"
  using 1 3
proof induct
  case Nil
  then show ?case by blast
next
  case prepend
  then show ?case using 2 by (simp add: antisym_def)
next
  case (append xs ys zs)
  then show ?case
    apply -
    apply (subgoal_tac "length zs = 0", force)
    apply (drule genPrefix_length_le)+
    apply (simp del: length_0_conv)
    done
qed

lemma antisym_genPrefix: "antisym r ==> antisym (genPrefix r)"
  by (blast intro: antisymI genPrefix_antisym)

subsection{*recursion equations*}

lemma genPrefix_Nil [simp]: "((xs, []) : genPrefix r) = (xs = [])"
  by (induct xs) auto

lemma same_genPrefix_genPrefix [simp]:
    "refl r ==> ((xs@ys, xs@zs) : genPrefix r) = ((ys,zs) : genPrefix r)"
  by (induct xs) (simp_all add: refl_on_def)

lemma genPrefix_Cons:
     "((xs, y#ys) : genPrefix r) =
      (xs=[] | (EX z zs. xs=z#zs & (z,y) : r & (zs,ys) : genPrefix r))"
  by (cases xs) auto

lemma genPrefix_take_append:
     "[| refl r;  (xs,ys) : genPrefix r |]
      ==>  (xs@zs, take (length xs) ys @ zs) : genPrefix r"
apply (erule genPrefix.induct)
apply (frule_tac [3] genPrefix_length_le)
apply (simp_all (no_asm_simp) add: diff_is_0_eq [THEN iffD2])
done

lemma genPrefix_append_both:
     "[| refl r;  (xs,ys) : genPrefix r;  length xs = length ys |]
      ==>  (xs@zs, ys @ zs) : genPrefix r"
apply (drule genPrefix_take_append, assumption)
apply simp
done

(*NOT suitable for rewriting since [y] has the form y#ys*)
lemma append_cons_eq: "xs @ y # ys = (xs @ [y]) @ ys"
by auto

lemma aolemma:
     "[| (xs,ys) : genPrefix r;  refl r |]
      ==> length xs < length ys --> (xs @ [ys ! length xs], ys) : genPrefix r"
apply (erule genPrefix.induct)
  apply blast
 apply simp
txt{*Append case is hardest*}
apply simp
apply (frule genPrefix_length_le [THEN le_imp_less_or_eq])
apply (erule disjE)
apply (simp_all (no_asm_simp) add: neq_Nil_conv nth_append)
apply (blast intro: genPrefix.append, auto)
apply (subst append_cons_eq, fast intro: genPrefix_append_both genPrefix.append)
done

lemma append_one_genPrefix:
     "[| (xs,ys) : genPrefix r;  length xs < length ys;  refl r |]
      ==> (xs @ [ys ! length xs], ys) : genPrefix r"
by (blast intro: aolemma [THEN mp])

(** Proving the equivalence with Charpentier's definition **)

lemma genPrefix_imp_nth:
    "i < length xs \<Longrightarrow> (xs, ys) : genPrefix r \<Longrightarrow> (xs ! i, ys ! i) : r"
  apply (induct xs arbitrary: i ys)
   apply auto
  apply (case_tac i)
   apply auto
  done

lemma nth_imp_genPrefix:
  "length xs <= length ys \<Longrightarrow>
     (\<forall>i. i < length xs --> (xs ! i, ys ! i) : r) \<Longrightarrow>
     (xs, ys) : genPrefix r"
  apply (induct xs arbitrary: ys)
   apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib)
  apply (case_tac ys)
   apply (force+)
  done

lemma genPrefix_iff_nth:
     "((xs,ys) : genPrefix r) =
      (length xs <= length ys & (ALL i. i < length xs --> (xs!i, ys!i) : r))"
apply (blast intro: genPrefix_length_le genPrefix_imp_nth nth_imp_genPrefix)
done

subsection{*The type of lists is partially ordered*}

declare refl_Id [iff]
        antisym_Id [iff]
        trans_Id [iff]

lemma prefix_refl [iff]: "xs <= (xs::'a list)"
by (simp add: prefix_def)

lemma prefix_trans: "!!xs::'a list. [| xs <= ys; ys <= zs |] ==> xs <= zs"
apply (unfold prefix_def)
apply (blast intro: genPrefix_trans)
done

lemma prefix_antisym: "!!xs::'a list. [| xs <= ys; ys <= xs |] ==> xs = ys"
apply (unfold prefix_def)
apply (blast intro: genPrefix_antisym)
done

lemma prefix_less_le_not_le: "!!xs::'a list. (xs < zs) = (xs <= zs & \<not> zs \<le> xs)"
by (unfold strict_prefix_def, auto)

instance list :: (type) order
  by (intro_classes,
      (assumption | rule prefix_refl prefix_trans prefix_antisym
                     prefix_less_le_not_le)+)

(*Monotonicity of "set" operator WRT prefix*)
lemma set_mono: "xs <= ys ==> set xs <= set ys"
apply (unfold prefix_def)
apply (erule genPrefix.induct, auto)
done

(** recursion equations **)

lemma Nil_prefix [iff]: "[] <= xs"
by (simp add: prefix_def)

lemma prefix_Nil [simp]: "(xs <= []) = (xs = [])"
by (simp add: prefix_def)

lemma Cons_prefix_Cons [simp]: "(x#xs <= y#ys) = (x=y & xs<=ys)"
by (simp add: prefix_def)

lemma same_prefix_prefix [simp]: "(xs@ys <= xs@zs) = (ys <= zs)"
by (simp add: prefix_def)

lemma append_prefix [iff]: "(xs@ys <= xs) = (ys <= [])"
by (insert same_prefix_prefix [of xs ys "[]"], simp)

lemma prefix_appendI [simp]: "xs <= ys ==> xs <= ys@zs"
apply (unfold prefix_def)
apply (erule genPrefix.append)
done

lemma prefix_Cons:
   "(xs <= y#ys) = (xs=[] | (? zs. xs=y#zs & zs <= ys))"
by (simp add: prefix_def genPrefix_Cons)

lemma append_one_prefix:
  "[| xs <= ys; length xs < length ys |] ==> xs @ [ys ! length xs] <= ys"
apply (unfold prefix_def)
apply (simp add: append_one_genPrefix)
done

lemma prefix_length_le: "xs <= ys ==> length xs <= length ys"
apply (unfold prefix_def)
apply (erule genPrefix_length_le)
done

lemma splemma: "xs<=ys ==> xs~=ys --> length xs < length ys"
apply (unfold prefix_def)
apply (erule genPrefix.induct, auto)
done

lemma strict_prefix_length_less: "xs < ys ==> length xs < length ys"
apply (unfold strict_prefix_def)
apply (blast intro: splemma [THEN mp])
done

lemma mono_length: "mono length"
by (blast intro: monoI prefix_length_le)

(*Equivalence to the definition used in Lex/Prefix.thy*)
lemma prefix_iff: "(xs <= zs) = (EX ys. zs = xs@ys)"
apply (unfold prefix_def)
apply (auto simp add: genPrefix_iff_nth nth_append)
apply (rule_tac x = "drop (length xs) zs" in exI)
apply (rule nth_equalityI)
apply (simp_all (no_asm_simp) add: nth_append)
done

lemma prefix_snoc [simp]: "(xs <= ys@[y]) = (xs = ys@[y] | xs <= ys)"
apply (simp add: prefix_iff)
apply (rule iffI)
 apply (erule exE)
 apply (rename_tac "zs")
 apply (rule_tac xs = zs in rev_exhaust)
  apply simp
 apply clarify
 apply (simp del: append_assoc add: append_assoc [symmetric], force)
done

lemma prefix_append_iff:
     "(xs <= ys@zs) = (xs <= ys | (? us. xs = ys@us & us <= zs))"
apply (rule_tac xs = zs in rev_induct)
 apply force
apply (simp del: append_assoc add: append_assoc [symmetric], force)
done

(*Although the prefix ordering is not linear, the prefixes of a list
  are linearly ordered.*)
lemma common_prefix_linear:
  fixes xs ys zs :: "'a list"
  shows "xs <= zs \<Longrightarrow> ys <= zs \<Longrightarrow> xs <= ys | ys <= xs"
  by (induct zs rule: rev_induct) auto

subsection{*pfixLe, pfixGe: properties inherited from the translations*}

(** pfixLe **)

lemma refl_Le [iff]: "refl Le"
by (unfold refl_on_def Le_def, auto)

lemma antisym_Le [iff]: "antisym Le"
by (unfold antisym_def Le_def, auto)

lemma trans_Le [iff]: "trans Le"
by (unfold trans_def Le_def, auto)

lemma pfixLe_refl [iff]: "x pfixLe x"
by simp

lemma pfixLe_trans: "[| x pfixLe y; y pfixLe z |] ==> x pfixLe z"
by (blast intro: genPrefix_trans)

lemma pfixLe_antisym: "[| x pfixLe y; y pfixLe x |] ==> x = y"
by (blast intro: genPrefix_antisym)

lemma prefix_imp_pfixLe: "xs<=ys ==> xs pfixLe ys"
apply (unfold prefix_def Le_def)
apply (blast intro: genPrefix_mono [THEN [2] rev_subsetD])
done

lemma refl_Ge [iff]: "refl Ge"
by (unfold refl_on_def Ge_def, auto)

lemma antisym_Ge [iff]: "antisym Ge"
by (unfold antisym_def Ge_def, auto)

lemma trans_Ge [iff]: "trans Ge"
by (unfold trans_def Ge_def, auto)

lemma pfixGe_refl [iff]: "x pfixGe x"
by simp

lemma pfixGe_trans: "[| x pfixGe y; y pfixGe z |] ==> x pfixGe z"
by (blast intro: genPrefix_trans)

lemma pfixGe_antisym: "[| x pfixGe y; y pfixGe x |] ==> x = y"
by (blast intro: genPrefix_antisym)

lemma prefix_imp_pfixGe: "xs<=ys ==> xs pfixGe ys"
apply (unfold prefix_def Ge_def)
apply (blast intro: genPrefix_mono [THEN [2] rev_subsetD])
done

end


theory Desargues_Property
  imports Main Projective_Plane_Axioms Pappus_Property Pascal_Property
begin

(* Author: Anthony Bordg, University of Cambridge, apdb3@cam.ac.uk .*)

text \<open>
Contents:
\<^item> We formalize Desargues's property, [desargues_prop], that states that if two triangles are perspective
from a point, then they are perspective from a line.
Note that some planes satisfy that property and some others don't, hence Desargues's property is
not a theorem though it is a theorem in projective space geometry.
\<close>

section \<open>Desargues's Property\<close>

definition distinct3 :: "[Points, Points, Points] \<Rightarrow> bool" where
"distinct3 A B C \<equiv> A \<noteq> B \<and> A \<noteq> C \<and> B \<noteq> C"

definition triangle :: "[Points, Points, Points] \<Rightarrow> bool" where
"triangle A B C \<equiv> distinct3 A B C \<and> (line A B \<noteq> line A C)"

definition meet_in :: "Lines \<Rightarrow> Lines => Points => bool " where
"meet_in l m P \<equiv> incid P l \<and> incid P m"

lemma meet_col_1:
  assumes "meet_in (line A B) (line C D) P"
  shows "col A B P"
  using assms col_def incidA_lAB incidB_lAB meet_in_def
  by blast

lemma meet_col_2:
  assumes "meet_in (line A B) (line C D) P"
  shows "col C D P"
  using assms meet_col_1 meet_in_def
  by auto

definition meet_3_in :: "[Lines, Lines, Lines, Points] \<Rightarrow> bool" where
"meet_3_in l m n P \<equiv> meet_in l m P \<and> meet_in l n P"

lemma meet_all_3:
  assumes "meet_3_in l m n P"
  shows "meet_in m n P"
  using assms meet_3_in_def meet_in_def
  by auto

lemma meet_3_col_1:
  assumes "meet_3_in (line A B) m n P"
  shows "col A B P"
  using assms meet_3_in_def meet_col_2 meet_in_def
  by auto

lemma meet_3_col_2:
  assumes "meet_3_in l (line A B) n P"
  shows "col A B P"
  using assms col_def incidA_lAB incidB_lAB meet_3_in_def meet_in_def
  by blast

lemma meet_3_col_3:
  assumes "meet_3_in l m (line A B) P"
  shows "col A B P"
  using assms meet_3_col_2 meet_3_in_def
  by auto

definition distinct7 ::
  "[Points, Points, Points, Points, Points, Points, Points] \<Rightarrow> bool" where
"distinct7 A B C D E F G \<equiv> (A \<noteq> B) \<and> (A \<noteq> C) \<and> (A \<noteq> D) \<and> (A \<noteq> E) \<and> (A \<noteq> F) \<and> (A \<noteq> G) \<and>
(B \<noteq> C) \<and> (B \<noteq> D) \<and> (B \<noteq> E) \<and> (B \<noteq> F) \<and> (B \<noteq> G) \<and>
(C \<noteq> D) \<and> (C \<noteq> E) \<and> (C \<noteq> F) \<and> (C \<noteq> G) \<and>
(D \<noteq> E) \<and> (D \<noteq> F) \<and> (D \<noteq> G) \<and>
(E \<noteq> F) \<and> (E \<noteq> G) \<and>
(F \<noteq> G)"

definition distinct3l :: "[Lines, Lines, Lines] \<Rightarrow> bool" where
"distinct3l l m n \<equiv> l \<noteq> m \<and> l \<noteq> n \<and> m \<noteq> n"

(* From now on we give less general statements on purpose to avoid a lot of uninteresting
degenerate cases, since we can hardly think of any interesting application where one would need
to instantiate a statement on such degenerate case, hence our statements and proofs will be more
textbook-like. For the working mathematician the only thing that probably matters is the main
theorem without considering all the degenerate cases for which the statement might still hold. *)

definition desargues_config ::
  "[Points, Points, Points, Points, Points, Points, Points, Points, Points, Points] => bool" where
"desargues_config A B C A' B' C' M N P R \<equiv> distinct7 A B C A' B' C' R \<and> \<not> col A B C
\<and> \<not> col A' B' C' \<and> distinct3l (line A A') (line B B') (line C C') \<and>
meet_3_in (line A A') (line B B') (line C C') R \<and> (line A B) \<noteq> (line A' B') \<and>
(line B C) \<noteq> (line B' C') \<and> (line A C) \<noteq> (line A' C') \<and> meet_in (line B C) (line B' C') M \<and>
meet_in (line A C) (line A' C') N \<and> meet_in (line A B) (line A' B') P"

lemma distinct7_rot_CW:
  assumes "distinct7 A B C D E F G"
  shows "distinct7 C A B F D E G"
  using assms distinct7_def
  by auto

(* Desargues configurations are stable under any rotation (i,j,k) of {1,2,3} *)

lemma desargues_config_rot_CCW:
  assumes "desargues_config A B C A' B' C' M N P R"
  shows "desargues_config B C A B' C' A' N P M R"
  by (simp add: assms desargues_config_rot_CW)

(* With the two following definitions we repackage the definition of a Desargues configuration in a
"high-level", i.e. textbook-like, way. *)

definition are_perspective_from_point ::
  "[Points, Points, Points, Points, Points, Points, Points] \<Rightarrow> bool" where
"are_perspective_from_point A B C A' B' C' R \<equiv> distinct7 A B C A' B' C' R \<and> triangle A B C \<and>
triangle A' B' C' \<and> distinct3l (line A A') (line B B') (line C C') \<and>
meet_3_in (line A A') (line B B') (line C C') R"

definition are_perspective_from_line ::
  "[Points, Points, Points, Points, Points, Points] \<Rightarrow> bool" where
"are_perspective_from_line A B C A' B' C' \<equiv> distinct6 A B C A' B' C' \<longrightarrow> triangle A B C \<longrightarrow>
triangle A' B' C' \<longrightarrow> line A B \<noteq> line A' B' \<longrightarrow> line A C \<noteq> line A' C' \<longrightarrow> line B C \<noteq> line B' C' \<longrightarrow>
col (inter (line A B) (line A' B')) (inter (line A C) (line A' C')) (inter (line B C) (line B' C'))"

lemma meet_in_inter:
  assumes "l \<noteq> m"
  shows "meet_in l m (inter l m)"
  by (simp add: incid_inter_left incid_inter_right meet_in_def)

lemma perspective_from_point_desargues_config:
  assumes "are_perspective_from_point A B C A' B' C' R" and "line A B \<noteq> line A' B'" and
    "line A C \<noteq> line A' C'" and "line B C \<noteq> line B' C'"
  shows "desargues_config A B C A' B' C' (inter (line B C) (line B' C')) (inter (line A C) (line A' C'))
    (inter (line A B) (line A' B')) R"
  by (smt are_perspective_from_point_def assms(1) assms(2) assms(3) assms(4) col_line_ext_1
      desargues_config_def distinct3_def incidB_lAB inter_line_ext_2 line_comm meet_in_inter
      triangle_def uniq_inter)

(* Now, we state Desargues's property in a textbook-like form *)
definition desargues_prop :: "bool" where
"desargues_prop \<equiv>
\<forall>A B C A' B' C' P.
  are_perspective_from_point A B C A' B' C' P \<longrightarrow> are_perspective_from_line A B C A' B' C'"

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 "~~/src/HOL/Number_Theory/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


(*  Title:      HOL/Modules.thy
    Author:     Amine Chaieb, University of Cambridge
    Author:     Jose Divasón <jose.divasonm at unirioja.es>
    Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
    Author:     Johannes Hölzl, VU Amsterdam
    Author:     Fabian Immler, TUM
*)

section \<open>Modules\<close>

text \<open>Bases of a linear algebra based on modules (i.e. vector spaces of rings). \<close>

theory Modules
  imports Hull
begin

subsection \<open>Locale for additive functions\<close>

locale additive =
  fixes f :: "'a::ab_group_add \<Rightarrow> 'b::ab_group_add"
  assumes add: "f (x + y) = f x + f y"
begin

lemma zero: "f 0 = 0"
proof -
  have "f 0 = f (0 + 0)" by simp
  also have "\<dots> = f 0 + f 0" by (rule add)
  finally show "f 0 = 0" by simp
qed

lemma minus: "f (- x) = - f x"
proof -
  have "f (- x) + f x = f (- x + x)" by (rule add [symmetric])
  also have "\<dots> = - f x + f x" by (simp add: zero)
  finally show "f (- x) = - f x" by (rule add_right_imp_eq)
qed

lemma diff: "f (x - y) = f x - f y"
  using add [of x "- y"] by (simp add: minus)

lemma sum: "f (sum g A) = (\<Sum>x\<in>A. f (g x))"
  by (induct A rule: infinite_finite_induct) (simp_all add: zero add)

end

text \<open>Modules form the central spaces in linear algebra. They are a generalization from vector
spaces by replacing the scalar field by a scalar ring.\<close>
locale module =
  fixes scale :: "'a::comm_ring_1 \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*s" 75)
  assumes scale_right_distrib [algebra_simps, algebra_split_simps]:
      "a *s (x + y) = a *s x + a *s y"
    and scale_left_distrib [algebra_simps, algebra_split_simps]:
      "(a + b) *s x = a *s x + b *s x"
    and scale_scale [simp]: "a *s (b *s x) = (a * b) *s x"
    and scale_one [simp]: "1 *s x = x"
begin

lemma scale_left_commute: "a *s (b *s x) = b *s (a *s x)"
  by (simp add: mult.commute)

lemma scale_zero_left [simp]: "0 *s x = 0"
  and scale_minus_left [simp]: "(- a) *s x = - (a *s x)"
  and scale_left_diff_distrib [algebra_simps, algebra_split_simps]:
    "(a - b) *s x = a *s x - b *s x"
  and scale_sum_left: "(sum f A) *s x = (\<Sum>a\<in>A. (f a) *s x)"
proof -
  interpret s: additive "\<lambda>a. a *s x"
    by standard (rule scale_left_distrib)
  show "0 *s x = 0" by (rule s.zero)
  show "(- a) *s x = - (a *s x)" by (rule s.minus)
  show "(a - b) *s x = a *s x - b *s x" by (rule s.diff)
  show "(sum f A) *s x = (\<Sum>a\<in>A. (f a) *s x)" by (rule s.sum)
qed

lemma scale_zero_right [simp]: "a *s 0 = 0"
  and scale_minus_right [simp]: "a *s (- x) = - (a *s x)"
  and scale_right_diff_distrib [algebra_simps, algebra_split_simps]:
    "a *s (x - y) = a *s x - a *s y"
  and scale_sum_right: "a *s (sum f A) = (\<Sum>x\<in>A. a *s (f x))"
proof -
  interpret s: additive "\<lambda>x. a *s x"
    by standard (rule scale_right_distrib)
  show "a *s 0 = 0" by (rule s.zero)
  show "a *s (- x) = - (a *s x)" by (rule s.minus)
  show "a *s (x - y) = a *s x - a *s y" by (rule s.diff)
  show "a *s (sum f A) = (\<Sum>x\<in>A. a *s (f x))" by (rule s.sum)
qed

lemma sum_constant_scale: "(\<Sum>x\<in>A. y) = scale (of_nat (card A)) y"
  by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)

end

setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>

context module
begin

lemma [field_simps, field_split_simps]:
  shows scale_left_distrib_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a + b) *s x = a *s x + b *s x"
    and scale_right_distrib_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a *s (x + y) = a *s x + a *s y"
    and scale_left_diff_distrib_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a - b) *s x = a *s x - b *s x"
    and scale_right_diff_distrib_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a *s (x - y) = a *s x - a *s y"
  by (rule scale_left_distrib scale_right_distrib scale_left_diff_distrib scale_right_diff_distrib)+

end

setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a::divide \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>

section \<open>Subspace\<close>

context module
begin

definition subspace :: "'b set \<Rightarrow> bool"
  where "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x\<in>S. \<forall>y\<in>S. x + y \<in> S) \<and> (\<forall>c. \<forall>x\<in>S. c *s x \<in> S)"

lemma subspaceI:
  "0 \<in> S \<Longrightarrow> (\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S) \<Longrightarrow> (\<And>c x. x \<in> S \<Longrightarrow> c *s x \<in> S) \<Longrightarrow> subspace S"
  by (auto simp: subspace_def)

lemma subspace_UNIV[simp]: "subspace UNIV"
  by (simp add: subspace_def)

lemma subspace_single_0[simp]: "subspace {0}"
  by (simp add: subspace_def)

lemma subspace_0: "subspace S \<Longrightarrow> 0 \<in> S"
  by (metis subspace_def)

lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S"
  by (metis subspace_def)

lemma subspace_scale: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
  by (metis subspace_def)

lemma subspace_neg: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> - x \<in> S"
  by (metis scale_minus_left scale_one subspace_scale)

lemma subspace_diff: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
  by (metis diff_conv_add_uminus subspace_add subspace_neg)

lemma subspace_sum: "subspace A \<Longrightarrow> (\<And>x. x \<in> B \<Longrightarrow> f x \<in> A) \<Longrightarrow> sum f B \<in> A"
  by (induct B rule: infinite_finite_induct) (auto simp add: subspace_add subspace_0)

lemma subspace_Int: "(\<And>i. i \<in> I \<Longrightarrow> subspace (s i)) \<Longrightarrow> subspace (\<Inter>i\<in>I. s i)"
  by (auto simp: subspace_def)

lemma subspace_Inter: "\<forall>s \<in> f. subspace s \<Longrightarrow> subspace (\<Inter>f)"
  unfolding subspace_def by auto

lemma subspace_inter: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<inter> B)"
  by (simp add: subspace_def)

section \<open>Span: subspace generated by a set\<close>

definition span :: "'b set \<Rightarrow> 'b set"
  where span_explicit: "span b = {(\<Sum>a\<in>t. r a *s  a) | t r. finite t \<and> t \<subseteq> b}"

lemma span_explicit':
  "span b = {(\<Sum>v | f v \<noteq> 0. f v *s v) | f. finite {v. f v \<noteq> 0} \<and> (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)}"
  unfolding span_explicit
proof safe
  fix t r assume "finite t" "t \<subseteq> b"
  then show "\<exists>f. (\<Sum>a\<in>t. r a *s a) = (\<Sum>v | f v \<noteq> 0. f v *s v) \<and> finite {v. f v \<noteq> 0} \<and> (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)"
    by (intro exI[of _ "\<lambda>v. if v \<in> t then r v else 0"]) (auto intro!: sum.mono_neutral_cong_right)
next
  fix f :: "'b \<Rightarrow> 'a" assume "finite {v. f v \<noteq> 0}" "(\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)"
  then show "\<exists>t r. (\<Sum>v | f v \<noteq> 0. f v *s v) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> b"
    by (intro exI[of _ "{v. f v \<noteq> 0}"] exI[of _ f]) auto
qed

lemma span_alt:
  "span B = {(\<Sum>x | f x \<noteq> 0. f x *s x) | f. {x. f x \<noteq> 0} \<subseteq> B \<and> finite {x. f x \<noteq> 0}}"
  unfolding span_explicit' by auto

lemma span_finite:
  assumes fS: "finite S"
  shows "span S = range (\<lambda>u. \<Sum>v\<in>S. u v *s v)"
  unfolding span_explicit
proof safe
  fix t r assume "t \<subseteq> S" then show "(\<Sum>a\<in>t. r a *s a) \<in> range (\<lambda>u. \<Sum>v\<in>S. u v *s v)"
    by (intro image_eqI[of _ _ "\<lambda>a. if a \<in> t then r a else 0"])
       (auto simp: if_distrib[of "\<lambda>r. r *s a" for a] sum.If_cases fS Int_absorb1)
next
  show "\<exists>t r. (\<Sum>v\<in>S. u v *s v) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> S" for u
    by (intro exI[of _ u] exI[of _ S]) (auto intro: fS)
qed

lemma span_induct_alt [consumes 1, case_names base step, induct set: span]:
  assumes x: "x \<in> span S"
  assumes h0: "h 0" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *s x + y)"
  shows "h x"
  using x unfolding span_explicit
proof safe
  fix t r assume "finite t" "t \<subseteq> S" then show "h (\<Sum>a\<in>t. r a *s a)"
    by (induction t) (auto intro!: hS h0)
qed

lemma span_mono: "A \<subseteq> B \<Longrightarrow> span A \<subseteq> span B"
  by (auto simp: span_explicit)

lemma span_base: "a \<in> S \<Longrightarrow> a \<in> span S"
  by (auto simp: span_explicit intro!: exI[of _ "{a}"] exI[of _ "\<lambda>_. 1"])

lemma span_superset: "S \<subseteq> span S"
  by (auto simp: span_base)

lemma span_zero: "0 \<in> span S"
  by (auto simp: span_explicit intro!: exI[of _ "{}"])

lemma span_UNIV[simp]: "span UNIV = UNIV"
  by (auto intro: span_base)

lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
  unfolding span_explicit
proof safe
  fix tx ty rx ry assume *: "finite tx" "finite ty" "tx \<subseteq> S" "ty \<subseteq> S"
  have [simp]: "(tx \<union> ty) \<inter> tx = tx" "(tx \<union> ty) \<inter> ty = ty"
    by auto
  show "\<exists>t r. (\<Sum>a\<in>tx. rx a *s a) + (\<Sum>a\<in>ty. ry a *s a) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> S"
    apply (intro exI[of _ "tx \<union> ty"])
    apply (intro exI[of _ "\<lambda>a. (if a \<in> tx then rx a else 0) + (if a \<in> ty then ry a else 0)"])
    apply (auto simp: * scale_left_distrib sum.distrib if_distrib[of "\<lambda>r. r *s a" for a] sum.If_cases)
    done
qed

lemma span_scale: "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
  unfolding span_explicit
proof safe
  fix t r assume *: "finite t" "t \<subseteq> S"
  show "\<exists>t' r'. c *s (\<Sum>a\<in>t. r a *s a) = (\<Sum>a\<in>t'. r' a *s a) \<and> finite t' \<and> t' \<subseteq> S"
    by (intro exI[of _ t] exI[of _ "\<lambda>a. c * r a"]) (auto simp: * scale_sum_right)
qed

lemma subspace_span [iff]: "subspace (span S)"
  by (auto simp: subspace_def span_zero span_add span_scale)

lemma span_neg: "x \<in> span S \<Longrightarrow> - x \<in> span S"
  by (metis subspace_neg subspace_span)

lemma span_diff: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x - y \<in> span S"
  by (metis subspace_span subspace_diff)

lemma span_sum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> sum f A \<in> span S"
  by (rule subspace_sum, rule subspace_span)

lemma span_minimal: "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> span S \<subseteq> T"
  by (auto simp: span_explicit intro!: subspace_sum subspace_scale)

lemma span_def: "span S = subspace hull S"
  by (intro hull_unique[symmetric] span_superset subspace_span span_minimal)

lemma span_unique:
  "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> (\<And>T'. S \<subseteq> T' \<Longrightarrow> subspace T' \<Longrightarrow> T \<subseteq> T') \<Longrightarrow> span S = T"
  unfolding span_def by (rule hull_unique)

lemma span_subspace_induct[consumes 2]:
  assumes x: "x \<in> span S"
    and P: "subspace P"
    and SP: "\<And>x. x \<in> S \<Longrightarrow> x \<in> P"
  shows "x \<in> P"
proof -
  from SP have SP': "S \<subseteq> P"
    by (simp add: subset_eq)
  from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]]
  show "x \<in> P"
    by (metis subset_eq)
qed

lemma (in module) span_induct[consumes 1, case_names base step, induct set: span]:
  assumes x: "x \<in> span S"
    and P: "subspace (Collect P)"
    and SP: "\<And>x. x \<in> S \<Longrightarrow> P x"
  shows "P x"
  using P SP span_subspace_induct x by fastforce

lemma span_empty[simp]: "span {} = {0}"
  by (rule span_unique) (auto simp add: subspace_def)

lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<subseteq> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
  by (metis order_antisym span_def hull_minimal)

lemma span_span: "span (span A) = span A"
  unfolding span_def hull_hull ..

(* TODO: proof generally for subspace: *)
lemma span_add_eq: assumes x: "x \<in> span S" shows "x + y \<in> span S \<longleftrightarrow> y \<in> span S"
proof
  assume *: "x + y \<in> span S"
  have "(x + y) - x \<in> span S" using * x by (rule span_diff)
  then show "y \<in> span S" by simp
qed (intro span_add x)

lemma span_add_eq2: assumes y: "y \<in> span S" shows "x + y \<in> span S \<longleftrightarrow> x \<in> span S"
  using span_add_eq[of y S x] y by (auto simp: ac_simps)

lemma span_singleton: "span {x} = range (\<lambda>k. k *s x)"
  by (auto simp: span_finite)

lemma span_Un: "span (S \<union> T) = {x + y | x y. x \<in> span S \<and> y \<in> span T}"
proof safe
  fix x assume "x \<in> span (S \<union> T)"
  then obtain t r where t: "finite t" "t \<subseteq> S \<union> T" and x: "x = (\<Sum>a\<in>t. r a *s a)"
    by (auto simp: span_explicit)
  moreover have "t \<inter> S \<union> (t - S) = t" by auto
  ultimately show "\<exists>xa y. x = xa + y \<and> xa \<in> span S \<and> y \<in> span T"
    unfolding x
    apply (rule_tac exI[of _ "\<Sum>a\<in>t \<inter> S. r a *s a"])
    apply (rule_tac exI[of _ "\<Sum>a\<in>t - S. r a *s a"])
    apply (subst sum.union_inter_neutral[symmetric])
    apply (auto intro!: span_sum span_scale intro: span_base)
    done
next
  fix x y assume"x \<in> span S" "y \<in> span T" then show "x + y \<in> span (S \<union> T)"
    using span_mono[of S "S \<union> T"] span_mono[of T "S \<union> T"]
    by (auto intro!: span_add)
qed

lemma span_insert: "span (insert a S) = {x. \<exists>k. (x - k *s a) \<in> span S}"
proof -
  have "span ({a} \<union> S) = {x. \<exists>k. (x - k *s a) \<in> span S}"
    unfolding span_Un span_singleton
    apply (auto simp add: set_eq_iff)
    subgoal for y k by (auto intro!: exI[of _ "k"])
    subgoal for y k by (rule exI[of _ "k *s a"], rule exI[of _ "y - k *s a"]) auto
    done
  then show ?thesis by simp
qed

lemma span_breakdown:
  assumes bS: "b \<in> S"
    and aS: "a \<in> span S"
  shows "\<exists>k. a - k *s b \<in> span (S - {b})"
  using assms span_insert [of b "S - {b}"]
  by (simp add: insert_absorb)

lemma span_breakdown_eq: "x \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. x - k *s a \<in> span S)"
  by (simp add: span_insert)

lemmas span_clauses = span_base span_zero span_add span_scale

lemma span_eq_iff[simp]: "span s = s \<longleftrightarrow> subspace s"
  unfolding span_def by (rule hull_eq) (rule subspace_Inter)

lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
  by (metis span_minimal span_subspace span_superset subspace_span)

lemma eq_span_insert_eq:
  assumes "(x - y) \<in> span S"
    shows "span(insert x S) = span(insert y S)"
proof -
  have *: "span(insert x S) \<subseteq> span(insert y S)" if "(x - y) \<in> span S" for x y
  proof -
    have 1: "(r *s x - r *s y) \<in> span S" for r
      by (metis scale_right_diff_distrib span_scale that)
    have 2: "(z - k *s y) - k *s (x - y) = z - k *s x" for  z k
      by (simp add: scale_right_diff_distrib)
  show ?thesis
    apply (clarsimp simp add: span_breakdown_eq)
    by (metis 1 2 diff_add_cancel scale_right_diff_distrib span_add_eq)
  qed
  show ?thesis
    apply (intro subset_antisym * assms)
    using assms subspace_neg subspace_span minus_diff_eq by force
qed

section \<open>Dependent and independent sets\<close>

definition dependent :: "'b set \<Rightarrow> bool"
  where dependent_explicit: "dependent s \<longleftrightarrow> (\<exists>t u. finite t \<and> t \<subseteq> s \<and> (\<Sum>v\<in>t. u v *s v) = 0 \<and> (\<exists>v\<in>t. u v \<noteq> 0))"

abbreviation "independent s \<equiv> \<not> dependent s"

lemma dependent_mono: "dependent B \<Longrightarrow> B \<subseteq> A \<Longrightarrow> dependent A"
  by (auto simp add: dependent_explicit)

lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A \<Longrightarrow> independent B"
  by (auto intro: dependent_mono)

lemma dependent_zero: "0 \<in> A \<Longrightarrow> dependent A"
  by (auto simp: dependent_explicit intro!: exI[of _ "\<lambda>i. 1"] exI[of _ "{0}"])

lemma independent_empty[intro]: "independent {}"
  by (simp add: dependent_explicit)

lemma independent_explicit_module:
  "independent s \<longleftrightarrow> (\<forall>t u v. finite t \<longrightarrow> t \<subseteq> s \<longrightarrow> (\<Sum>v\<in>t. u v *s v) = 0 \<longrightarrow> v \<in> t \<longrightarrow> u v = 0)"
  unfolding dependent_explicit by auto

lemma independentD: "independent s \<Longrightarrow> finite t \<Longrightarrow> t \<subseteq> s \<Longrightarrow> (\<Sum>v\<in>t. u v *s v) = 0 \<Longrightarrow> v \<in> t \<Longrightarrow> u v = 0"
  by (simp add: independent_explicit_module)

lemma independent_Union_directed:
  assumes directed: "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
  assumes indep: "\<And>c. c \<in> C \<Longrightarrow> independent c"
  shows "independent (\<Union>C)"
proof
  assume "dependent (\<Union>C)"
  then obtain u v S where S: "finite S" "S \<subseteq> \<Union>C" "v \<in> S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *s v) = 0"
    by (auto simp: dependent_explicit)

  have "S \<noteq> {}"
    using \<open>v \<in> S\<close> by auto
  have "\<exists>c\<in>C. S \<subseteq> c"
    using \<open>finite S\<close> \<open>S \<noteq> {}\<close> \<open>S \<subseteq> \<Union>C\<close>
  proof (induction rule: finite_ne_induct)
    case (insert i I)
    then obtain c d where cd: "c \<in> C" "d \<in> C" and iI: "I \<subseteq> c" "i \<in> d"
      by blast
    from directed[OF cd] cd have "c \<union> d \<in> C"
      by (auto simp: sup.absorb1 sup.absorb2)
    with iI show ?case
      by (intro bexI[of _ "c \<union> d"]) auto
  qed auto
  then obtain c where "c \<in> C" "S \<subseteq> c"
    by auto
  have "dependent c"
    unfolding dependent_explicit
    by (intro exI[of _ S] exI[of _ u] bexI[of _ v] conjI) fact+
  with indep[OF \<open>c \<in> C\<close>] show False
    by auto
qed

lemma dependent_finite:
  assumes "finite S"
  shows "dependent S \<longleftrightarrow> (\<exists>u. (\<exists>v \<in> S. u v \<noteq> 0) \<and> (\<Sum>v\<in>S. u v *s v) = 0)"
    (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain T u v
    where "finite T" "T \<subseteq> S" "v\<in>T" "u v \<noteq> 0" "(\<Sum>v\<in>T. u v *s v) = 0"
    by (force simp: dependent_explicit)
  with assms show ?rhs
    apply (rule_tac x="\<lambda>v. if v \<in> T then u v else 0" in exI)
    apply (auto simp: sum.mono_neutral_right)
    done
next
  assume ?rhs  with assms show ?lhs
    by (fastforce simp add: dependent_explicit)
qed

lemma dependent_alt:
  "dependent B \<longleftrightarrow>
    (\<exists>X. finite {x. X x \<noteq> 0} \<and> {x. X x \<noteq> 0} \<subseteq> B \<and> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<and> (\<exists>x. X x \<noteq> 0))"
  unfolding dependent_explicit
  apply safe
  subgoal for S u v
    apply (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
    apply (subst sum.mono_neutral_cong_left[where T=S])
    apply (auto intro!: sum.mono_neutral_cong_right cong: rev_conj_cong)
    done
  apply auto
  done

lemma independent_alt:
  "independent B \<longleftrightarrow>
    (\<forall>X. finite {x. X x \<noteq> 0} \<longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<longrightarrow> (\<forall>x. X x = 0))"
  unfolding dependent_alt by auto

lemma independentD_alt:
  "independent B \<Longrightarrow> finite {x. X x \<noteq> 0} \<Longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<Longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<Longrightarrow> X x = 0"
  unfolding independent_alt by blast

lemma independentD_unique:
  assumes B: "independent B"
    and X: "finite {x. X x \<noteq> 0}" "{x. X x \<noteq> 0} \<subseteq> B"
    and Y: "finite {x. Y x \<noteq> 0}" "{x. Y x \<noteq> 0} \<subseteq> B"
    and "(\<Sum>x | X x \<noteq> 0. X x *s x) = (\<Sum>x| Y x \<noteq> 0. Y x *s x)"
  shows "X = Y"
proof -
  have "X x - Y x = 0" for x
    using B
  proof (rule independentD_alt)
    have "{x. X x - Y x \<noteq> 0} \<subseteq> {x. X x \<noteq> 0} \<union> {x. Y x \<noteq> 0}"
      by auto
    then show "finite {x. X x - Y x \<noteq> 0}" "{x. X x - Y x \<noteq> 0} \<subseteq> B"
      using X Y by (auto dest: finite_subset)
    then have "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *s x) = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. (X v - Y v) *s v)"
      using X Y by (intro sum.mono_neutral_cong_left) auto
    also have "\<dots> = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *s v) - (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *s v)"
      by (simp add: scale_left_diff_distrib sum_subtractf assms)
    also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *s v) = (\<Sum>v\<in>{S. X S \<noteq> 0}. X v *s v)"
      using X Y by (intro sum.mono_neutral_cong_right) auto
    also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *s v) = (\<Sum>v\<in>{S. Y S \<noteq> 0}. Y v *s v)"
      using X Y by (intro sum.mono_neutral_cong_right) auto
    finally show "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *s x) = 0"
      using assms by simp
  qed
  then show ?thesis
    by auto
qed

section \<open>Representation of a vector on a specific basis\<close>

definition representation :: "'b set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'a"
  where "representation basis v =
    (if independent basis \<and> v \<in> span basis then
      SOME f. (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> basis) \<and> finite {v. f v \<noteq> 0} \<and> (\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = v
    else (\<lambda>b. 0))"

lemma unique_representation:
  assumes basis: "independent basis"
    and in_basis: "\<And>v. f v \<noteq> 0 \<Longrightarrow> v \<in> basis" "\<And>v. g v \<noteq> 0 \<Longrightarrow> v \<in> basis"
    and [simp]: "finite {v. f v \<noteq> 0}" "finite {v. g v \<noteq> 0}"
    and eq: "(\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = (\<Sum>v\<in>{v. g v \<noteq> 0}. g v *s v)"
  shows "f = g"
proof (rule ext, rule ccontr)
  fix v assume ne: "f v \<noteq> g v"
  have "dependent basis"
    unfolding dependent_explicit
  proof (intro exI conjI)
    have *: "{v. f v - g v \<noteq> 0} \<subseteq> {v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}"
      by auto
    show "finite {v. f v - g v \<noteq> 0}"
      by (rule finite_subset[OF *]) simp
    show "\<exists>v\<in>{v. f v - g v \<noteq> 0}. f v - g v \<noteq> 0"
      by (rule bexI[of _ v]) (auto simp: ne)
    have "(\<Sum>v | f v - g v \<noteq> 0. (f v - g v) *s v) =
        (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. (f v - g v) *s v)"
      by (intro sum.mono_neutral_cong_left *) auto
    also have "... =
        (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. f v *s v) - (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. g v *s v)"
      by (simp add: algebra_simps sum_subtractf)
    also have "... = (\<Sum>v | f v \<noteq> 0. f v *s v) - (\<Sum>v | g v \<noteq> 0. g v *s v)"
      by (intro arg_cong2[where f= "(-)"] sum.mono_neutral_cong_right) auto
    finally show "(\<Sum>v | f v - g v \<noteq> 0. (f v - g v) *s v) = 0"
      by (simp add: eq)
    show "{v. f v - g v \<noteq> 0} \<subseteq> basis"
      using in_basis * by auto
  qed
  with basis show False by auto
qed

lemma
  shows representation_ne_zero: "\<And>b. representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis"
    and finite_representation: "finite {b. representation basis v b \<noteq> 0}"
    and sum_nonzero_representation_eq:
      "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b) = v"
proof -
  { assume basis: "independent basis" and v: "v \<in> span basis"
    define p where "p f \<longleftrightarrow>
      (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> basis) \<and> finite {v. f v \<noteq> 0} \<and> (\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = v" for f
    obtain t r where *: "finite t" "t \<subseteq> basis" "(\<Sum>b\<in>t. r b *s b) = v"
      using \<open>v \<in> span basis\<close> by (auto simp: span_explicit)
    define f where "f b = (if b \<in> t then r b else 0)" for b
    have "p f"
      using * by (auto simp: p_def f_def intro!: sum.mono_neutral_cong_left)
    have *: "representation basis v = Eps p" by (simp add: p_def[abs_def] representation_def basis v)
    from someI[of p f, OF \<open>p f\<close>] have "p (representation basis v)"
      unfolding * . }
  note * = this

  show "representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
    using * by (cases "independent basis \<and> v \<in> span basis") (auto simp: representation_def)

  show "finite {b. representation basis v b \<noteq> 0}"
    using * by (cases "independent basis \<and> v \<in> span basis") (auto simp: representation_def)

  show "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b) = v"
    using * by auto
qed

lemma sum_representation_eq:
  "(\<Sum>b\<in>B. representation basis v b *s b) = v"
  if "independent basis" "v \<in> span basis" "finite B" "basis \<subseteq> B"
proof -
  have "(\<Sum>b\<in>B. representation basis v b *s b) =
      (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b)"
    apply (rule sum.mono_neutral_cong)
        apply (rule finite_representation)
       apply fact
    subgoal for b
      using that representation_ne_zero[of basis v b]
      by auto
    subgoal by auto
    subgoal by simp
    done
  also have "\<dots> = v"
    by (rule sum_nonzero_representation_eq; fact)
  finally show ?thesis .
qed

lemma representation_eqI:
  assumes basis: "independent basis" and b: "v \<in> span basis"
    and ne_zero: "\<And>b. f b \<noteq> 0 \<Longrightarrow> b \<in> basis"
    and finite: "finite {b. f b \<noteq> 0}"
    and eq: "(\<Sum>b | f b \<noteq> 0. f b *s b) = v"
  shows "representation basis v = f"
  by (rule unique_representation[OF basis])
     (auto simp: representation_ne_zero finite_representation
       sum_nonzero_representation_eq[OF basis b] ne_zero finite eq)

lemma representation_basis:
  assumes basis: "independent basis" and b: "b \<in> basis"
  shows "representation basis b = (\<lambda>v. if v = b then 1 else 0)"
proof (rule unique_representation[OF basis])
  show "representation basis b v \<noteq> 0 \<Longrightarrow> v \<in> basis" for v
    using representation_ne_zero .
  show "finite {v. representation basis b v \<noteq> 0}"
    using finite_representation .
  show "(if v = b then 1 else 0) \<noteq> 0 \<Longrightarrow> v \<in> basis" for v
    by (cases "v = b") (auto simp: b)
  have *: "{v. (if v = b then 1 else 0 :: 'a) \<noteq> 0} = {b}"
    by auto
  show "finite {v. (if v = b then 1 else 0) \<noteq> 0}" unfolding * by auto
  show "(\<Sum>v | representation basis b v \<noteq> 0. representation basis b v *s v) =
    (\<Sum>v | (if v = b then 1 else 0::'a) \<noteq> 0. (if v = b then 1 else 0) *s v)"
    unfolding * sum_nonzero_representation_eq[OF basis span_base[OF b]] by auto
qed

lemma representation_zero: "representation basis 0 = (\<lambda>b. 0)"
proof cases
  assume basis: "independent basis" show ?thesis
    by (rule representation_eqI[OF basis span_zero]) auto
qed (simp add: representation_def)

lemma representation_diff:
  assumes basis: "independent basis" and v: "v \<in> span basis" and u: "u \<in> span basis"
  shows "representation basis (u - v) = (\<lambda>b. representation basis u b - representation basis v b)"
proof (rule representation_eqI[OF basis span_diff[OF u v]])
  let ?R = "representation basis"
  note finite_representation[simp] u[simp] v[simp]
  have *: "{b. ?R u b - ?R v b \<noteq> 0} \<subseteq> {b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}"
    by auto
  then show "?R u b - ?R v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
    by (auto dest: representation_ne_zero)
  show "finite {b. ?R u b - ?R v b \<noteq> 0}"
    by (intro finite_subset[OF *]) simp_all
  have "(\<Sum>b | ?R u b - ?R v b \<noteq> 0. (?R u b - ?R v b) *s b) =
      (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. (?R u b - ?R v b) *s b)"
    by (intro sum.mono_neutral_cong_left *) auto
  also have "... =
      (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. ?R u b *s b) - (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. ?R v b *s b)"
    by (simp add: algebra_simps sum_subtractf)
  also have "... = (\<Sum>b | ?R u b \<noteq> 0. ?R u b *s b) - (\<Sum>b | ?R v b \<noteq> 0. ?R v b *s b)"
    by (intro arg_cong2[where f= "(-)"] sum.mono_neutral_cong_right) auto
  finally show "(\<Sum>b | ?R u b - ?R v b \<noteq> 0. (?R u b - ?R v b) *s b) = u - v"
    by (simp add: sum_nonzero_representation_eq[OF basis])
qed

lemma representation_neg:
  "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> representation basis (- v) = (\<lambda>b. - representation basis v b)"
  using representation_diff[of basis v 0] by (simp add: representation_zero span_zero)

lemma representation_add:
  "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> u \<in> span basis \<Longrightarrow>
    representation basis (u + v) = (\<lambda>b. representation basis u b + representation basis v b)"
  using representation_diff[of basis "-v" u] by (simp add: representation_neg representation_diff span_neg)

lemma representation_sum:
  "independent basis \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> v i \<in> span basis) \<Longrightarrow>
    representation basis (sum v I) = (\<lambda>b. \<Sum>i\<in>I. representation basis (v i) b)"
  by (induction I rule: infinite_finite_induct)
     (auto simp: representation_zero representation_add span_sum)

lemma representation_scale:
  assumes basis: "independent basis" and v: "v \<in> span basis"
  shows "representation basis (r *s v) = (\<lambda>b. r * representation basis v b)"
proof (rule representation_eqI[OF basis span_scale[OF v]])
  let ?R = "representation basis"
  note finite_representation[simp] v[simp]
  have *: "{b. r * ?R v b \<noteq> 0} \<subseteq> {b. ?R v b \<noteq> 0}"
    by auto
  then show "r * representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
    using representation_ne_zero by auto
  show "finite {b. r * ?R v b \<noteq> 0}"
    by (intro finite_subset[OF *]) simp_all
  have "(\<Sum>b | r * ?R v b \<noteq> 0. (r * ?R v b) *s b) = (\<Sum>b\<in>{b. ?R v b \<noteq> 0}. (r * ?R v b) *s b)"
    by (intro sum.mono_neutral_cong_left *) auto
  also have "... = r *s (\<Sum>b | ?R v b \<noteq> 0. ?R v b *s b)"
    by (simp add: scale_scale[symmetric] scale_sum_right del: scale_scale)
  finally show "(\<Sum>b | r * ?R v b \<noteq> 0. (r * ?R v b) *s b) = r *s v"
    by (simp add: sum_nonzero_representation_eq[OF basis])
qed

lemma representation_extend:
  assumes basis: "independent basis" and v: "v \<in> span basis'" and basis': "basis' \<subseteq> basis"
  shows "representation basis v = representation basis' v"
proof (rule representation_eqI[OF basis])
  show v': "v \<in> span basis" using span_mono[OF basis'] v by auto
  have *: "independent basis'" using basis' basis by (auto intro: dependent_mono)
  show "representation basis' v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
    using representation_ne_zero basis' by auto
  show "finite {b. representation basis' v b \<noteq> 0}"
    using finite_representation .
  show "(\<Sum>b | representation basis' v b \<noteq> 0. representation basis' v b *s b) = v"
    using sum_nonzero_representation_eq[OF * v] .
qed

text \<open>The set \<open>B\<close> is the maximal independent set for \<open>span B\<close>, or \<open>A\<close> is the minimal spanning set\<close>
lemma spanning_subset_independent:
  assumes BA: "B \<subseteq> A"
    and iA: "independent A"
    and AsB: "A \<subseteq> span B"
  shows "A = B"
proof (intro antisym[OF _ BA] subsetI)
  have iB: "independent B" using independent_mono [OF iA BA] .
  fix v assume "v \<in> A"
  with AsB have "v \<in> span B" by auto
  let ?RB = "representation B v" and ?RA = "representation A v"
  have "?RB v = 1"
    unfolding representation_extend[OF iA \<open>v \<in> span B\<close> BA, symmetric] representation_basis[OF iA \<open>v \<in> A\<close>] by simp
  then show "v \<in> B"
    using representation_ne_zero[of B v v] by auto
qed

end

(* We need to introduce more specific modules, where the ring structure gets more and more finer,
  i.e. Bezout rings & domains, division rings, fields *)

text \<open>A linear function is a mapping between two modules over the same ring.\<close>

locale module_hom = m1: module s1 + m2: module s2
    for s1 :: "'a::comm_ring_1 \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*a" 75)
    and s2 :: "'a::comm_ring_1 \<Rightarrow> 'c::ab_group_add \<Rightarrow> 'c" (infixr "*b" 75) +
  fixes f :: "'b \<Rightarrow> 'c"
  assumes add: "f (b1 + b2) = f b1 + f b2"
    and scale: "f (r *a b) = r *b f b"
begin

lemma zero[simp]: "f 0 = 0"
  using scale[of 0 0] by simp

lemma neg: "f (- x) = - f x"
  using scale [where r="-1"] by (metis add add_eq_0_iff zero)

lemma diff: "f (x - y) = f x - f y"
  by (metis diff_conv_add_uminus add neg)

lemma sum: "f (sum g S) = (\<Sum>a\<in>S. f (g a))"
proof (induct S rule: infinite_finite_induct)
  case (insert x F)
  have "f (sum g (insert x F)) = f (g x + sum g F)"
    using insert.hyps by simp
  also have "\<dots> = f (g x) + f (sum g F)"
    using add by simp
  also have "\<dots> = (\<Sum>a\<in>insert x F. f (g a))"
    using insert.hyps by simp
  finally show ?case .
qed simp_all

lemma inj_on_iff_eq_0:
  assumes s: "m1.subspace s"
  shows "inj_on f s \<longleftrightarrow> (\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0)"
proof -
  have "inj_on f s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. f x - f y = 0 \<longrightarrow> x - y = 0)"
    by (simp add: inj_on_def)
  also have "\<dots> \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. f (x - y) = 0 \<longrightarrow> x - y = 0)"
    by (simp add: diff)
  also have "\<dots> \<longleftrightarrow> (\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0)" (is "?l = ?r")(* TODO: sledgehammer! *)
  proof safe
    fix x assume ?l assume "x \<in> s" "f x = 0" with \<open>?l\<close>[rule_format, of x 0] s show "x = 0"
      by (auto simp: m1.subspace_0)
  next
    fix x y assume ?r assume "x \<in> s" "y \<in> s" "f (x - y) = 0"
    with \<open>?r\<close>[rule_format, of "x - y"] s
    show "x - y = 0"
      by (auto simp: m1.subspace_diff)
  qed
  finally show ?thesis
    by auto
qed

lemma inj_iff_eq_0: "inj f = (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
  by (rule inj_on_iff_eq_0[OF m1.subspace_UNIV, unfolded ball_UNIV])

lemma subspace_image: assumes S: "m1.subspace S" shows "m2.subspace (f ` S)"
  unfolding m2.subspace_def
proof safe
  show "0 \<in> f ` S"
    by (rule image_eqI[of _ _ 0]) (auto simp: S m1.subspace_0)
  show "x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x + f y \<in> f ` S" for x y
    by (rule image_eqI[of _ _ "x + y"]) (auto simp: S m1.subspace_add add)
  show "x \<in> S \<Longrightarrow> r *b f x \<in> f ` S" for r x
    by (rule image_eqI[of _ _ "r *a x"]) (auto simp: S m1.subspace_scale scale)
qed

lemma subspace_vimage: "m2.subspace S \<Longrightarrow> m1.subspace (f -` S)"
  by (simp add: vimage_def add scale m1.subspace_def m2.subspace_0 m2.subspace_add m2.subspace_scale)

lemma subspace_kernel: "m1.subspace {x. f x = 0}"
  using subspace_vimage[OF m2.subspace_single_0] by (simp add: vimage_def)

lemma span_image: "m2.span (f ` S) = f ` (m1.span S)"
proof (rule m2.span_unique)
  show "f ` S \<subseteq> f ` m1.span S"
    by (rule image_mono, rule m1.span_superset)
  show "m2.subspace (f ` m1.span S)"
    using m1.subspace_span by (rule subspace_image)
next
  fix T assume "f ` S \<subseteq> T" and "m2.subspace T" then show "f ` m1.span S \<subseteq> T"
    unfolding image_subset_iff_subset_vimage by (metis subspace_vimage m1.span_minimal)
qed

lemma dependent_inj_imageD:
  assumes d: "m2.dependent (f ` s)" and i: "inj_on f (m1.span s)"
  shows "m1.dependent s"
proof -
  have [intro]: "inj_on f s"
    using \<open>inj_on f (m1.span s)\<close> m1.span_superset by (rule inj_on_subset)
  from d obtain s' r v where *: "finite s'" "s' \<subseteq> s" "(\<Sum>v\<in>f ` s'. r v *b v) = 0" "v \<in> s'" "r (f v) \<noteq> 0"
    by (auto simp: m2.dependent_explicit subset_image_iff dest!: finite_imageD intro: inj_on_subset)
  have "f (\<Sum>v\<in>s'. r (f v) *a v) = (\<Sum>v\<in>s'. r (f v) *b f v)"
    by (simp add: sum scale)
  also have "... = (\<Sum>v\<in>f ` s'. r v *b v)"
    using \<open>s' \<subseteq> s\<close> by (subst sum.reindex) (auto dest!: finite_imageD intro: inj_on_subset)
  finally have "f (\<Sum>v\<in>s'. r (f v) *a v) = 0"
    by (simp add: *)
  with \<open>s' \<subseteq> s\<close> have "(\<Sum>v\<in>s'. r (f v) *a v) = 0"
    by (intro inj_onD[OF i] m1.span_zero m1.span_sum m1.span_scale) (auto intro: m1.span_base)
  then show "m1.dependent s"
    using \<open>finite s'\<close> \<open>s' \<subseteq> s\<close> \<open>v \<in> s'\<close> \<open>r (f v) \<noteq> 0\<close> by (force simp add: m1.dependent_explicit)
qed

lemma eq_0_on_span:
  assumes f0: "\<And>x. x \<in> b \<Longrightarrow> f x = 0" and x: "x \<in> m1.span b" shows "f x = 0"
  using m1.span_induct[OF x subspace_kernel] f0 by simp

lemma independent_injective_image: "m1.independent s \<Longrightarrow> inj_on f (m1.span s) \<Longrightarrow> m2.independent (f ` s)"
  using dependent_inj_imageD[of s] by auto

lemma inj_on_span_independent_image:
  assumes ifB: "m2.independent (f ` B)" and f: "inj_on f B" shows "inj_on f (m1.span B)"
  unfolding inj_on_iff_eq_0[OF m1.subspace_span] unfolding m1.span_explicit'
proof safe
  fix r assume fr: "finite {v. r v \<noteq> 0}" and r: "\<forall>v. r v \<noteq> 0 \<longrightarrow> v \<in> B"
    and eq0: "f (\<Sum>v | r v \<noteq> 0. r v *a v) = 0"
  have "0 = (\<Sum>v | r v \<noteq> 0. r v *b f v)"
    using eq0 by (simp add: sum scale)
  also have "... = (\<Sum>v\<in>f ` {v. r v \<noteq> 0}. r (the_inv_into B f v) *b v)"
    using r by (subst sum.reindex) (auto simp: the_inv_into_f_f[OF f] intro!: inj_on_subset[OF f] sum.cong)
  finally have "r v \<noteq> 0 \<Longrightarrow> r (the_inv_into B f (f v)) = 0" for v
    using fr r ifB[unfolded m2.independent_explicit_module, rule_format,
        of "f ` {v. r v \<noteq> 0}" "\<lambda>v. r (the_inv_into B f v)"]
    by auto
  then have "r v = 0" for v
    using the_inv_into_f_f[OF f] r by auto
  then show "(\<Sum>v | r v \<noteq> 0. r v *a v) = 0" by auto
qed

lemma inj_on_span_iff_independent_image: "m2.independent (f ` B) \<Longrightarrow> inj_on f (m1.span B) \<longleftrightarrow> inj_on f B"
  using inj_on_span_independent_image[of B] inj_on_subset[OF _ m1.span_superset, of f B] by auto

lemma subspace_linear_preimage: "m2.subspace S \<Longrightarrow> m1.subspace {x. f x \<in> S}"
  by (simp add: add scale m1.subspace_def m2.subspace_def)

lemma spans_image: "V \<subseteq> m1.span B \<Longrightarrow> f ` V \<subseteq> m2.span (f ` B)"
  by (metis image_mono span_image)

text \<open>Relation between bases and injectivity/surjectivity of map.\<close>

lemma spanning_surjective_image:
  assumes us: "UNIV \<subseteq> m1.span S"
    and sf: "surj f"
  shows "UNIV \<subseteq> m2.span (f ` S)"
proof -
  have "UNIV \<subseteq> f ` UNIV"
    using sf by (auto simp add: surj_def)
  also have " \<dots> \<subseteq> m2.span (f ` S)"
    using spans_image[OF us] .
  finally show ?thesis .
qed

lemmas independent_inj_on_image = independent_injective_image

lemma independent_inj_image:
  "m1.independent S \<Longrightarrow> inj f \<Longrightarrow> m2.independent (f ` S)"
  using independent_inj_on_image[of S] by (auto simp: subset_inj_on)

end

lemma module_hom_iff:
  "module_hom s1 s2  f \<longleftrightarrow>
    module s1 \<and> module s2 \<and>
    (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (s1 c x) = s2 c (f x))"
  by (simp add: module_hom_def module_hom_axioms_def)

locale module_pair = m1: module s1 + m2: module s2
  for s1 :: "'a :: comm_ring_1 \<Rightarrow> 'b \<Rightarrow> 'b :: ab_group_add"
  and s2 :: "'a :: comm_ring_1 \<Rightarrow> 'c \<Rightarrow> 'c :: ab_group_add"
begin

lemma module_hom_zero: "module_hom s1 s2 (\<lambda>x. 0)"
  by (simp add: module_hom_iff m1.module_axioms m2.module_axioms)

lemma module_hom_add: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 g \<Longrightarrow> module_hom s1 s2 (\<lambda>x. f x + g x)"
  by (simp add: module_hom_iff module.scale_right_distrib)

lemma module_hom_sub: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 g \<Longrightarrow> module_hom s1 s2 (\<lambda>x. f x - g x)"
  by (simp add: module_hom_iff module.scale_right_diff_distrib)

lemma module_hom_neg: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 (\<lambda>x. - f x)"
  by (simp add: module_hom_iff module.scale_minus_right)

lemma module_hom_scale: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 (\<lambda>x. s2 c (f x))"
  by (simp add: module_hom_iff module.scale_scale module.scale_right_distrib ac_simps)

lemma module_hom_compose_scale:
  "module_hom s1 s2 (\<lambda>x. s2 (f x) (c))"
  if "module_hom s1 (*) f"
proof -
  interpret mh: module_hom s1 "(*)" f by fact
  show ?thesis
    by unfold_locales (simp_all add: mh.add mh.scale m2.scale_left_distrib)
qed

lemma bij_module_hom_imp_inv_module_hom: "module_hom scale1 scale2 f \<Longrightarrow> bij f \<Longrightarrow>
  module_hom scale2 scale1 (inv f)"
  by (auto simp: module_hom_iff bij_is_surj bij_is_inj surj_f_inv_f
      intro!: Hilbert_Choice.inv_f_eq)

lemma module_hom_sum: "(\<And>i. i \<in> I \<Longrightarrow> module_hom s1 s2 (f i)) \<Longrightarrow> (I = {} \<Longrightarrow> module s1 \<and> module s2) \<Longrightarrow> module_hom s1 s2 (\<lambda>x. \<Sum>i\<in>I. f i x)"
  apply (induction I rule: infinite_finite_induct)
  apply (auto intro!: module_hom_zero module_hom_add)
  using m1.module_axioms m2.module_axioms by blast

lemma module_hom_eq_on_span: "f x = g x"
  if "module_hom s1 s2 f" "module_hom s1 s2 g"
  and "(\<And>x. x \<in> B \<Longrightarrow> f x = g x)" "x \<in> m1.span B"
proof -
  interpret module_hom s1 s2 "\<lambda>x. f x - g x"
    by (rule module_hom_sub that)+
  from eq_0_on_span[OF _ that(4)] that(3) show ?thesis by auto
qed

end

context module begin

lemma module_hom_scale_self[simp]:
  "module_hom scale scale (\<lambda>x. scale c x)"
  using module_axioms module_hom_iff scale_left_commute scale_right_distrib by blast

lemma module_hom_scale_left[simp]:
  "module_hom (*) scale (\<lambda>r. scale r x)"
  by unfold_locales (auto simp: algebra_simps)

lemma module_hom_id: "module_hom scale scale id"
  by (simp add: module_hom_iff module_axioms)

lemma module_hom_ident: "module_hom scale scale (\<lambda>x. x)"
  by (simp add: module_hom_iff module_axioms)

lemma module_hom_uminus: "module_hom scale scale uminus"
  by (simp add: module_hom_iff module_axioms)

end

lemma module_hom_compose: "module_hom s1 s2 f \<Longrightarrow> module_hom s2 s3 g \<Longrightarrow> module_hom s1 s3 (g o f)"
  by (auto simp: module_hom_iff)

end


(* Topological Spaces
   Based on "A Bridge to Advanced Mathematics" by Dennis Sentilles
   Translated to Isar by Michal J Wallace *)
theory TopSpace
  imports Main
begin

section \<open>axioms\<close>

text \<open>A topological space (X,T) is a pair where X is a set whose elements
are called the "points" of the topological space, and T is a fixed collection of
subsets of X called neighborhoods, with the following properties:\<close>

locale topspace =
    fixes X :: "'a set"
    fixes T :: "('a set) set"
    assumes A1 [simp]: "x\<in>X \<equiv> \<exists>N\<in>T. x\<in>N"
    assumes A2 [simp]: "U\<in>T \<and> V\<in>T \<and> x\<in>(U\<inter>V) \<Longrightarrow> \<exists>N\<in>T. x\<in>N \<and> N\<subseteq>(U\<inter>V)"
begin

section \<open>limits, boundaries, and open and closed sets\<close>

  text \<open>A set N\<in>T which contains p\<in>X is called a neighborhood of p.\<close>

  definition nhs :: "'a \<Rightarrow> ('a set) set"
    where [simp]: "nhs p \<equiv> {N\<in>T. p\<in>N}"

  text \<open>If \<open>A\<subseteq>X\<close> in topological space \<open>(X,T)\<close>, then \<open>p\<in>X\<close> is called a \<^bold>\<open>limit point\<close>
    of \<open>A\<close> if the intersection of every neighborhood of \<open>p\<close> with \<open>A\<close> is non-empty.
    In loose geometrical terms, \<open>p\<close> is either a point in \<open>A\<close> or as close as possible
    to \<open>A\<close> without actually being in it.\<close>

  definition limpt :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" (* def 4.2.1 *)
    where [simp]: "limpt A p \<equiv> A\<subseteq>X \<and> p\<in>X \<and> (\<forall>N\<in>nhs p. (A\<inter>N) \<noteq> {})"

  text \<open>If \<open>A\<subset>X\<close> in topological space \<open>(X,T)\<close>, then \<open>x\<in>X\<close> is called an \<^bold>\<open>interior point\<close>
    of \<open>A\<close> if at least one neighborhood of \<open>x\<close> is contained entirely within \<open>A\<close>.\<close>

  definition intpt :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" (* def 4.2.2 *)
    where [simp]: "intpt A p \<equiv> A\<subseteq>X \<and> p\<in>A \<and> (\<exists>N\<in>nhs p. N\<subseteq>A)"

  definition boundpt :: "'a set \<Rightarrow> 'a \<Rightarrow> bool" (* def 4.2.3 *)
    where "boundpt A p \<equiv> (limpt A p) \<and> (limpt (X-A) p)"

  definition "open" :: "'a set \<Rightarrow> bool" (* def 4.2.4a *)
    where "open A \<equiv> (\<forall>p\<in>A. intpt A p)"

  definition closed :: "'a set \<Rightarrow> bool" (* def 4.2.4b *)
    where [simp, intro]: "closed A \<longleftrightarrow> open (X-A)"

  text \<open>THEOREM 4.2.5: A set \<open>A\<in>X\<close> in a topological space "\<open>(X,T)\<close> is closed
        iff every limit point of \<open>A\<close> belongs to \<open>A\<close>. Hence, if \<open>\<exists>\<close> a limit point
        of \<open>A\<close> not in \<open>A\<close>, then \<open>A\<close> is not closed. Conversely, if \<open>A\<close> is not
        closed, then  \<open>\<exists>\<close> a limit point of \<open>A\<close> not in \<open>A\<close>.\<close>

  theorem t425a: assumes "closed A" and "limpt A p" shows "p \<in> A"
    proof (rule ccontr)
      assume "p\<notin>A"
      with `limpt A p` have "p\<in>(X-A)" by simp
      moreover from `closed A` have "open (X-A)" by simp
      ultimately have "intpt (X-A) p" using open_def by blast
      \<comment> \<open>that is, there's a neighborhood, \<open>N\<in>T\<close> of p such that \<open>N\<subseteq>(X-A)\<close> \<close>
      with A2 `p\<in>(X-A)` obtain N where "p\<in>N" and "N\<in>T" and "N\<subseteq>(X-A)" by auto
      then have "N\<inter>A={}" by auto   \<comment> \<open>which contradicts the definition of a limit point.\<close>
      moreover have "N\<inter>A\<noteq>{}" using `limpt A p` `p\<in>N` `N\<in>T` limpt_def by auto
      ultimately show "False" by simp
    qed

    text \<open>To prove the converse in Isar, I needed to make use of the following lemma,
  which says that if some \<open>x\<in>X\<close> is not a limit point of \<open>A\<subseteq>X\<close> then there must be some
  neighborhood \<open>N\<close> of \<open>x\<close> that does not intersect \<open>A\<close> at all.\<close>
  lemma non_limpt_nh:
    assumes "A\<subseteq>X" "x\<in>X" and "\<not>(limpt A x)"
    obtains N where "N\<in>nhs x" and "N\<inter>A={}"
  proof -
    \<comment> "Start with the (negated) definition of \<open>limpt A x\<close>"
    from limpt_def have "\<not>(limpt A x) \<equiv> \<not>(A\<subseteq>X \<and> x\<in>X \<and> (\<forall>N\<in>nhs x. (A\<inter>N) \<noteq> {}))" by simp
    \<comment> "Distributing \<not> over \<and> gives us three possibilities \<dots>"
    also have "\<dots> \<equiv> \<not>(A\<subseteq>X) \<or> (x\<notin>X) \<or> (\<exists>N\<in>nhs x. A\<inter>N={})" by simp
    \<comment> "\<dots> But our assumptions rule out the first two."
    finally have "\<dots> \<equiv> \<exists>N\<in>nhs x. A\<inter>N = {}" using assms by auto
    with `\<not>(limpt A x)` obtain N where "N\<in>nhs x" and "N\<inter>A={}" by auto
    then show ?thesis using that by auto
  qed

  text \<open>Now we can prove the second part of theorem 4.2.5: if \<open>A\<close> contains all its limit
        points, then A is closed.\<close>
  theorem t425b: assumes a0: "A\<subseteq>X" and a1: "\<forall>p. limpt A p \<longrightarrow> p\<in>A" shows "closed A"
    \<comment> \<open>Quoting Sentilles here (replacing his syntax with isar's and using my variable names:\<close>
    \<comment> \<open>"To show \<open>A\<close> is closed, we must argue that \<open>X-A\<close> is open."\<close>
    \<comment> \<open>"That is, that any point of \<open>X-A\<close> is an interior point of \<open>X-A\<close>."\<close>
       \<comment> \<open>"Suppose \<open>x\<in>X-A\<close>. Then \<open>x\<notin>A\<close>."\<close>
       \<comment> \<open>"Since \<open>A\<close> contains all its limit points, then \<open>x\<close> is not a limit point of \<open>A\<close>."\<close>
       \<comment> \<open>"By [\<open>limpt_def\<close>] this means there is a neighborhood \<open>N\<in>T\<close> of \<open>x\<close>
            whose intersection with \<open>A\<close> is empty. In other words, \<open>N\<subseteq>(X-A)\<close>."\<close>
       \<comment> \<open>"But this means \<open>X-A\<close> is open by [\<open>open_def\<close>]."\<close>
       \<comment> \<open>"This is what we wished to prove."\<close>
    proof -
      have "\<forall>x\<in>(X-A). intpt (X-A) x" proof
        fix x assume "x\<in>(X-A)" hence "x\<notin>A" by auto
        have  "\<not>(limpt A x)" using a1 \<open>x\<notin>A\<close> by auto
        with `x \<in> X-A` obtain N where "N\<in>nhs x" and "N\<inter>A={}" using a0 non_limpt_nh by blast
        hence "N\<subseteq>X-A" by auto
        with `N\<in>nhs x` show "intpt (X-A) x" by auto
      qed
      hence "open (X-A)" using open_def by simp
      thus "closed A" by simp
    qed

  text \<open>\<^bold>\<open>COROLLARY 4.2.6\<close>
      A subset \<open>A\<subseteq>X\<close> of a topological space \<open>(X,T)\<close> is closed if \<open>A\<close> contains its boundary.\<close>

  text \<open>
    The last theorem shows that if \<open>A\<subseteq>X\<close> contains all its limit points, then it's closed.
    Can we show that if \<open>A\<close> contains all its boundary points, it must contain all
    its limit points?

    First, many of the limit points are interior points, right? From intpt_def,
    it seems like all interior points are limit points... right?
\<close>

  lemma int_lim:
    assumes "A\<subseteq>X" "intpt A p" shows "limpt A p"
    using assms ball_empty intpt_def by auto

  text \<open>
    It seems so. (We won't actually need that lemma, so I'll just trust the proof.
    Isabelle generated when i typed the word 'try' after the `shows` clause.)

    Anyway, back to the question of whether \<open>A\<close> containing its boundary implies
    that it contains all its limit points.

    Assume \<open>A\<subseteq>X\<close> contains its boundary points, and let \<open>p\<close> be a limit point of \<open>A\<close>
       If \<open>p\<close> is an interior point, then \<open>p\<in>A\<close>.
       else if it's a boundary point, then \<open>p\<in>A\<close> by assumption.
       else ... well, what would that even mean?

    The final case would be a limit point that is neither an interior point
    nor a boundary point. It's hard for me to imagine such a thing, so maybe no
    such thing exists.

    If it doesn't exist, then we've covered all our bases, and the corollary
    can be proven just by formalizing the argument above.

    So... let's try to show that if \<open>limpt A p \<Longrightarrow> (intpt A p) \<or> (boundpt A p)\<close>.
    We know all boundary points are limit points by definition, and all interior
    points are limit points from the lemma above, so really we only need to show
    that a limit point that isn't one of those two things must be the other.

    Here's the proof I came up with:
\<close>

  lemma bnd_ext_lim: assumes "A\<subseteq>X" "limpt A p" "~intpt A p" shows "boundpt A p"
  proof -
    from `limpt A p` have "p\<in>X" by simp
    moreover have "\<forall>N\<in>nhs p. (X-A)\<inter>N\<noteq>{}"
      proof
        fix N assume "N\<in>nhs p"
        from `\<not>intpt A p` `A\<subseteq>X` have "p\<notin>A \<or> \<not>(\<exists>N\<in>nhs p. N\<subseteq>A)" by auto
        then consider "p\<in>(X-A)" | "(\<forall>N\<in>nhs p. \<not>N\<subseteq>A)" by auto
        thus"(X-A)\<inter>N\<noteq>{}" proof (cases)
          case 1 then show ?thesis using \<open>N \<in> nhs p\<close> by fastforce
        next
          case 2 then have "\<not>N\<subseteq>A" using \<open>N \<in> nhs p\<close> by blast
          thus ?thesis using \<open>N \<in> nhs p\<close> by fastforce
        qed
     qed
     moreover from `A\<subseteq>X` have "(X-A) \<subseteq>X" by auto
     ultimately have "limpt (X-A) p" by simp
     thus "boundpt A p" using `limpt A p` boundpt_def by blast
   qed

  text \<open>I'll let Isabelle prove to itself that the two cases are mutually exclusive:\<close>
  lemma lim_bnd_xor_int: assumes "limpt A p" shows "(boundpt A p) \<noteq> (intpt A p)"
    using assms bnd_ext_lim boundpt_def by auto

  text \<open>Now we can show what we really wanted to show:\<close>

  corollary c426:  (* cor 4.2.6 *)
    assumes ax: "A\<subseteq>X"
        and ap: "\<forall>p. boundpt A p \<longrightarrow> p\<in>A"
    shows "closed A"
    proof -
      have "\<And>p. limpt A p \<longrightarrow> p\<in>A" proof
        fix p assume "limpt A p"
        consider (0) "boundpt A p"
               | (1) "intpt A p"
          using \<open>limpt A p\<close> lim_bnd_xor_int by auto
        then show "p\<in>A" using ap intpt_def by auto
      qed
      thus "closed A" using ax t425b by simp
    qed

  text \<open>\<^bold>\<open>COROLLARY 4.2.7\<close>
     In any topological space \<open>(X,T)\<close>, both \<open>X\<close> and \<open>{}\<close> are closed sets,
     and both are empty sets.\<close>

    \<comment> "The first two statements can be proved directly from the definition of 'open':"
    corollary open_empty: "open {}"      using open_def by auto
    corollary open_univ: "open X"        using open_def by fastforce
    \<comment> "Once we have those two, the others two are obvious:"
    corollary closed_univ: "closed X"    using open_empty by simp
    corollary closed_empty: "closed {}"  using open_univ by simp

section \<open>The closure of a set\<close>

definition closure :: "'a set \<Rightarrow> 'a set" (* def 4.3.1 *)
  where "closure A \<equiv> {x. limpt A x}"

text \<open>Theorem 4.3.2: For any set \<open>A\<close> in topological space \<open>X\<close>, \<open>closure A\<close> is closed.
Furthermore, one always has \<open>A \<subseteq> closure A\<close>\<close>

theorem t432: assumes "A\<subseteq>X" shows "closed (closure A)" sorry

corollary c433: assumes "A\<subseteq>X" and "closed A" shows "A = closure A" sorry

corollary c434: assumes "closed B" "A\<subseteq>B" shows "(closure A) \<subseteq> B" sorry

section "Topology and Set Theory"

theorem t441a: assumes "open S0" "open S1" shows "open (S0 \<inter> S1)" sorry
theorem t441b: assumes "closed S0" "closed S1" shows "closed (S0 \<union> S1)" sorry
text \<open>theorem t441c: the union of any collection of open sets is open\<close>
text \<open>theorem t441d: the intersection of any collection of closed sets is closed\<close>

text \<open>theorem 442: if A and B are subsets of a topspace (X,T) then
  1. closure(A\<union>B) = (closure A) \<union> (closure B)
  2. closure(A\<inter>B) = (closure A) \<inter> (closure B)\<close>

text \<open>theorem 443. If \<open>A\<noteq>{}\<close> is a bounded set of real numbers in \<R>, and \<R> is given the usual
topology, then \<open>sup A\<in> closure A\<close>. Hence, if \<open>A\<close> is closed, then \<open>sup A\<in>A\<close>\<close>

section \<open>4.5 connectedness in a topological space\<close>

section \<open>4.6 the general theory of connected sets\<close>

end (* locale topspace *)

end (* theory TopSpace *)


(*  Title:      HOL/Library/Poly_Deriv.thy
    Author:     Amine Chaieb
    Author:     Brian Huffman
*)

section{* Polynomials and Differentiation *}

theory Poly_Deriv
imports Deriv Polynomial
begin

subsection {* Derivatives of univariate polynomials *}

function pderiv :: "'a::real_normed_field poly \<Rightarrow> 'a poly"
where
  [simp del]: "pderiv (pCons a p) = (if p = 0 then 0 else p + pCons 0 (pderiv p))"
  by (auto intro: pCons_cases)

termination pderiv
  by (relation "measure degree") simp_all

lemma pderiv_0 [simp]:
  "pderiv 0 = 0"
  using pderiv.simps [of 0 0] by simp

lemma pderiv_pCons:
  "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
  by (simp add: pderiv.simps)

lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
  by (induct p arbitrary: n)
     (auto simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)

primrec pderiv_coeffs :: "'a::comm_monoid_add list \<Rightarrow> 'a list"
where
  "pderiv_coeffs [] = []"
| "pderiv_coeffs (x # xs) = plus_coeffs xs (cCons 0 (pderiv_coeffs xs))"

lemma coeffs_pderiv [code abstract]:
  "coeffs (pderiv p) = pderiv_coeffs (coeffs p)"
  by (rule sym, induct p) (simp_all add: pderiv_pCons coeffs_plus_eq_plus_coeffs cCons_def)

lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
  apply (rule iffI)
  apply (cases p, simp)
  apply (simp add: poly_eq_iff coeff_pderiv del: of_nat_Suc)
  apply (simp add: poly_eq_iff coeff_pderiv coeff_eq_0)
  done

lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
  apply (rule order_antisym [OF degree_le])
  apply (simp add: coeff_pderiv coeff_eq_0)
  apply (cases "degree p", simp)
  apply (rule le_degree)
  apply (simp add: coeff_pderiv del: of_nat_Suc)
  apply (metis degree_0 leading_coeff_0_iff nat.distinct(1))
  done

lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
by (simp add: pderiv_pCons)

lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
by (rule poly_eqI, simp add: coeff_pderiv algebra_simps)

lemma pderiv_minus: "pderiv (- p) = - pderiv p"
by (rule poly_eqI, simp add: coeff_pderiv)

lemma pderiv_diff: "pderiv (p - q) = pderiv p - pderiv q"
by (rule poly_eqI, simp add: coeff_pderiv algebra_simps)

lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
by (rule poly_eqI, simp add: coeff_pderiv algebra_simps)

lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
by (induct p) (auto simp: pderiv_add pderiv_smult pderiv_pCons algebra_simps)

lemma pderiv_power_Suc:
  "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
apply (induct n)
apply simp
apply (subst power_Suc)
apply (subst pderiv_mult)
apply (erule ssubst)
apply (simp only: of_nat_Suc smult_add_left smult_1_left)
apply (simp add: algebra_simps)
done

lemma DERIV_pow2: "DERIV (%x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
by (rule DERIV_cong, rule DERIV_pow, simp)
declare DERIV_pow2 [simp] DERIV_pow [simp]

lemma DERIV_add_const: "DERIV f x :> D ==>  DERIV (%x. a + f x :: 'a::real_normed_field) x :> D"
by (rule DERIV_cong, rule DERIV_add, auto)

lemma poly_DERIV[simp]: "DERIV (%x. poly p x) x :> poly (pderiv p) x"
  by (induct p, auto intro!: derivative_eq_intros simp add: pderiv_pCons)

text{* Consequences of the derivative theorem above*}

lemma poly_differentiable[simp]: "(%x. poly p x) differentiable (at x::real filter)"
apply (simp add: real_differentiable_def)
apply (blast intro: poly_DERIV)
done

lemma poly_isCont[simp]: "isCont (%x. poly p x) (x::real)"
by (rule poly_DERIV [THEN DERIV_isCont])

lemma poly_IVT_pos: "[| a < b; poly p (a::real) < 0; 0 < poly p b |]
      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
using IVT_objl [of "poly p" a 0 b]
by (auto simp add: order_le_less)

lemma poly_IVT_neg: "[| (a::real) < b; 0 < poly p a; poly p b < 0 |]
      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
by (insert poly_IVT_pos [where p = "- p" ]) simp

lemma poly_MVT: "(a::real) < b ==>
     \<exists>x. a < x & x < b & (poly p b - poly p a = (b - a) * poly (pderiv p) x)"
using MVT [of a b "poly p"]
apply auto
apply (rule_tac x = z in exI)
apply (auto simp add: mult_left_cancel poly_DERIV [THEN DERIV_unique])
done

text{*Lemmas for Derivatives*}

lemma order_unique_lemma:
  fixes p :: "'a::idom poly"
  assumes "[:-a, 1:] ^ n dvd p" "\<not> [:-a, 1:] ^ Suc n dvd p"
  shows "n = order a p"
unfolding Polynomial.order_def
apply (rule Least_equality [symmetric])
apply (fact assms)
apply (rule classical)
apply (erule notE)
unfolding not_less_eq_eq
using assms(1) apply (rule power_le_dvd)
apply assumption
done

lemma lemma_order_pderiv1:
  "pderiv ([:- a, 1:] ^ Suc n * q) = [:- a, 1:] ^ Suc n * pderiv q +
    smult (of_nat (Suc n)) (q * [:- a, 1:] ^ n)"
apply (simp only: pderiv_mult pderiv_power_Suc)
apply (simp del: power_Suc of_nat_Suc add: pderiv_pCons)
done

lemma dvd_add_cancel1:
  fixes a b c :: "'a::comm_ring_1"
  shows "a dvd b + c \<Longrightarrow> a dvd b \<Longrightarrow> a dvd c"
  by (drule (1) Rings.dvd_diff, simp)

lemma lemma_order_pderiv:
  assumes n: "0 < n"
      and pd: "pderiv p \<noteq> 0"
      and pe: "p = [:- a, 1:] ^ n * q"
      and nd: "~ [:- a, 1:] dvd q"
    shows "n = Suc (order a (pderiv p))"
using n
proof -
  have "pderiv ([:- a, 1:] ^ n * q) \<noteq> 0"
    using assms by auto
  obtain n' where "n = Suc n'" "0 < Suc n'" "pderiv ([:- a, 1:] ^ Suc n' * q) \<noteq> 0"
    using assms by (cases n) auto
  then have *: "!!k l. k dvd k * pderiv q + smult (of_nat (Suc n')) l \<Longrightarrow> k dvd l"
    by (metis dvd_add_cancel1 dvd_smult_iff dvd_triv_left of_nat_eq_0_iff old.nat.distinct(2))
  have "n' = order a (pderiv ([:- a, 1:] ^ Suc n' * q))"
  proof (rule order_unique_lemma)
    show "[:- a, 1:] ^ n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
      apply (subst lemma_order_pderiv1)
      apply (rule dvd_add)
      apply (metis dvdI dvd_mult2 power_Suc2)
      apply (metis dvd_smult dvd_triv_right)
      done
  next
    show "\<not> [:- a, 1:] ^ Suc n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
     apply (subst lemma_order_pderiv1)
     by (metis * nd dvd_mult_cancel_right field_power_not_zero pCons_eq_0_iff power_Suc zero_neq_one)
  qed
  then show ?thesis
    by (metis `n = Suc n'` pe)
qed

lemma order_decomp:
     "p \<noteq> 0
      ==> \<exists>q. p = [:-a, 1:] ^ (order a p) * q &
                ~([:-a, 1:] dvd q)"
apply (drule order [where a=a])
by (metis dvdE dvd_mult_cancel_left power_Suc2)

lemma order_pderiv: "[| pderiv p \<noteq> 0; order a p \<noteq> 0 |]
      ==> (order a p = Suc (order a (pderiv p)))"
apply (case_tac "p = 0", simp)
apply (drule_tac a = a and p = p in order_decomp)
using neq0_conv
apply (blast intro: lemma_order_pderiv)
done

lemma order_mult: "p * q \<noteq> 0 \<Longrightarrow> order a (p * q) = order a p + order a q"
proof -
  def i \<equiv> "order a p"
  def j \<equiv> "order a q"
  def t \<equiv> "[:-a, 1:]"
  have t_dvd_iff: "\<And>u. t dvd u \<longleftrightarrow> poly u a = 0"
    unfolding t_def by (simp add: dvd_iff_poly_eq_0)
  assume "p * q \<noteq> 0"
  then show "order a (p * q) = i + j"
    apply clarsimp
    apply (drule order [where a=a and p=p, folded i_def t_def])
    apply (drule order [where a=a and p=q, folded j_def t_def])
    apply clarify
    apply (erule dvdE)+
    apply (rule order_unique_lemma [symmetric], fold t_def)
    apply (simp_all add: power_add t_dvd_iff)
    done
qed

text{*Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *}

lemma order_divides: "[:-a, 1:] ^ n dvd p \<longleftrightarrow> p = 0 \<or> n \<le> order a p"
apply (cases "p = 0", auto)
apply (drule order_2 [where a=a and p=p])
apply (metis not_less_eq_eq power_le_dvd)
apply (erule power_le_dvd [OF order_1])
done

lemma poly_squarefree_decomp_order:
  assumes "pderiv p \<noteq> 0"
  and p: "p = q * d"
  and p': "pderiv p = e * d"
  and d: "d = r * p + s * pderiv p"
  shows "order a q = (if order a p = 0 then 0 else 1)"
proof (rule classical)
  assume 1: "order a q \<noteq> (if order a p = 0 then 0 else 1)"
  from `pderiv p \<noteq> 0` have "p \<noteq> 0" by auto
  with p have "order a p = order a q + order a d"
    by (simp add: order_mult)
  with 1 have "order a p \<noteq> 0" by (auto split: if_splits)
  have "order a (pderiv p) = order a e + order a d"
    using `pderiv p \<noteq> 0` `pderiv p = e * d` by (simp add: order_mult)
  have "order a p = Suc (order a (pderiv p))"
    using `pderiv p \<noteq> 0` `order a p \<noteq> 0` by (rule order_pderiv)
  have "d \<noteq> 0" using `p \<noteq> 0` `p = q * d` by simp
  have "([:-a, 1:] ^ (order a (pderiv p))) dvd d"
    apply (simp add: d)
    apply (rule dvd_add)
    apply (rule dvd_mult)
    apply (simp add: order_divides `p \<noteq> 0`
           `order a p = Suc (order a (pderiv p))`)
    apply (rule dvd_mult)
    apply (simp add: order_divides)
    done
  then have "order a (pderiv p) \<le> order a d"
    using `d \<noteq> 0` by (simp add: order_divides)
  show ?thesis
    using `order a p = order a q + order a d`
    using `order a (pderiv p) = order a e + order a d`
    using `order a p = Suc (order a (pderiv p))`
    using `order a (pderiv p) \<le> order a d`
    by auto
qed

lemma poly_squarefree_decomp_order2: "[| pderiv p \<noteq> 0;
         p = q * d;
         pderiv p = e * d;
         d = r * p + s * pderiv p
      |] ==> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
by (blast intro: poly_squarefree_decomp_order)

lemma order_pderiv2: "[| pderiv p \<noteq> 0; order a p \<noteq> 0 |]
      ==> (order a (pderiv p) = n) = (order a p = Suc n)"
by (auto dest: order_pderiv)

definition
  rsquarefree :: "'a::idom poly => bool" where
  "rsquarefree p = (p \<noteq> 0 & (\<forall>a. (order a p = 0) | (order a p = 1)))"

lemma pderiv_iszero: "pderiv p = 0 \<Longrightarrow> \<exists>h. p = [:h:]"
apply (simp add: pderiv_eq_0_iff)
apply (case_tac p, auto split: if_splits)
done

lemma rsquarefree_roots:
  "rsquarefree p = (\<forall>a. ~(poly p a = 0 & poly (pderiv p) a = 0))"
apply (simp add: rsquarefree_def)
apply (case_tac "p = 0", simp, simp)
apply (case_tac "pderiv p = 0")
apply simp
apply (drule pderiv_iszero, clarsimp)
apply (metis coeff_0 coeff_pCons_0 degree_pCons_0 le0 le_antisym order_degree)
apply (force simp add: order_root order_pderiv2)
done

lemma poly_squarefree_decomp:
  assumes "pderiv p \<noteq> 0"
    and "p = q * d"
    and "pderiv p = e * d"
    and "d = r * p + s * pderiv p"
  shows "rsquarefree q & (\<forall>a. (poly q a = 0) = (poly p a = 0))"
proof -
  from `pderiv p \<noteq> 0` have "p \<noteq> 0" by auto
  with `p = q * d` have "q \<noteq> 0" by simp
  have "\<forall>a. order a q = (if order a p = 0 then 0 else 1)"
    using assms by (rule poly_squarefree_decomp_order2)
  with `p \<noteq> 0` `q \<noteq> 0` show ?thesis
    by (simp add: rsquarefree_def order_root)
qed

end