Theory Rep_Fin_Groups

theory Rep_Fin_Groups

imports
  "HOL-Library.Function_Algebras"
  "HOL-Library.Set_Algebras"
  "HOL-Computational_Algebra.Polynomial"

begin




section ‹Preliminaries›

text ‹
  In this section, we establish some basic facts about logic, sets, and functions that are not
  available in the HOL library. As well, we develop some theory for almost-everywhere-zero functions
  in preparation of the definition of the group ring.
›


subsection ‹Logic›

lemma conjcases [case_names BothTrue OneTrue OtherTrue BothFalse] :
  assumes BothTrue: "P  Q     R"
  and     OneTrue:   "P  ¬Q   R"
  and     OtherTrue: "¬P  Q   R"
  and     BothFalse: "¬P  ¬Q  R"
  shows   "R"
  using   assms
  by      fast


subsection ‹Sets›

lemma empty_set_diff_single : "A - {x} = {}  A = {}  A = {x}"
  by auto

lemma seteqI : "(a. a  A  a  B)  (b. b  B  b  A)  A = B"
  using subset_antisym subsetI by fast

lemma prod_ballI : "(a b. (a,b)  AxB  P a b)  (a,b)AxB. P a b"
  by fast

lemma good_card_imp_finite : "of_nat (card A)  (0::'a::semiring_1)  finite A"
  using card_ge_0_finite[of A] by fastforce

subsection ‹Lists›

subsubsection zip›

lemma zip_truncate_left : "zip xs ys = zip (take (length ys) xs) ys"
  by (induct xs ys rule:list_induct2') auto

lemma zip_truncate_right : "zip xs ys = zip xs (take (length xs) ys)"
  by (induct xs ys rule:list_induct2') auto

text ‹
  Lemmas zip_append1› and zip_append2› in theory @{theory HOL.List} have unnecessary
  take (length _)› in them. Here are replacements.
›

lemma zip_append_left :
  "zip (xs@ys) zs = zip xs zs @ zip ys (drop (length xs) zs)"
  using zip_append1 zip_truncate_right[of xs zs] by simp

lemma zip_append_right :
  "zip xs (ys@zs) = zip xs ys @ zip (drop (length ys) xs) zs"
  using zip_append2 zip_truncate_left[of xs ys] by simp

lemma length_concat_map_split_zip :
  "length [f x y. (x,y)zip xs ys] = min (length xs) (length ys)"
  by (induct xs ys rule: list_induct2') auto

lemma concat_map_split_eq_map_split_zip :
  "[f x y. (x,y)zip xs ys] = map (case_prod f) (zip xs ys)"
  by (induct xs ys rule: list_induct2') auto

lemma set_zip_map2 :
  "(a,z)  set (zip xs (map f ys))  b. (a,b)  set (zip xs ys)  z = f b"
  by (induct xs ys rule: list_induct2') auto

subsubsection concat›

lemma concat_eq :
  "list_all2 (λxs ys. length xs = length ys) xss yss  concat xss = concat yss
         xss = yss"
  by  (induct xss yss rule: list_all2_induct) auto

lemma match_concat :
  fixes   bss :: "'b list list"
  defines eq_len: "eq_len  λxs ys. length xs = length ys"
  shows   "as::'a list. length as = length (concat bss)
                 (css::'a list list. as = concat css  list_all2 eq_len css bss)"
proof (induct bss)
  from eq_len
    show "as. length as = length (concat [])
                 (css. as = concat css  list_all2 eq_len css [])"
    by   simp
next
  fix fs :: "'b list" and fss :: "'b list list"
  assume prevcase: "as. length as = length (concat fss)
                          (css. as = concat css  list_all2 eq_len css fss)"
  have "as. length as = length (concat (fs # fss))
              (css. as = concat css  list_all2 eq_len css (fs # fss))"
  proof
    fix as :: "'a list"
    assume as: "length as = length (concat (fs#fss))"
    define xs ys where "xs = take (length fs) as" and "ys = drop (length fs) as"
    define gss where "gss = (SOME css. ys = concat css  list_all2 eq_len css fss)"
    define hss where "hss = xs # gss"
    with xs_def ys_def as gss_def eq_len prevcase
      show "as = concat hss  list_all2 eq_len hss (fs#fss)"
      using someI_ex[of "λcss. ys = concat css  list_all2 eq_len css fss"] by auto
  qed
  thus "as. length as = length (concat (fs # fss))
              (css. as = concat css  list_all2 eq_len css (fs # fss))"
    by fast
qed 

subsubsection strip_while›

lemma strip_while_0_nnil :
  "as  []  set as  0  strip_while ((=) 0) as  []"
  by (induct as rule: rev_nonempty_induct) auto

subsubsection sum_list›

lemma const_sum_list :
  "x  set xs. f x = a  sum_list (map f xs) = a * (length xs)"
  by (induct xs) auto

lemma sum_list_prod_cong :
  "(x,y)  set xys. f x y = g x y
         ((x,y)xys. f x y) = ((x,y)xys. g x y)"
  using arg_cong[of "map (case_prod f) xys" "map (case_prod g) xys" sum_list] by fastforce

lemma sum_list_prod_map2 :
  "((a,y)zip as (map f bs). g a y) = ((a,b)zip as bs. g a (f b))"
  by (induct as bs rule: list_induct2') auto

lemma sum_list_fun_apply : "(xxs. f x) y = (xxs. f x y)"
  by (induct xs) auto

lemma sum_list_prod_fun_apply : "((x,y)xys. f x y) z = ((x,y)xys. f x y z)"
  by (induct xys) auto

lemma (in comm_monoid_add) sum_list_plus :
  "length xs = length ys
         sum_list xs + sum_list ys = sum_list [a+b. (a,b)zip xs ys]"
proof (induct xs ys rule: list_induct2)
  case Cons thus ?case by (simp add: algebra_simps)
qed simp

lemma sum_list_const_mult_prod :
  fixes f :: "'a  'b  'r::semiring_0"
  shows "r * ((x,y)xys. f x y) = ((x,y)xys. r * (f x y))"
  using sum_list_const_mult[of r "case_prod f"] prod.case_distrib[of "λx. r*x" f]
  by    simp

lemma sum_list_mult_const_prod :
  fixes f :: "'a  'b  'r::semiring_0"
  shows "((x,y)xys. f x y) * r = ((x,y)xys. (f x y) * r)"
  using sum_list_mult_const[of "case_prod f" r] prod.case_distrib[of "λx. x*r" f]
  by    simp

lemma sum_list_update :
  fixes xs :: "'a::ab_group_add list"
  shows "n < length xs  sum_list (xs[n := y]) = sum_list xs - xs!n + y"
proof (induct xs arbitrary: n)
  case Cons thus ?case by (cases n) auto
qed simp

lemma sum_list_replicate0 : "sum_list (replicate n 0) = 0"
  by (induct n) auto

subsubsection listset›

lemma listset_ConsI : "x  X  xs  listset Xs  x#xs  listset (X#Xs)"
  unfolding listset_def set_Cons_def by simp

lemma listset_ConsD : "x#xs  listset (A # As)  x  A  xs  listset As"
  unfolding listset_def set_Cons_def by auto

lemma listset_Cons_conv :
  "xs  listset (A # As)  (y ys. y  A  ys  listset As  xs = y#ys)"
  unfolding listset_def set_Cons_def by auto

lemma listset_length : "xs  listset Xs  length xs = length Xs"
  using     listset_ConsD
  unfolding listset_def set_Cons_def
  by        (induct xs Xs rule: list_induct2') auto

lemma set_sum_list_element :
  "x  (AAs. A)  as  listset As. x = (aas. a)"
proof (induct As arbitrary: x)
  case Nil hence "x = (a[]. a)" by simp
  moreover have "[]  listset []" by simp
  ultimately show ?case by fast
next
  case (Cons A As)
  from this obtain a as
    where a_as: "a  A" "as  listset As" "x = (b(a#as). b)"
    using set_plus_def[of A]
    by    fastforce
  have "listset (A#As) = set_Cons A (listset As)" by simp
  with a_as(1,2) have "a#as  listset (A#As)" unfolding set_Cons_def by fast
  with a_as(3) show "bslistset (A#As). x = (bbs. b)" by fast
qed

lemma set_sum_list_element_Cons :
  assumes "x  (X(A#As). X)"
  shows   "a as. aA  as  listset As  x = a + (bas. b)"
proof-
  from assms obtain xs where xs: "xs  listset (A#As)" "x = (bxs. b)"
    using set_sum_list_element by fast
  from xs(1) obtain a as where "a  A" "as  listset As" "xs = a # as"
    using listset_Cons_conv by fast
  with xs(2) show ?thesis by auto
qed

lemma sum_list_listset : "as  listset As  sum_list as  (AAs. A)"
proof-
  have "length as = length As  as  listset As  sum_list as  (AAs. A)"
  proof (induct as As rule: list_induct2)
    case Nil show ?case by simp
  next
    case (Cons a as A As) thus ?case
      using listset_ConsD[of a] set_plus_def by auto
  qed
  thus "as  listset As  sum_list as  (AAs. A)" using listset_length by fast
qed

lemma listsetI_nth :
  "length xs = length Xs  n<length xs. xs!n  Xs!n  xs  listset Xs"
proof (induct xs Xs rule: list_induct2)
  case Nil show ?case by simp
next
  case (Cons x xs X Xs) thus "x#xs  listset (X#Xs)"
    using listset_ConsI[of x X xs Xs] by fastforce
qed

lemma listsetD_nth : "xs  listset Xs  n<length xs. xs!n  Xs!n"
proof-
  have "length xs = length Xs  xs  listset Xs  n<length xs. xs!n  Xs!n"
  proof (induct xs Xs rule: list_induct2)
     case Nil show ?case by simp
  next
    case (Cons x xs X Xs)
    from Cons(3) have x_xs: "x  X" "xs  listset Xs"
      using listset_ConsD[of x] by auto
    with Cons(2) have 1: "(x#xs)!0  (X#Xs)!0" "n<length xs. xs!n  Xs!n"
      by auto
    have "n. n < length (x#xs)  (x#xs)!n  (X#Xs)!n"
    proof-
      fix n assume "n < length (x#xs)"
      with 1 show "(x#xs)!n  (X#Xs)!n" by (cases n) auto
    qed
    thus "n < length (x#xs). (x#xs)!n  (X#Xs)!n" by fast
  qed
  thus "xs  listset Xs  n<length xs. xs!n  Xs!n" using listset_length by fast
qed

lemma set_listset_el_subset :
  "xs  listset Xs  Xset Xs. X  A  set xs  A"
proof-
  have " length xs = length Xs; xs  listset Xs; Xset Xs. X  A  
               set xs  A"
  proof (induct xs Xs rule: list_induct2)
    case Cons thus ?case using listset_ConsD by force
  qed simp
  thus "xs  listset Xs  Xset Xs. X  A  set xs  A"
    using listset_length by fast
qed


subsection ‹Functions›

subsubsection ‹Miscellaneous facts›

lemma sum_fun_apply : "finite A  (aA. f a) x = (aA. f a x)"
  by (induct set: finite) auto

lemma sum_single_nonzero :
  "finite A  (xA. yA. f x y = (if y = x then g x else 0)) 
         (xA. sum (f x) A = g x)"
proof (induct A rule: finite_induct)
  case (insert a A)
  show "xinsert a A. sum (f x) (insert a A) = g x"
  proof
    fix x assume x: "x  insert a A"
    show "sum (f x) (insert a A) = g x"
    proof (cases "x = a")
      case True
      moreover with insert(2,4) have "yA. f x y = 0" by simp
      ultimately show ?thesis using insert(1,2,4) by simp
    next
      case False with x insert show ?thesis by simp
    qed
  qed
qed simp

lemma distrib_comp_sum_right : "(T + T')  S = (T  S) + (T'  S)"
  by auto

subsubsection ‹Support of a function›

definition supp :: "('a  'b::zero)  'a set" where "supp f = {x. f x  0}"

lemma suppI: "f x  0  x  supp f"
  using supp_def by fast

lemma suppI_contra: "x  supp f  f x = 0"
  using suppI by fast

lemma suppD: "x  supp f  f x  0"
  using supp_def by fast

lemma suppD_contra: "f x = 0  x  supp f"
  using suppD by fast

lemma zerofun_imp_empty_supp : "supp 0 = {}"
  unfolding supp_def by simp

lemma supp_zerofun_subset_any : "supp 0  A"
  using zerofun_imp_empty_supp by fast

lemma supp_sum_subset_union_supp :
  fixes     f g :: "'a  'b::monoid_add"
  shows     "supp (f + g)  supp f  supp g"
  unfolding supp_def
  by        auto

lemma supp_neg_eq_supp :
  fixes     f :: "'a  'b::group_add"
  shows     "supp (- f) = supp f"
  unfolding supp_def
  by        auto

lemma supp_diff_subset_union_supp :
  fixes     f g :: "'a  'b::group_add"
  shows     "supp (f - g)  supp f  supp g"
  unfolding supp_def
  by        auto

abbreviation restrict0 :: "('a'b::zero)  'a set  ('a'b)" (infix "" 70)
  where "restrict0 f A  (λa. if a  A then f a else 0)"

lemma supp_restrict0 : "supp (fA)  A"
proof-
  have "a. a  A  a  supp (fA)" using suppD_contra[of "fA"] by simp
  thus ?thesis by fast
qed

lemma bij_betw_restrict0 : "bij_betw f A B  bij_betw (f  A) A B"
  using     bij_betw_imp_inj_on bij_betw_imp_surj_on
  unfolding bij_betw_def inj_on_def
  by        auto


subsubsection ‹Convolution›

definition convolution ::
  "('a::group_add  'b::{comm_monoid_add,times})  ('a'b)  ('a'b)"
  where "convolution f g
              = (λx. y|x - y  supp f  y  supp g. (f (x - y)) * g y)"
  ― ‹More often than not, this definition will be used in the case that @{text "'b"} is of class
        @{text "mult_zero"}, in which case the conditions @{term "x - y  supp f"} and
        @{term "y  supp g"} are obviously mathematically unnecessary. However, they also serve to
        ensure that the sum is taken over a finite set in the case that at least one of @{term f}
        and @{term g} is almost everywhere zero.›

lemma convolution_zero :
  fixes     f g :: "'a::group_add  'b::{comm_monoid_add,mult_zero}"
  shows     "f = 0  g = 0  convolution f g = 0"
  unfolding convolution_def
  by        auto

lemma convolution_symm :
  fixes f g :: "'a::group_add  'b::{comm_monoid_add,times}"
  shows "convolution f g
              = (λx. y|y  supp f  -y + x  supp g. (f y) * g (-y + x))"
proof
  fix x::'a
  define c1 c2 i S1 S2
    where "c1 y = (f (x - y)) * g y"
      and "c2 y = (f y) * g (-y + x)"
      and "i y = -y + x"
      and "S1 = {y. x - y  supp f  y  supp g}"
      and "S2 = {y. y  supp f  -y + x  supp g}"
    for y
  have "inj_on i S2" unfolding inj_on_def using i_def by simp
  hence "(y(i ` S2). c1 y) = (yS2. (c1  i) y)"
    using sum.reindex by fast
  moreover have S1_iS2: "S1 = i ` S2"
  proof (rule seteqI)
    fix y assume y_S1: "y  S1"
    define z where "z = x - y"
    hence y_eq: "-z + x = y" by (auto simp add: algebra_simps)
    hence "-z + x  supp g" using y_S1 S1_def by fast
    moreover have "z  supp f" using z_def y_S1 S1_def by fast
    ultimately have "z  S2" using S2_def by fast
    moreover have "y = i z" using i_def [abs_def] y_eq by fast
    ultimately show "y  i ` S2" by fast
  next
    fix y assume "y  i ` S2"
    from this obtain z where z_S2: "z  S2" and y_eq: "y = -z + x"
      using i_def by fast
    from y_eq have "x - y = z" by (auto simp add: algebra_simps)
    hence "x - y  supp f  y  supp g" using y_eq z_S2 S2_def by fastforce
    thus "y  S1" using S1_def by fast
  qed
  ultimately have "(yS1. c1 y) = (yS2. (c1  i) y)" by fast
  with i_def c1_def c2_def have "(yS1. c1 y) = (yS2. c2 y)"
    using diff_add_eq_diff_diff_swap[of x _ x] by simp
  thus "convolution f g x
              = (y|y  supp f  -y + x  supp g. (f y) * g (-y + x))"
    unfolding S1_def c1_def S2_def c2_def convolution_def by fast
qed  

lemma supp_convolution_subset_sum_supp :
  fixes f g :: "'a::group_add  'b::{comm_monoid_add,times}"
  shows "supp (convolution f g)  supp f + supp g"
proof-
  define SS where "SS x = {y. x-y  supp f  y  supp g}" for x
  have "convolution f g = (λx. sum (λy. (f (x - y)) * g y) (SS x))"
    unfolding SS_def convolution_def by fast
  moreover have "x. x  supp f + supp g  SS x = {}"
  proof-
    have "x. SS x  {}  x  supp f + supp g"
    proof-
      fix x::'a assume "SS x  {}"
      from this obtain y where "x - y  supp f" and y_G: "y  supp g"
        using SS_def by fast
      from this obtain z where z_F: "z  supp f" and z_eq: "x - y = z" by fast
      from z_eq have "x = z + y" using diff_eq_eq by fast
      with z_F y_G show "x  supp f + supp g" by fast
    qed
    thus "x. x  supp f + supp g  SS x = {}" by fast
  qed
  ultimately have "x. x  supp f + supp g
                         convolution f g x = sum (λy. (f (x - y)) * g y) {}"
    by simp
  hence "x. x  supp f + supp g  convolution f g x = 0"
    using sum.empty by simp
  thus ?thesis unfolding supp_def by fast
qed


subsection ‹Almost-everywhere-zero functions›

subsubsection ‹Definition and basic properties›

definition "aezfun_set = {f::'a'b::zero. finite (supp f)}"

lemma aezfun_setD: "f  aezfun_set  finite (supp f)"
  unfolding aezfun_set_def by fast

lemma aezfun_setI: "finite (supp f)  f  aezfun_set"
  unfolding aezfun_set_def by fast

lemma zerofun_is_aezfun : "0  aezfun_set"
  unfolding supp_def aezfun_set_def by auto

lemma sum_of_aezfun_is_aezfun :
  fixes     f g :: "'a'b::monoid_add"
  shows     "f  aezfun_set  g  aezfun_set  f + g  aezfun_set"
  using     supp_sum_subset_union_supp[of f g] finite_subset[of _ "supp f  supp g"]
  unfolding aezfun_set_def
  by        fastforce

lemma neg_of_aezfun_is_aezfun :
  fixes     f :: "'a'b::group_add"
  shows     "f  aezfun_set  - f  aezfun_set"
  using     supp_neg_eq_supp[of f]
  unfolding aezfun_set_def
  by        simp

lemma diff_of_aezfun_is_aezfun :
  fixes     f g :: "'a'b::group_add"
  shows     "f  aezfun_set  g  aezfun_set  f - g  aezfun_set"
  using     supp_diff_subset_union_supp[of f g] finite_subset[of _ "supp f  supp g"]
  unfolding aezfun_set_def
  by        fastforce

lemma restrict_and_extend0_aezfun_is_aezfun :
  assumes "f  aezfun_set"
  shows   "fA  aezfun_set"
proof (rule aezfun_setI)
  have "a. a  supp f  A  a  supp (fA)"
  proof-
    fix a assume "a  supp f  A"
    thus "a  supp (fA)" using suppI_contra[of a] suppD_contra[of "fA" a]
      by (cases "a  A") auto
  qed
  with assms show "finite (supp (fA))"
    using aezfun_setD finite_subset[of "supp (fA)"] by auto
qed

subsubsection ‹Delta (impulse) functions›

text ‹The notation is set up in the order output-input so that later when these are used to define
        the group ring RG, it will be in order ring-element-group-element.›

definition deltafun :: "'b::zero  'a  ('a  'b)" (infix "δ" 70)
  where "b δ a = (λx. if x = a then b else 0)"

lemma deltafun_apply_eq : "(b δ a) a = b"
  unfolding deltafun_def by simp

lemma deltafun_apply_neq : "x  a  (b δ a) x = 0"
  unfolding deltafun_def by simp

lemma deltafun0 : "0 δ a = 0"
  unfolding deltafun_def by auto

lemma deltafun_plus :
  fixes     b c :: "'b::monoid_add"
  shows     "(b+c) δ a = (b δ a) + (c δ a)"
  unfolding deltafun_def
  by        auto

lemma supp_delta0fun :  "supp (0 δ a) = {}"
  unfolding supp_def deltafun_def by simp

lemma supp_deltafun :  "b  0  supp (b δ a) = {a}"
  unfolding supp_def deltafun_def by simp

lemma deltafun_is_aezfun : "b δ a  aezfun_set"
proof (cases "b = 0")
  case True
  hence "supp (b δ a) = {}" using supp_delta0fun[of a] by fast
  thus ?thesis unfolding aezfun_set_def by simp
next
  case False thus ?thesis using supp_deltafun[of b a] unfolding aezfun_set_def by simp
qed

lemma aezfun_common_supp_spanning_set' :
  "finite A  as. distinct as  set as = A
       ( f::'a  'b::semiring_1. supp f  A
                    (bs. length bs = length as  f = ((b,a)zip bs as. b δ a)) )"
proof (induct rule: finite_induct)
  case empty show ?case unfolding supp_def by auto
next
  case (insert a A)
  from insert(3) obtain as
    where as: "distinct as" "set as = A"
              "f::'a  'b. supp f  A
                     bs. length bs = length as  f = ((b,a)zip bs as. b δ a)"
    by fast
  from as(1,2) insert(2) have "distinct (a#as)" "set (a#as) = insert a A" by auto
  moreover
    have "f::'a  'b::semiring_1. supp f  insert a A
                 (bs. length bs = length (a#as)
                   f = ((b,a)zip bs (a#as). b δ a))"
  proof-
    fix f :: "'a  'b" assume supp_f : "supp f  insert a A"
    define g where "g x = (if x = a then 0 else f x)" for x
    have "supp g  A"
    proof
      fix x assume x: "x  supp g"
      with x supp_f g_def have "x  insert a A" unfolding supp_def by auto
      moreover from x g_def have "x  a" unfolding supp_def by auto
      ultimately show "x  A" by fast
    qed
    with as(3) obtain bs
      where bs: "length bs = length as" "g = ((b,a)zip bs as. b δ a)"
      by    fast
    from bs(1) have "length ((f a) # bs) = length (a#as)" by auto
    moreover from g_def bs(2) have "f = ((b,a)zip ((f a) # bs) (a#as). b δ a)"
      using deltafun_apply_eq[of "f a" a] deltafun_apply_neq[of _ a "f a"] by (cases) auto
    ultimately
      show "bs. length bs = length (a#as)  f = ((b,a)zip bs (a#as). b δ a)"
      by   fast
  qed
  ultimately show ?case by fast
qed

subsubsection ‹Convolution of almost-everywhere-zero functions›

lemma convolution_eq_sum_over_supp_right :
  fixes   g f :: "'a::group_add  'b::{comm_monoid_add,mult_zero}"
  assumes "g  aezfun_set"
  shows   "convolution f g = (λx. ysupp g. (f (x - y)) * g y )"
proof
  fix x::'a
  define SS where "SS = {y. x - y  supp f  y  supp g}"
  have "finite (supp g)" using assms unfolding aezfun_set_def by fast
  moreover have "SS  supp g" unfolding SS_def by fast
  moreover have "y. y  supp g - SS  (f (x - y)) * g y = 0" using SS_def unfolding supp_def by auto
  ultimately show "convolution f g x = (ysupp g. (f (x - y)) * g y )"
    unfolding convolution_def
    using     SS_def sum.mono_neutral_left[of "supp g" SS "λy. (f (x - y)) * g y"]
    by        fast
qed

lemma convolution_symm_eq_sum_over_supp_left :
  fixes   f g :: "'a::group_add  'b::{comm_monoid_add,mult_zero}"
  assumes "f  aezfun_set"
  shows   "convolution f g = (λx. ysupp f. (f y) * g (-y + x))"
proof
  fix x::'a
  define SS where "SS = {y. y  supp f  -y + x  supp g}"
  have "finite (supp f)" using assms unfolding aezfun_set_def by fast
  moreover have "SS  supp f" using SS_def by fast
  moreover have "y. y  supp f - SS  (f y) * g (-y + x) = 0"
    using SS_def unfolding supp_def by auto
  ultimately
    have "(ySS. (f y) * g (-y + x)) = (ysupp f. (f y) * g (-y + x) )"
    unfolding convolution_def
    using     SS_def sum.mono_neutral_left[of "supp f" SS "λy. (f y) * g (-y + x)"]
    by        fast
  thus "convolution f g x = (ysupp f. (f y) * g (-y + x) )"
    using SS_def convolution_symm[of f g] by simp
qed

lemma convolution_delta_left :
  fixes b :: "'b::{comm_monoid_add,mult_zero}"
  and   a :: "'a::group_add"
  and   f :: "'a  'b"
  shows "convolution (b δ a) f = (λx. b * f (-a + x))"
proof (cases "b = 0")
  case True
  moreover have "convolution (b δ a) f = 0"
  proof-
    from True have "convolution (b δ a) f = convolution 0 f"
      using deltafun0[of a] arg_cong[of "0 δ a" "0::'a'b"]
      by (simp add: 0 δ a = 0 b = 0)
    thus ?thesis using convolution_zero by auto
  qed
  ultimately show ?thesis by auto
next
  case False thus ?thesis
    using deltafun_is_aezfun[of b a] convolution_symm_eq_sum_over_supp_left
          supp_deltafun[of b a] deltafun_apply_eq[of b a]
    by    fastforce
qed

lemma convolution_delta_right :
  fixes b :: "'b::{comm_monoid_add,mult_zero}"
  and   f :: "'a::group_add  'b" and a::'a
  shows "convolution f (b δ a) = (λx. f (x - a) * b)"
proof (cases "b = 0")
  case True
  moreover have "convolution f (b δ a) = 0"
  proof-
    from True have "convolution f (b δ a) = convolution f 0"
      using deltafun0[of a] arg_cong[of "0 δ a" "0::'a'b"] 
      by (simp add: 0 δ a = 0)
    thus ?thesis using convolution_zero by auto
  qed
  ultimately show ?thesis by auto
next
  case False thus ?thesis
    using deltafun_is_aezfun[of b a] convolution_eq_sum_over_supp_right
          supp_deltafun[of b a] deltafun_apply_eq[of b a]
    by    fastforce
qed

lemma   convolution_delta_delta :
  fixes b1 b2 :: "'b::{comm_monoid_add,mult_zero}"
  and   a1 a2 :: "'a::group_add"
  shows "convolution (b1 δ a1) (b2 δ a2) = (b1 * b2) δ (a1 + a2)"
proof
  fix x::'a
  have 1: "convolution (b1 δ a1) (b2 δ a2) x = (b1 δ a1) (x - a2) * b2"
    using convolution_delta_right[of "b1 δ a1"] by simp
  show "convolution (b1 δ a1) (b2 δ a2) x = ((b1 * b2) δ (a1 + a2)) x"
  proof (cases "x = a1 + a2")
    case True
    hence "x - a2 = a1" by (simp add: algebra_simps)
    with 1 have "convolution (b1 δ a1) (b2 δ a2) x = b1 * b2"
      using deltafun_apply_eq[of b1 a1] by simp
    with True show ?thesis
      using deltafun_apply_eq[of "b1 * b2" "a1 + a2"] by simp
  next
    case False
    hence "x - a2  a1" by (simp add: algebra_simps)
    with 1 have "convolution (b1 δ a1) (b2 δ a2) x = 0"
      using deltafun_apply_neq[of "x - a2" a1 b1] by simp
    with False show ?thesis using deltafun_apply_neq by simp
  qed
qed

lemma convolution_of_aezfun_is_aezfun :
  fixes     f g :: "'a::group_add  'b::{comm_monoid_add,times}"
  shows     "f  aezfun_set  g  aezfun_set  convolution f g  aezfun_set"
  using     supp_convolution_subset_sum_supp[of f g]
            finite_set_plus[of "supp f" "supp g"] finite_subset
  unfolding aezfun_set_def
  by        fastforce

lemma convolution_assoc :
  fixes   f h g :: "'a::group_add  'b::semiring_0"
  assumes f_aez: "f  aezfun_set" and h_aez: "h  aezfun_set"
  shows   "convolution (convolution f g) h = convolution f (convolution g h)"
proof
  define fg gh where "fg = convolution f g" and "gh = convolution g h"
  fix x::'a
  have "convolution fg h x
              = (ysupp f. (zsupp h. f y * g (-y + x - z) * h z) )"
  proof-
    have "convolution fg h x = (zsupp h. fg (x - z) * h z )"
      using h_aez convolution_eq_sum_over_supp_right[of h fg] by simp
    moreover have "z. fg (x - z) * h z
                        = (ysupp f. f y * g (-y + x - z) * h z)"
    proof-
      fix z::'a
      have "fg (x - z) = (ysupp f. f y * g (-y + (x - z)) )"
        using fg_def f_aez convolution_symm_eq_sum_over_supp_left by fastforce
      hence "fg (x - z) * h z = (ysupp f. f y * g (-y + (x - z)) * h z )"
        using sum_distrib_right by simp
      thus "fg (x - z) * h z = (ysupp f. f y * g (-y + x - z) * h z )"
        by (simp add: algebra_simps)
    qed
    ultimately 
      have  "convolution fg h x
                  = (zsupp h. (ysupp f. f y * g (-y + x - z) * h z) )"
      using sum.cong
      by    simp
    thus ?thesis using sum.swap by simp
  qed
  moreover have "convolution f gh x
                      = (ysupp f. (zsupp h. f y * g (-y + x - z) * h z) )"
  proof-
    have "convolution f gh x = (ysupp f. f y * gh (-y + x) )"
      using f_aez convolution_symm_eq_sum_over_supp_left[of f gh] by simp
    moreover have "y. f y * gh (-y + x)
                        = (zsupp h. f y * g (-y + x - z) * h z)"
    proof-
      fix y::'a
      have triple_cong: "z. f y * (g (-y + x - z) * h z)
                              = f y * g (-y + x - z) * h z"
        using mult.assoc[of "f y"] by simp
      have "gh (-y + x) = (zsupp h. g (-y + x - z) * h z)"
        using gh_def h_aez convolution_eq_sum_over_supp_right by fastforce
      hence "f y * gh (-y + x) = (zsupp h. f y * (g (-y + x - z) * h z))"
        using sum_distrib_left by simp
      also have " = (zsupp h. f y * g (-y + x - z) * h z)"
        using triple_cong sum.cong by simp
      finally
        show "f y * gh (-y + x) = (zsupp h. f y * g (-y + x - z) * h z)"
        by   fast
    qed
    ultimately show ?thesis using sum.cong by simp
  qed
  ultimately show "convolution fg h x = convolution f gh x" by simp
qed

lemma convolution_distrib_left :
  fixes   g h f :: "'a::group_add  'b::semiring_0"
  assumes "g  aezfun_set" "h  aezfun_set"
  shows   "convolution f (g + h) = convolution f g + convolution f h"
proof
  define gh GH where "gh = g + h" and "GH = supp g  supp h"
  have fin_GH: "finite GH" using GH_def assms unfolding aezfun_set_def by fast
  have gh_aezfun: "gh  aezfun_set" using gh_def assms sum_of_aezfun_is_aezfun by fast
  fix x::'a
  have zero_ext_g : "y. y  GH - supp g  (f (x - y)) * g y = 0"
  and  zero_ext_h : "y. y  GH - supp h  (f (x - y)) * h y = 0"
  and  zero_ext_gh: "y. y  GH - supp gh  (f (x - y)) * gh y = 0"
    unfolding supp_def by auto
  have "convolution f gh x = (ysupp gh. (f (x - y)) * gh y)"
    using assms gh_aezfun convolution_eq_sum_over_supp_right[of gh f] by simp
  also from gh_def GH_def have " = (yGH. (f (x - y)) * gh y)"
    using fin_GH supp_sum_subset_union_supp zero_ext_gh
          sum.mono_neutral_left[of GH "supp gh" "(λy. (f (x - y)) * gh y)"]
    by    fast
  also from gh_def
    have  " = (yGH. (f (x - y)) * g y) + (yGH. (f (x - y)) * h y)"
    using sum.distrib by (simp add: algebra_simps)
  finally show "convolution f gh x = (convolution f g + convolution f h) x"
    using assms GH_def fin_GH zero_ext_g zero_ext_h
          sum.mono_neutral_right[of GH "supp g" "(λy. (f (x - y)) * g y)"]
          sum.mono_neutral_right[of GH "supp h" "(λy. (f (x - y)) * h y)"]
          convolution_eq_sum_over_supp_right[of g f]
          convolution_eq_sum_over_supp_right[of h f]
    by    fastforce
qed

lemma convolution_distrib_right :
  fixes   f g h :: "'a::group_add  'b::semiring_0"
  assumes "f  aezfun_set" "g  aezfun_set"
  shows   "convolution (f + g) h = convolution f h + convolution g h"
proof
  define fg FG where "fg = f + g" and "FG = supp f  supp g"
  have fin_FG: "finite FG" using FG_def assms unfolding aezfun_set_def by fast
  have fg_aezfun: "fg  aezfun_set" using fg_def assms sum_of_aezfun_is_aezfun by fast
  fix x::'a
  have zero_ext_f : "y. y  FG - supp f  (f y) * h (-y + x) = 0"
  and  zero_ext_g : "y. y  FG - supp g  (g y) * h (-y + x) = 0"
  and  zero_ext_fg: "y. y  FG - supp fg  (fg y) * h (-y + x) = 0"
    unfolding supp_def by auto
  from assms have "convolution fg h x = (ysupp fg. (fg y) * h (-y + x))"
    using fg_aezfun convolution_symm_eq_sum_over_supp_left[of fg h] by simp
  also from fg_def FG_def have " = (yFG. (fg y) * h (-y + x))"
    using fin_FG supp_sum_subset_union_supp zero_ext_fg
          sum.mono_neutral_left[of FG "supp fg" "(λy. (fg y) * h (-y + x))"]
    by    fast
  also from fg_def
    have  " = (yFG. (f y) * h (-y + x)) + (yFG. (g y) * h (-y + x))"
    using sum.distrib by (simp add: algebra_simps)
  finally show "convolution fg h x = (convolution f h + convolution g h) x"
    using assms FG_def fin_FG zero_ext_f zero_ext_g
          sum.mono_neutral_right[of FG "supp f" "(λy. (f y) * h (-y + x))"]
          sum.mono_neutral_right[of FG "supp g" "(λy. (g y) * h (-y + x))"]
          convolution_symm_eq_sum_over_supp_left[of f h]
          convolution_symm_eq_sum_over_supp_left[of g h]
    by    fastforce
qed

subsubsection ‹Type definition, instantiations, and instances›

typedef (overloaded) ('a::zero,'b) aezfun = "aezfun_set :: ('b'a) set"
  morphisms aezfun Abs_aezfun
  using     zerofun_is_aezfun
  by        fast

setup_lifting type_definition_aezfun

lemma aezfun_finite_supp : "finite (supp (aezfun a))"
  using aezfun.aezfun unfolding aezfun_set_def by fast

lemma aezfun_transfer : "aezfun a = aezfun b  a = b" by transfer fast

instantiation aezfun :: (zero, type) zero
begin
  lift_definition zero_aezfun :: "('a,'b) aezfun" is "0::'b'a"
    using zerofun_is_aezfun by fast
  instance ..
end

lemma zero_aezfun_transfer : "Abs_aezfun ((0::'b::zero) δ (0::'a::zero)) = 0"
proof-
  define zb za where "zb = (0::'b)" and "za = (0::'a)"
  hence "zb δ za = 0" using deltafun0[of za] by fast
  moreover have "aezfun 0 = 0" using zero_aezfun.rep_eq by fast
  ultimately have "zb δ za = aezfun 0" by simp
  with zb_def za_def show ?thesis using aezfun_inverse by simp
qed

lemma zero_aezfun_apply [simp]: "aezfun 0 x = 0"
  by transfer simp

instantiation aezfun :: (monoid_add, type) plus
begin
  lift_definition plus_aezfun :: "('a, 'b) aezfun  ('a, 'b) aezfun  ('a, 'b) aezfun"
    is    "λf g. f + g"
    using sum_of_aezfun_is_aezfun
    by    auto
  instance ..
end

lemma plus_aezfun_apply [simp]: "aezfun (a+b) x = aezfun a x + aezfun b x"
  by transfer simp

instance aezfun :: (monoid_add, type) semigroup_add
proof
  fix a b c :: "('a, 'b) aezfun"
  have "aezfun (a + b + c) = aezfun (a + (b + c))"
  proof
    fix x::'b show "aezfun (a + b + c) x = aezfun (a + (b + c)) x" 
      using add.assoc[of "aezfun a x"] by simp
  qed
  thus "a + b + c = a + (b + c)" by transfer fast
qed

instance aezfun :: (monoid_add, type) monoid_add
proof
  fix a b c :: "('a, 'b) aezfun"
  show "0 + a = a" by transfer simp
  show "a + 0 = a" by transfer simp
qed

lemma sum_list_aezfun_apply [simp] :
  "aezfun (sum_list as) x = (aas. aezfun a x)"
  by (induct as) auto

lemma sum_list_map_aezfun_apply [simp] :
  "aezfun (aas. f a) x = (aas. aezfun (f a) x)"
  by (induct as) auto

lemma sum_list_map_aezfun [simp] :
  "aezfun (aas. f a) = (aas. aezfun (f a))"
  using sum_list_map_aezfun_apply[of f] sum_list_fun_apply[of "aezfun  f"] by auto

lemma sum_list_prod_map_aezfun_apply :  
  "aezfun ((x,y)xys. f x y) a = ((x,y)xys. aezfun (f x y) a)"
  by (induct xys) auto

lemma sum_list_prod_map_aezfun :
  "aezfun ((x,y)xys. f x y) = ((x,y)xys. aezfun (f x y))"
  using sum_list_prod_map_aezfun_apply[of f]
        sum_list_prod_fun_apply[of "λy z. aezfun (f y z)"]
  by    auto

instance aezfun :: (comm_monoid_add, type) comm_monoid_add
proof
  fix a b :: "('a, 'b) aezfun"
  have "aezfun (a + b) = aezfun (b + a)"
  proof
    fix x::'b show "aezfun (a + b) x = aezfun (b + a) x" 
      using add.commute[of "aezfun a x"] by simp
  qed
  thus "a + b = b + a" by transfer fast
  show "0 + a = a" by simp
qed

lemma sum_aezfun_apply [simp] :
  "finite A  aezfun (A) x = (aA. aezfun a x)"
  by (induct set: finite) auto

instantiation aezfun :: (group_add, type) minus
begin
  lift_definition minus_aezfun :: "('a, 'b) aezfun  ('a, 'b) aezfun  ('a, 'b) aezfun"
    is    "λf g. f - g"
    using diff_of_aezfun_is_aezfun
    by    fast
  instance ..
end

lemma minus_aezfun_apply [simp]: "aezfun (a-b) x = aezfun a x - aezfun b x"
  by transfer simp

instantiation aezfun :: (group_add, type) uminus
begin
  lift_definition uminus_aezfun :: "('a, 'b) aezfun  ('a, 'b) aezfun" is "λf. - f"
    using neg_of_aezfun_is_aezfun by fast
  instance ..
end

lemma uminus_aezfun_apply [simp]: "aezfun (-a) x = - aezfun a x"
  by transfer simp

lemma aezfun_left_minus [simp] :
  fixes a :: "('a::group_add, 'b) aezfun"
  shows "- a + a = 0"
  by    transfer simp

lemma aezfun_diff_minus [simp] :
  fixes a b :: "('a::group_add, 'b) aezfun"
  shows "a - b = a + - b"
  by    transfer auto

instance aezfun :: (group_add, type) group_add
proof
  fix a b :: "('a::group_add, 'b) aezfun"
  show "- a + a = 0" "a + - b = a - b" by auto
qed

instance aezfun :: (ab_group_add, type) ab_group_add
proof
  fix a b :: "('a::ab_group_add, 'b) aezfun"
  show "- a + a = 0" by simp
  show "a - b = a + - b" using aezfun_diff_minus by fast
qed

instantiation aezfun :: ("{one,zero}", zero) one
begin
  lift_definition one_aezfun :: "('a,'b) aezfun" is "1 δ 0"
    using deltafun_is_aezfun by fast
  instance ..
end

lemma one_aezfun_transfer : "Abs_aezfun (1 δ 0) = 1"
proof-
  define z n where "z = (0::'b::zero)" and "n = (1::'a::{one,zero})"
  hence "aezfun 1 = n δ z" using one_aezfun.rep_eq by fast
  hence "Abs_aezfun (n δ z) = Abs_aezfun (aezfun 1)" by simp
  with z_def n_def show ?thesis using aezfun_inverse by simp
qed

lemma one_aezfun_apply [simp]: "aezfun 1 x = (1 δ 0) x"
  by transfer rule

lemma one_aezfun_apply_eq [simp]: "aezfun 1 0 = 1"
  using deltafun_apply_eq by simp

lemma one_aezfun_apply_neq [simp]: "x  0  aezfun 1 x = 0"
  using deltafun_apply_neq by simp

instance aezfun :: (zero_neq_one, zero) zero_neq_one
proof
  have "(0::'a)  1" "aezfun 0 0 = 0" "aezfun (1::('a,'b) aezfun) 0 = 1"
    using zero_neq_one one_aezfun_apply_eq by auto
  thus "(0::('a,'b) aezfun)  1"
    using zero_neq_one one_aezfun_apply_eq
          fun_eq_iff[of "aezfun (0::('a,'b) aezfun)" "aezfun 1"]
    by    auto
qed

instantiation aezfun :: ("{comm_monoid_add,times}", group_add) times
begin
  lift_definition times_aezfun :: "('a, 'b) aezfun  ('a, 'b) aezfun  ('a, 'b) aezfun"
    is    "λ f g. convolution f g"
    using convolution_of_aezfun_is_aezfun
    by    fast
  instance ..
end

lemma convolution_transfer :
  assumes "f  aezfun_set" "g  aezfun_set"
  shows   "Abs_aezfun (convolution f g) = Abs_aezfun f * Abs_aezfun g"
proof (rule aezfun_transfer)
  from assms have "aezfun (Abs_aezfun (convolution f g)) = convolution f g"
    using convolution_of_aezfun_is_aezfun Abs_aezfun_inverse by fast
  moreover from assms
    have  "aezfun (Abs_aezfun f * Abs_aezfun g) = convolution f g"
    using times_aezfun.rep_eq[of "Abs_aezfun f"] Abs_aezfun_inverse[of f]
          Abs_aezfun_inverse[of g]
    by    simp
  ultimately show "aezfun (Abs_aezfun (convolution f g))
                        = aezfun (Abs_aezfun f * Abs_aezfun g)"
    by simp
qed

instance aezfun :: ("{comm_monoid_add,mult_zero}", group_add) mult_zero
proof
  fix a :: "('a, 'b) aezfun"
  show "0 * a = 0" using convolution_zero[of _ "aezfun a"] by transfer fast
  show "a * 0 = 0" using convolution_zero[of   "aezfun a"] by transfer fast
qed

instance aezfun :: (semiring_0, group_add) semiring_0
proof
  fix a b c :: "('a, 'b) aezfun"
  show "a * b * c = a * (b * c)"
    using convolution_assoc[of "aezfun a" "aezfun c" "aezfun b"] by transfer
  show "(a + b) * c = a * c + b * c"
    using convolution_distrib_right[of "aezfun a" "aezfun b" "aezfun c"] by transfer
  show "a * (b + c) = a * b + a * c"
    using convolution_distrib_left[of "aezfun b" "aezfun c" "aezfun a"] by transfer
qed

instance aezfun :: (ring, group_add) ring ..

instance aezfun :: ("{semiring_0,monoid_mult,zero_neq_one}", group_add) monoid_mult
proof
  fix a :: "('a, 'b) aezfun"
  show "1 * a = a"
  proof-
    have "aezfun (1 * a) = convolution (1 δ 0) (aezfun a)" by transfer fast
    hence "aezfun (1 * a) = (aezfun a)"
      using one_neq_zero convolution_delta_left[of 1 0 "aezfun a"] minus_zero by simp
    thus "1 * a = a" by transfer
  qed
  show "a * 1 = a"
  proof-
    have "aezfun (a * 1) = convolution (aezfun a) (1 δ 0)" by transfer fast
    hence "aezfun (a * 1) = (aezfun a)" 
      using one_neq_zero convolution_delta_right[of "aezfun a"] by simp
    thus ?thesis by transfer
  qed
qed

instance aezfun :: (ring_1, group_add) ring_1 ..

subsubsection ‹Transfer facts›

abbreviation aezdeltafun :: "'b::zero  'a  ('b,'a) aezfun" (infix "δδ" 70)
  where "b δδ a  Abs_aezfun (b δ a)"

lemma aezdeltafun : "aezfun (b δδ a) = b δ a"
  using deltafun_is_aezfun[of b a] Abs_aezfun_inverse by fast

lemma aezdeltafun_plus : "(b+c) δδ a = (b δδ a) + (c δδ a)"
  using aezdeltafun[of "b+c" a] deltafun_plus aezdeltafun[of b a] aezdeltafun[of c a]
        plus_aezfun.rep_eq[of "b δδ a"]
        aezfun_transfer[of "(b+c) δδ a" "(b δδ a) + (c δδ a)"]
  by    fastforce

lemma   times_aezdeltafun_aezdeltafun :
  fixes b1 b2 :: "'b::{comm_monoid_add,mult_zero}"
  shows "(b1 δδ a1) * (b2 δδ a2) = (b1 * b2) δδ (a1 + a2)"
  using deltafun_is_aezfun convolution_transfer[of "b1 δ a1", THEN sym]
        convolution_delta_delta[of b1 a1 b2 a2]
  by    fastforce

lemma aezfun_restrict_and_extend0 : "(aezfun x)A  aezfun_set"
  using aezfun.aezfun restrict_and_extend0_aezfun_is_aezfun[of "aezfun x"] by fast

lemma aezdeltafun_decomp :
  fixes b :: "'b::semiring_1"
  shows "b δδ a = (b δδ 0) * (1 δδ a)"
  using convolution_delta_delta[of b 0 1 a] deltafun_is_aezfun[of b 0]
        deltafun_is_aezfun[of 1 a] convolution_transfer
  by    fastforce

lemma aezdeltafun_decomp' :
  fixes b :: "'b::semiring_1"
  shows "b δδ a = (1 δδ a) * (b δδ 0)"
  using convolution_delta_delta[of 1 a b 0] deltafun_is_aezfun[of b 0]
        deltafun_is_aezfun[of 1 a] convolution_transfer
  by    fastforce

lemma supp_aezfun1 :
  "supp ( aezfun ( 1 :: ('a::zero_neq_one,'b::zero) aezfun ) ) = 0"
  using supp_deltafun[of "1::'a" "0::'b"] by transfer simp

lemma supp_aezfun_diff :
  "supp (aezfun (x - y))  supp (aezfun x)  supp (aezfun y)"
proof-
  have "supp (aezfun (x - y)) = supp ( (aezfun x) - (aezfun y) )" by transfer fast
  thus ?thesis using supp_diff_subset_union_supp by fast
qed

lemma supp_aezfun_times :
  "supp (aezfun (x * y))  supp (aezfun x) + supp (aezfun y)"
proof-
  have "supp (aezfun (x * y)) = supp (convolution (aezfun x) (aezfun y))"
    by transfer fast
  thus ?thesis using supp_convolution_subset_sum_supp by fast
qed

subsubsection ‹Almost-everywhere-zero functions with constrained support›

text ‹The name of the next definition anticipates aezfun_common_supp_spanning_set›
        below.›

definition aezfun_setspan :: "'a set  ('b::zero,'a) aezfun set"
  where "aezfun_setspan A = {x. supp (aezfun x)  A}"

lemma aezfun_setspanD : "x  aezfun_setspan A  supp (aezfun x)  A"
  unfolding aezfun_setspan_def by fast

lemma aezfun_setspanI : "supp (aezfun x)  A  x  aezfun_setspan A"
  unfolding aezfun_setspan_def by fast

lemma aezfun_common_supp_spanning_set :
  assumes "finite A"
  shows   "as. distinct as  set as = A  (
                  x::('b::semiring_1,'a) aezfun  aezfun_setspan A.
                    bs. length bs = length as  x = ((b,a)zip bs as. b δδ a)
          )"
proof-
  from assms aezfun_common_supp_spanning_set'[of A] obtain as
    where as: "distinct as" "set as = A"
              "f::'a  'b. supp f  A
                     (bs. length bs = length as  f = ((b,a)zip bs as. b δ a))"
    by    fast
  have "x::('b,'a) aezfun. x  aezfun_setspan A 
             (bs. length bs = length as  x = ((b,a)zip bs as. b δδ a))"
  proof-
    fix x::"('b,'a) aezfun" assume "x  aezfun_setspan A"
    with as(3) obtain bs
      where bs: "length bs = length as" "aezfun x = ((b,a)zip bs as. b δ a)"
      using aezfun_setspanD
      by    fast
    have "b a. (b,a)  set (zip bs as)  b δ a = aezfun (b δδ a)"
    proof-
      fix b a assume "(b,a)  set (zip bs as)"
      show "b δ a = aezfun (b δδ a)" using aezdeltafun[of b a] by simp
    qed
    with bs show "bs. length bs = length as  x = ((b,a)zip bs as. b δδ a)"
      using sum_list_prod_cong[of "zip bs as" deltafun "λb a. aezfun (b δδ a)"]
            sum_list_prod_map_aezfun[of aezdeltafun "zip bs as"]
            aezfun_transfer[of x]
      by    fastforce
  qed
  with as(1,2) show ?thesis by fast
qed

lemma aezfun_common_supp_spanning_set_decomp :
  fixes   G :: "'g::group_add set"
  assumes "finite G"
  shows   "gs. distinct gs  set gs = G  (
                  x::('r::semiring_1,'g) aezfun  aezfun_setspan G.
                    rs. length rs = length gs
                       x = ((r,g)zip rs gs. (r δδ 0) * (1 δδ g))
          )"
proof-
  from  aezfun_common_supp_spanning_set[OF assms] obtain gs
    where gs: "distinct gs" "set gs = G"
              "x::('r,'g) aezfun  aezfun_setspan G.
                    rs. length rs = length gs
                       x = ((r,g)zip rs gs. r δδ g)"
    by    fast
  have "x::('r,'g) aezfun. x  aezfun_setspan G
               rs. length rs = length gs
                 x = ((r,g)zip rs gs. (r δδ 0) * (1 δδ g))"
  proof-
    fix x::"('r,'g) aezfun" assume "x  aezfun_setspan G"
    with gs(3) obtain rs
      where "length rs = length gs" "x = ((r,g)zip rs gs. r δδ g)"
      using aezfun_setspanD
      by    fast
    thus "rs. length rs = length gs
                 x = ((r,g)zip rs gs. (r δδ 0) * (1 δδ g))"
      using aezdeltafun_decomp sum_list_prod_cong[
              of "zip rs gs" "λr g. r δδ g" "λr g. (r δδ 0) * (1 δδ g)"
            ]
      by    auto
  qed
  with gs(1,2) show ?thesis by fast
qed

lemma aezfun_decomp_aezdeltafun :
  fixes c :: "('r::semiring_1,'a) aezfun"
  shows "ras. set (map snd ras) = supp (aezfun c)  c = ((r,a)ras. r δδ a)"
proof-
  from aezfun_finite_supp[of c] obtain as
    where as: "set as = supp (aezfun c)"
              "x::('r,'a) aezfun  aezfun_setspan (supp (aezfun c)).
                    bs. length bs = length as
                       x = ((b,a)zip bs as. b δδ a)"
    using aezfun_common_supp_spanning_set[of "supp (aezfun c)"]
    by    fast
  from as(2) obtain bs
    where bs: "length bs = length as" "c = ((b,a)zip bs as. b δδ a)"
    using aezfun_setspanI[of c "supp (aezfun c)"]
    by    fast
  from bs(1) as(1) have "set (map snd (zip bs as)) = supp (aezfun c)" by simp
  with bs(2) show ?thesis by fast
qed

lemma aezfun_setspan_el_decomp_aezdeltafun :
  fixes c :: "('r::semiring_1,'a) aezfun"
  shows "c  aezfun_setspan A
               ras. set (map snd ras)  A  c = ((r,a)ras. r δδ a)"
  using aezfun_setspanD aezfun_decomp_aezdeltafun
  by    fast

lemma aezdelta0fun_commutes' :
  fixes b1 b2 :: "'b::comm_semiring_1"
  shows "b1 δδ a * (b2 δδ 0) = b2 δδ 0 * (b1 δδ a)"
  using times_aezdeltafun_aezdeltafun[of b1 a]
        times_aezdeltafun_aezdeltafun[of b2 0 b1 a]
  by    (simp add: algebra_simps)

lemma aezdelta0fun_commutes :
  fixes b :: "'b::comm_semiring_1"
  shows "c * (b δδ 0) = b δδ 0 * c"
proof-
  from aezfun_decomp_aezdeltafun obtain ras
    where c: "c = ((r,a)ras. r δδ a)"
    by    fast
  thus ?thesis
    using sum_list_mult_const_prod[of "λr a. r δδ a" ras] aezdelta0fun_commutes'
          sum_list_prod_cong[of ras "λr a. r δδ a * (b δδ 0)" "λr a. b δδ 0 * (r δδ a)"]
          sum_list_const_mult_prod[of "b δδ 0" "λr a. r δδ a" ras]
    by    auto
qed

text ‹
  The following definition constrains the support of arbitrary almost-everywhere-zero functions, as
  a sort of projection onto a aezfun_setspan›.
›

definition aezfun_setspan_proj :: "'a set  ('b::zero,'a) aezfun  ('b::zero,'a) aezfun"
  where "aezfun_setspan_proj A x  Abs_aezfun ((aezfun x)A)"

lemma aezfun_setspan_projD1 :
  "a  A  aezfun (aezfun_setspan_proj A x) a = aezfun x a"
  using     aezfun_restrict_and_extend0[of A x] Abs_aezfun_inverse[of "(aezfun x)A"]
  unfolding aezfun_setspan_proj_def
  by        simp

lemma aezfun_setspan_projD2 :
  "a  A  aezfun (aezfun_setspan_proj A x) a = 0"
  using     aezfun_restrict_and_extend0[of A x] Abs_aezfun_inverse[of "(aezfun x)A"]
  unfolding aezfun_setspan_proj_def
  by        simp

lemma aezfun_setspan_proj_in_setspan :
  "aezfun_setspan_proj A x  aezfun_setspan A"
  using aezfun_setspan_projD2[of _ A]
        suppD_contra[of "aezfun (aezfun_setspan_proj A x)"]
        aezfun_setspanI[of "aezfun_setspan_proj A x" A]
  by    auto

lemma aezfun_setspan_proj_zero : "aezfun_setspan_proj A 0 = 0"
proof-
  have "aezfun (aezfun_setspan_proj A 0) = aezfun 0"
  proof
    fix a show "aezfun (aezfun_setspan_proj A 0) a = aezfun 0 a"
      using aezfun_setspan_projD1[of a A 0] aezfun_setspan_projD2[of a A 0]
      by    (cases "aA") auto
  qed
  thus ?thesis using aezfun_transfer by fast
qed

lemma aezfun_setspan_proj_aezdeltafun :
  "aezfun_setspan_proj A (b δδ a) = (if a  A then b δδ a else 0)"
proof-
  have "aezfun (aezfun_setspan_proj A (b δδ a))
              = aezfun (if a  A then b δδ a else 0)"
  proof
    fix x show "aezfun (aezfun_setspan_proj A (b δδ a)) x
                      = aezfun (if a  A then b δδ a else 0) x"
    proof (cases "x  A")
      case True thus ?thesis
        using aezfun_setspan_projD1[of x A "b δδ a"] aezdeltafun[of b a]
              deltafun_apply_neq[of x]
        by    fastforce
    next
      case False
      hence "aezfun (aezfun_setspan_proj A (b δδ a)) x = 0"
        using aezfun_setspan_projD2[of x A] by simp
      moreover from False
        have  "a  A  aezfun (if a  A then b δδ a else 0) x = 0"
        using aezdeltafun[of b a] deltafun_apply_neq[of x a b] by auto
      ultimately show ?thesis by auto
    qed
  qed
  thus ?thesis using aezfun_transfer by fast
qed

lemma aezfun_setspan_proj_add :
  "aezfun_setspan_proj A (x+y)
        = aezfun_setspan_proj A x + aezfun_setspan_proj A y"
proof-
  have "aezfun (aezfun_setspan_proj A (x+y))
             = aezfun (aezfun_setspan_proj A x + aezfun_setspan_proj A y)"
  proof
    fix a show "aezfun (aezfun_setspan_proj A (x+y)) a
                     = aezfun (aezfun_setspan_proj A x + aezfun_setspan_proj A y) a"
      using aezfun_setspan_projD1[of a A "x+y"] aezfun_setspan_projD2[of a A "x+y"]
            aezfun_setspan_projD1[of a A x] aezfun_setspan_projD1[of a A y]
            aezfun_setspan_projD2[of a A x] aezfun_setspan_projD2[of a A y]
      by    (cases "a  A") auto
  qed
  thus ?thesis using aezfun_transfer by auto
qed

lemma aezfun_setspan_proj_sum_list : 
  "aezfun_setspan_proj A (xxs. f x) = (xxs. aezfun_setspan_proj A (f x))"
proof (induct xs)
  case Nil show ?case using aezfun_setspan_proj_zero by simp
next
  case (Cons x xs) thus ?case using aezfun_setspan_proj_add[of A "f x"] by simp
qed

lemma aezfun_setspan_proj_sum_list_prod :
  "aezfun_setspan_proj A ((x,y)xys. f x y)
        = ((x,y)xys. aezfun_setspan_proj A (f x y))"
  using aezfun_setspan_proj_sum_list[of A "λxy. case_prod f xy"]
        prod.case_distrib[of "aezfun_setspan_proj A" f]
  by    simp


subsection ‹Polynomials›

lemma nonzero_coeffs_nonzero_poly : "as  []  set as  0  Poly as  0"
  using coeffs_Poly[of as] strip_while_0_nnil[of as] by fastforce

lemma const_poly_nonzero_coeff :
  assumes "degree p = 0" "p  0"
  shows   "coeff p 0  0"
proof
  assume z: "coeff p 0 = 0"
  have "n. coeff p n = 0"
  proof-
    fix n from z assms show "coeff p n = 0"
      using coeff_eq_0[of p] by (cases "n = 0") auto
  qed
  with assms(2) show False using poly_eqI[of p 0] by simp
qed

lemma pCons_induct2 [case_names 00 lpCons rpCons pCons2]:
  assumes 00: "P 0 0"
  and     lpCons: "a p. a  0  p  0  P (pCons a p) 0"
  and     rpCons: "b q. b  0  q  0  P 0 (pCons b q)"
  and     pCons2: "a p b q. a  0  p  0  b  0  q  0  P p q
                                                                     P (pCons a p) (pCons b q)"
  shows   "P p q"
proof (induct p arbitrary: q)
  case 0
  show ?case
  proof (cases q)
    fix b q' assume "q = pCons b q'"
    with 00 rpCons show ?thesis by (cases "b  0  q'  0") auto
  qed
next
  case (pCons a p)
  show ?case
  proof (cases q)
    fix b q' assume "q = pCons b q'"
    with pCons lpCons pCons2 show ?thesis by (cases "b  0  q'  0") auto
  qed
qed


subsection ‹Algebra of sets›

subsubsection ‹General facts›

lemma zeroset_eqI: "0  A  (a. a  A  a = 0)  A = 0"
  by auto

lemma sum_list_sets_single : "(X[A]. X) = A"
  using add_0_right[of A] by simp

lemma sum_list_sets_double : "(X[A,B]. X) = A + B"
  using add_0_right[of B] by simp

subsubsection ‹Additive independence of sets›

primrec add_independentS :: "'a::monoid_add set list  bool"
  where "add_independentS [] = True"
      | "add_independentS (A#As) = ( add_independentS As
               (x(BAs. B). aA. a + x = 0  a = 0) )"

lemma add_independentS_doubleI:
  assumes "b a. bB  aA  a + b = 0  a = 0"
  shows   "add_independentS [A,B]"
  using assms sum_list_sets_single[of B] by simp

lemma add_independentS_doubleD:
  assumes "add_independentS [A,B]"
  shows   "b a. bB  aA  a + b = 0  a = 0"
  using assms sum_list_sets_single[of B] by simp

lemma add_independentS_double_iff :
  "add_independentS [A,B] = (bB. aA. a + b = 0  a = 0 )"
  using add_independentS_doubleI add_independentS_doubleD by fast

lemma add_independentS_Cons_conv_sum_right : 
  "add_independentS (A#As)
        = (add_independentS [A,BAs. B]  add_independentS As)"
  using add_independentS_double_iff[of A] by auto

lemma add_independentS_double_sum_conv_append :
  " Xset As. 0  X; add_independentS As; add_independentS Bs; 
        add_independentS [XAs. X, XBs. X] 
           add_independentS (As@Bs)"
proof (induct As)
  case (Cons A As)
  have "add_independentS [XAs. X, XBs. X]"
  proof (rule add_independentS_doubleI)
    fix b a assume ba: "b  (XBs. X)" "a  (XAs. X)" "a + b = 0"
    from Cons(2) ba(2) have "a  (XA#As. X)"
      using set_plus_intro[of 0 A a] by simp
    with ba(1,3) Cons(5) show "a = 0"
      using add_independentS_doubleD[of "XA # As. X" "XBs. X" b a]
      by    simp
  qed
  moreover have "x a.  x  (XAs@Bs. X); a  A; a + x = 0  
                       a = 0"
  proof-
    fix x a assume x_a: "x  (XAs@Bs. X)" "a  A" "a + x = 0"
    from x_a(1) obtain xa xb
      where xa_xb: "x = xa + xb" "xa  (XAs. X)" "xb  (XBs. X)"
      using set_plus_elim[of x "XAs. X"]
      by    auto
    from x_a(2) xa_xb(2) have "a + xa  A + (XAs. X)"
      using set_plus_intro by auto
    with Cons(3,5) xa_xb x_a(2,3) show "a = 0"
      using add_independentS_doubleD[
              of "XA # As. X" "XBs. X" xb "a+xa"
            ]
            add.assoc[of a] add_independentS_doubleD
      by    simp
  qed
  ultimately show "add_independentS ((A#As)@Bs)" using Cons by simp
qed simp

lemma add_independentS_ConsI :
  assumes "add_independentS As"
          "x a.  x(XAs. X); a  A; a+x = 0   a = 0"
  shows   "add_independentS (A#As)"
  using assms by simp

lemma add_independentS_append_reduce_right :
  "add_independentS (As@Bs)  add_independentS Bs"
  by (induct As) auto

lemma add_independentS_append_reduce_left : 
  "add_independentS (As@Bs)  0  (XBs. X)  add_independentS As"
proof (induct As)
  case (Cons A As) show "add_independentS (A#As)"
  proof (rule add_independentS_ConsI)
    from Cons show "add_independentS As" by simp
  next
    fix x a assume x: "x  (XAs. X)" and a: "a  A" and sum: "a+x = 0"
    from x Cons(3) have "x + 0  (XAs. X) + (XBs. X)" by fast
    with a sum Cons(2) show "a = 0" by simp
  qed
qed simp

lemma add_independentS_append_conv_double_sum : 
  "add_independentS (As@Bs)  add_independentS [XAs. X, XBs. X]"
proof (induct As)
  case (Cons A As)
  show "add_independentS [X(A#As). X, XBs. X]"
  proof (rule add_independentS_doubleI)
    fix b x assume bx: "b  (XBs. X)" "x  (XA # As. X)" "x + b = 0"
    from bx(2) obtain a as
      where a_as: "a  A" "as  listset As" "x = a + (zas. z)"
      using set_sum_list_element_Cons
      by    fast
    from Cons(2) have "add_independentS [A,XAs@Bs. X]"
      using add_independentS_Cons_conv_sum_right[of A "As@Bs"] by simp
    moreover from a_as(2) bx(1)
      have  "(zas. z) + b  (X(As@Bs). X)"
      using sum_list_listset set_plus_intro
      by    auto
    ultimately have "a = 0"
      using a_as(1,3) bx(3) add_independentS_doubleD[of A _ _ a] add.assoc[of a]
      by    auto
    with a_as(2,3) bx(1,3) Cons show "x = 0"
      using sum_list_listset
            add_independentS_doubleD[of "XAs. X" "XBs. X" b "zas. z"]
      by    auto
  qed
qed simp

subsubsection ‹Inner direct sums›

definition inner_dirsum :: "'a::monoid_add set list  'a set"
  where "inner_dirsum As = (if add_independentS As then AAs. A else 0)"

text‹Some syntactic sugar for inner_dirsum›, borrowed from theory @{theory HOL.List}.›

syntax 
  "_inner_dirsum" :: "pttrn => 'a list => 'b => 'b"
  ("(3__. _)" [0, 51, 10] 10)
translations ― ‹Beware of argument permutation!›
  "MMs. b" == "CONST inner_dirsum (CONST map (%M. b) Ms)"

abbreviation inner_dirsum_double ::
  "'a::monoid_add set  'a set  'a set" (infixr "" 70)
  where "inner_dirsum_double A B  inner_dirsum [A,B]"

lemma inner_dirsumI :
  "M = (NNs. N)  add_independentS Ns  M = (NNs. N)"
  unfolding inner_dirsum_def by simp

lemma inner_dirsum_doubleI :
  "M = A + B  add_independentS [A,B]  M = A  B"
  using inner_dirsumI[of M "[A,B]"] sum_list_sets_double[of A] by simp

lemma inner_dirsumD :
  "add_independentS Ms  (MMs. M) = (MMs. M)"
  unfolding inner_dirsum_def by simp

lemma inner_dirsumD2 : "¬ add_independentS Ms  (MMs. M) = 0"
  unfolding inner_dirsum_def by simp

lemma inner_dirsum_Nil : "(A[]. A) = 0"
  unfolding inner_dirsum_def by simp

lemma inner_dirsum_singleD : "(N[M]. N) = M"
  using inner_dirsumD[of "[M]"] sum_list_sets_single[of M] by simp

lemma inner_dirsum_doubleD : "add_independentS [M,N]  M  N = M + N"
  using inner_dirsumD[of "[M,N]"] sum_list_sets_double[of M N] by simp

lemma inner_dirsum_Cons :
  "add_independentS (A # As)  (X(A#As). X) = A  (XAs. X)"
  using inner_dirsumD[of "A#As"] add_independentS_Cons_conv_sum_right[of A] 
        inner_dirsum_doubleD[of A] inner_dirsumD[of As]
  by    simp

lemma inner_dirsum_append :
  "add_independentS (As@Bs)  0  (XBs. X)
         (X(As@Bs). X) = (XAs. X)  (XBs. X)"
  using inner_dirsumD[of "As@Bs"] add_independentS_append_reduce_left[of As]
        inner_dirsumD[of As] inner_dirsumD[of Bs]
        add_independentS_append_reduce_right[of As Bs]
        add_independentS_append_conv_double_sum[of As]
        inner_dirsum_doubleD[of "XAs. X"]
  by    simp

lemma inner_dirsum_double_left0: "0  A = A"
  using add_independentS_doubleD inner_dirsum_doubleI[of "0+A"] add_0_left[of A] by simp

lemma add_independentS_Cons_conv_dirsum_right :
  "add_independentS (A#As) = (add_independentS [A,BAs. B]
         add_independentS As)"
  using add_independentS_Cons_conv_sum_right[of A As] inner_dirsumD by auto

lemma sum_list_listset_dirsum : 
  "add_independentS As  as  listset As  sum_list as  (AAs. A)"
  using inner_dirsumD sum_list_listset by fast




section ‹Groups›

subsection ‹Locales and basic facts›

subsubsection ‹Locale Group› and finite variant FinGroup›

text ‹
  Define a Group› to be a closed subset of @{term UNIV} for the group_add› class.
›

locale Group =
  fixes G :: "'g::group_add set"
  assumes nonempty   : "G  {}"
  and     diff_closed: "g h. g  G  h  G  g - h  G"

lemma trivial_Group : "Group 0"
  by unfold_locales auto

locale FinGroup = Group G
  for G :: "'g::group_add set"
+ assumes finite: "finite G"

lemma (in FinGroup) Group : "Group G" by unfold_locales

lemma (in Group) FinGroupI : "finite G  FinGroup G" by unfold_locales

context Group
begin

abbreviation Subgroup ::
  "'g set  bool" where "Subgroup H  Group H  H  G"

lemma SubgroupD1 : "Subgroup H  Group H" by fast

lemma zero_closed : "0  G"
proof-
  from nonempty obtain g where "g  G" by fast
  hence "g - g  G" using diff_closed by fast
  thus ?thesis by simp
qed

lemma obtain_nonzero: assumes "G  0" obtains g where "g  G" and "g  0"
  using assms zero_closed by auto

lemma zeroS_closed : "0  G"
  using zero_closed by simp

lemma neg_closed : "g  G  -g  G"
  using zero_closed diff_closed[of 0 g] by simp

lemma add_closed : "g  G  h  G  g + h  G"
  using neg_closed[of h] diff_closed[of g "-h"] by simp

lemma neg_add_closed : "g  G  h  G  -g + h  G"
  using neg_closed add_closed by fast

lemma sum_list_closed : "set (map f as)  G  (aas. f a)  G"
  using zero_closed add_closed by (induct as) auto

lemma sum_list_closed_prod :
  "set (map (case_prod f) xys)  G  ((x,y)xys. f x y)  G"
  using sum_list_closed by fast

lemma set_plus_closed : "A  G  B  G  A + B  G"
  using set_plus_def[of A B] add_closed by force

lemma zip_add_closed :
  "set as  G  set bs  G  set [a + b. (a,b)zip as bs]  G"
  using add_closed by (induct as bs rule: list_induct2') auto

lemma list_diff_closed :
  "set gs  G  set hs  G  set [x-y. (x,y)zip gs hs]  G"
  using diff_closed by (induct gs hs rule: list_induct2') auto

lemma add_closed_converse_right : "g+x  G  g  G  x  G"
  using neg_add_closed add.assoc[of "-g" g x] by fastforce

lemma add_closed_inverse_right : "x  G  g  G  g+x  G"
  using add_closed_converse_right by fast

lemma add_closed_converse_left : "g+x  G  x  G  g  G"
  using diff_closed add.assoc[of g] by fastforce

lemma add_closed_inverse_left : "g  G  x  G  g+x  G"
  using add_closed_converse_left by fast

lemma right_translate_bij :
  assumes "g  G"
  shows   "bij_betw (λx. x + g) G G"
unfolding bij_betw_def proof
  show "inj_on (λx. x + g) G" by (rule inj_onI) simp
  show "(λx. x + g) ` G = G"
  proof
    show "(λx. x + g) ` G  G" using assms add_closed by fast
    show "(λx. x + g) ` G  G"
    proof
      fix x assume "x  G"
      with assms have "x - g  G" "x = (λx. x + g) (x - g)"
        using diff_closed diff_add_cancel[of x] by auto
      thus "x  (λx. x + g) ` G" by fast
    qed
  qed
qed

lemma right_translate_sum : "g  G  (hG. f h) = (hG. f (h + g))"
  using right_translate_bij[of g] bij_betw_def[of "λh. h + g"]
        sum.reindex[of "λh. h + g" G]
  by    simp

end (* context Group *)

subsubsection ‹Abelian variant locale AbGroup›

locale AbGroup = Group G
  for G :: "'g::ab_group_add set"
begin

lemmas nonempty    = nonempty
lemmas zero_closed = zero_closed
lemmas diff_closed = diff_closed
lemmas add_closed  = add_closed
lemmas neg_closed  = neg_closed

lemma sum_closed : "finite A  f ` A  G  (aA. f a)  G"
proof (induct set: finite)
  case empty show ?case using zero_closed by simp
next
  case (insert a A) thus ?case using add_closed by simp
qed

lemma subset_plus_right : "A  G + A"
  using zero_closed set_zero_plus2 by fast

lemma subset_plus_left : "A  A + G"
  using subset_plus_right add.commute by fast

end (* context AbGroup *)


subsection ‹Right cosets›

context Group
begin

definition rcoset_rel :: "'g set  ('g×'g) set" 
  where "rcoset_rel H  {(g,g'). g  G  g'  G  g - g'  H}"

lemma (in Group) rcosets :
  assumes subgrp: "Subgroup H" and g: "g  G"
  shows   "(rcoset_rel H)``{g} = H + {g}"
proof (rule seteqI)
  fix x assume "x  (rcoset_rel H)``{g}"
  hence "x  G" "g - x  H" using rcoset_rel_def by auto
  with subgrp have "x - g  H"
    using Group.neg_closed minus_diff_eq[of g x] by fastforce
  from this obtain h where h: "h  H" "x - g = h" by fast
  from h(2) have "x = h + g" by (simp add: algebra_simps)
  with h(1) show "x  H + {g}" using set_plus_def by fast
next
  fix x assume "x  H + {g}"
  from this obtain h where h: "h  H" "x = h + g" unfolding set_plus_def by fast
  with subgrp g have 1: "x  G" using add_closed by fast
  from h(2) have "x - g = h" by (simp add: algebra_simps)
  with subgrp h(1) have "g - x  H" using Group.neg_closed by fastforce
  with g 1 show "x  (rcoset_rel H)``{g}" using rcoset_rel_def by fast
qed

lemma rcoset_equiv :
  assumes "Subgroup H"
  shows   "equiv G (rcoset_rel H)"
proof (rule equivI)
  show "refl_on G (rcoset_rel H)"
  proof (rule refl_onI)
    show "(rcoset_rel H)  G × G" using rcoset_rel_def by auto
  next
    fix x assume "x  G"
    with assms show "(x,x)  (rcoset_rel H)"
      using rcoset_rel_def Group.zero_closed by auto
  qed
  show "sym (rcoset_rel H)"
  proof (rule symI)
    fix a b assume "(a,b)  (rcoset_rel H)"
    with assms show "(b,a)  (rcoset_rel H)"
      using rcoset_rel_def Group.neg_closed[of H "a - b"] minus_diff_eq by simp
  qed
  show "trans (rcoset_rel H)"
  proof (rule transI)
    fix x y z assume "(x,y)  (rcoset_rel H)" "(y,z)  (rcoset_rel H)"
    with assms show "(x,z)  (rcoset_rel H)"
      using rcoset_rel_def Group.add_closed[of H "x - y" "y - z"]
      by    (simp add: algebra_simps)
  qed
qed

lemma rcoset0 : "Subgroup H  (rcoset_rel H)``{0} = H"
  using zero_closed rcosets unfolding set_plus_def by simp

definition is_rcoset_replist :: "'g set  'g list  bool"
  where "is_rcoset_replist H gs
               set gs  G  distinct (map (λg. (rcoset_rel H)``{g}) gs)
                 G = (gset gs. (rcoset_rel H)``{g})"

lemma is_rcoset_replistD_set : "is_rcoset_replist H gs  set gs  G"
  unfolding is_rcoset_replist_def by fast

lemma is_rcoset_replistD_distinct :
  "is_rcoset_replist H gs  distinct (map (λg. (rcoset_rel H)``{g}) gs)"
  unfolding is_rcoset_replist_def by fast

lemma is_rcoset_replistD_cosets :
  "is_rcoset_replist H gs  G = (gset gs. (rcoset_rel H)``{g})"
  unfolding is_rcoset_replist_def by fast

lemma group_eq_subgrp_rcoset_un :
  "Subgroup H  is_rcoset_replist H gs  G = (gset gs. H + {g})"
  using is_rcoset_replistD_set is_rcoset_replistD_cosets rcosets
    by (auto, smt UN_E subsetCE, blast)

lemma is_rcoset_replist_imp_nrelated_nth :
  assumes "Subgroup H" "is_rcoset_replist H gs"
  shows   "i j. i < length gs  j < length gs  i  j  gs!i - gs!j  H"
proof
  fix i j assume ij: "i < length gs" "j < length gs" "ij" "gs!i - gs!j  H"
  from assms(2) ij(1,2,4) have "(gs!i,gs!j)  rcoset_rel H"
    using set_conv_nth is_rcoset_replistD_set rcoset_rel_def by fastforce
  with assms(1) ij(1,2)
    have  "(map (λg. (rcoset_rel H)``{g}) gs)!i
                = (map (λg. (rcoset_rel H)``{g}) gs)!j"
    using rcoset_equiv equiv_class_eq
    by    fastforce
  with assms(2) ij(1-3) show False
    using is_rcoset_replistD_distinct distinct_conv_nth[
            of "map (λg. (rcoset_rel H)``{g}) gs"
          ]
    by    auto
qed

lemma is_rcoset_replist_Cons :
  "is_rcoset_replist H (g#gs) 
      g  G  set gs  G
     (rcoset_rel H)``{g}  set (map (λx. (rcoset_rel H)``{x}) gs)
     distinct (map (λx. (rcoset_rel H)``{x}) gs)
     G = (rcoset_rel H)``{g}  (xset gs. (rcoset_rel H)``{x})"
  using is_rcoset_replist_def[of H "g#gs"] by auto

lemma rcoset_replist_Hrep :
  assumes "Subgroup H" "is_rcoset_replist H gs"
  shows   "gset gs. g  H"
proof-
  from assms(2) obtain g where g: "g  set gs" "0  (rcoset_rel H)``{g}"
    using zero_closed is_rcoset_replistD_cosets by fast
  from assms(1) g(2) have "g  (rcoset_rel H)``{0}"
    using rcoset_equiv equivE sym_def[of "rcoset_rel H"] by force
  with assms(1) g show "gset gs. g  H" using rcoset0 by fast
qed

lemma rcoset_replist_reorder :
  "is_rcoset_replist H (gs @ g # gs')  is_rcoset_replist H (g # gs @ gs')"
  using is_rcoset_replist_def by auto

lemma rcoset_replist_replacehd :
  assumes "Subgroup H" "g'  (rcoset_rel H)``{g}" "is_rcoset_replist H (g # gs)"
  shows   "is_rcoset_replist H (g' # gs)"
proof-
  from assms(2) have "g'  G" using rcoset_rel_def by simp
  moreover from assms(3) have "set gs  G"
    using is_rcoset_replistD_set by fastforce
  moreover from assms(1-3)
    have  "(rcoset_rel H)``{g'}  set (map (λx. (rcoset_rel H)``{x}) gs)"
    using set_conv_nth[of gs] rcoset_equiv equiv_class_eq_iff[of G] is_rcoset_replistD_distinct
    by    fastforce
  moreover from assms(3) have "distinct (map (λg. (rcoset_rel H)``{g}) gs)"
    using is_rcoset_replistD_distinct by fastforce
  moreover from assms(1-3)
    have  "G = (rcoset_rel H)``{g'}  (xset gs. (rcoset_rel H)``{x})"
    using is_rcoset_replistD_cosets[of H "g#gs"] rcoset_equiv equiv_class_eq_iff[of G]
    by    simp
  ultimately show ?thesis using is_rcoset_replist_Cons by auto 
qed

end (* context Group *)

lemma (in FinGroup) ex_rcoset_replist :
  assumes "Subgroup H"
  shows   "gs. is_rcoset_replist H gs"
proof-
  define r where "r = rcoset_rel H"
  hence equiv_r: "equiv G r" using rcoset_equiv[OF assms] by fast
  have "xG//r. g. g  x"
  proof
    fix x assume "x  G//r"
    from this obtain g where g: "g  G" "x = r``{g}"
      using quotient_def[of G r] by auto
    hence "g  x" using equiv_r equivE[of G r] refl_onD[of G r] by auto
    thus "g. g  x" by fast
  qed
  from this obtain f where f: "xG//r. f x  x" using bchoice by force
  from r_def have "r  G × G" using rcoset_rel_def by auto
  with finite have "finite (f`(G//r))" using finite_quotient by auto
  from this obtain gs where gs: "distinct gs" "set gs = f`(G//r)"
    using finite_distinct_list by force

  have 1: "set gs  G"
  proof
    fix g assume "g  set gs"
    with gs(2) obtain x where x: "x  G//r" "g = f x" by fast
    with f show "g  G" using equiv_r Union_quotient by fast
  qed

  moreover have "distinct (map (λg. r``{g}) gs)"
  proof-
    have "i j.  i < length (map (λg. r``{g}) gs);
                j < length (map (λg. r``{g}) gs); i  j 
                   (map (λg. r``{g}) gs)!i  (map (λg. r``{g}) gs)!j"
    proof
      fix i j assume ij:
        "i < length (map (λg. r``{g}) gs)"
        "j< length (map (λg. r``{g}) gs)"
        "i  j"
        "(map (λg. r``{g}) gs)!i = (map (λg. r``{g}) gs)!j"
      from ij(1,2) have "gs!i  set gs" "gs!j  set gs" using set_conv_nth by auto
      from this gs(2) obtain x y
        where x: "x  G//r" "gs!i = f x" and y: "y  G//r" "gs!j = f y"
        by    auto
      have "x = y"
        using equiv_r x(1) y(1)
      proof (rule quotient_eqI[of G r])
        from ij(1,2,4) have "r``{gs!i} = r``{gs!j}" by simp
        with ij(1,2) 1 show "(gs!i,gs!j)  r"
          using eq_equiv_class_iff[OF equiv_r] by force
        from x y f show "gs!i  x" "gs!j  y" by auto
      qed        
      with x(2) y(2) ij(1-3) gs(1) show False using distinct_conv_nth by fastforce
    qed
    thus ?thesis using distinct_conv_nth by fast
  qed

  moreover have "G = (gset gs. r``{g})"
  proof (rule subset_antisym, rule subsetI)
    fix g assume "g  G"
    hence rg: "r``{g}  G//r" using quotientI by fast
    with gs(2) obtain g' where g': "g'  set gs" "g' = f (r``{g})" by fast
    from f g'(2) rg have "g  r``{g'}" using equiv_r equivE sym_def[of r] by force
    with g'(1) show "g  (gset gs. r``{g})" by fast
  next
    from r_def show "G  (gset gs. r``{g})" using rcoset_rel_def by auto
  qed

  ultimately show ?thesis using r_def unfolding is_rcoset_replist_def by fastforce
qed

lemma (in FinGroup) ex_rcoset_replist_hd0 :
  assumes "Subgroup H"
  shows   "gs. is_rcoset_replist H (0#gs)"
proof-
  from assms obtain xs where xs: "is_rcoset_replist H xs"
    using ex_rcoset_replist by fast
  with assms obtain x where x: "x  set xs" "x  H"
    using rcoset_replist_Hrep by fast
  from x(2) have "(0,x)  rcoset_rel H" using rcoset0[OF assms] by auto
  moreover have "sym (rcoset_rel H)"
    using rcoset_equiv[OF assms] equivE[of G "rcoset_rel H"] by simp
  ultimately have "0  (rcoset_rel H)``{x}" using sym_def by fast
  with x(1) xs assms show "gs. is_rcoset_replist H (0#gs)" 
    using split_list rcoset_replist_reorder rcoset_replist_replacehd by fast
qed




subsection ‹Group homomorphisms›

subsubsection ‹Preliminaries›

definition ker :: "('a'b::zero)  'a set"
  where "ker f = {a. f a = 0}"

lemma kerI : "f a = 0  a  ker f"
  unfolding ker_def by fast

lemma kerD : "a  ker f  f a = 0"
  unfolding ker_def by fast

lemma ker_im_iff : "(A  {}  A  ker f) = (f ` A = 0)"
proof
  assume A: "A  {}  A  ker f"
  show "f ` A = 0"
  proof (rule zeroset_eqI)
    from A obtain a where a: "a  A" by fast
    with A have "f a = 0" using kerD by fastforce
    from this[THEN sym] a show "0  f ` A" by fast
  next
    fix b assume "b  f ` A"
    from this obtain a where "a  A" "b = f a" by fast
    with A show "b = 0" using kerD by fast
  qed
next
  assume fA: "f ` A = 0"
  have "A  {}"
  proof-
    from fA obtain a where "a  A" "f a = 0" by force
    thus ?thesis by fast
  qed
  moreover have "A  ker f"
  proof
    fix a assume "a  A"
    with fA have "f a = 0" by auto
    thus "a  ker f" using kerI by fast
  qed
  ultimately show "A  {}  A  ker f" by fast
qed

subsubsection ‹Locales›

text ‹The supp› condition is not strictly necessary, but helps with equality
        and uniqueness arguments.›

locale GroupHom = Group G
  for   G :: "'g::group_add set"
+ fixes T :: "'g  'h::group_add"
  assumes hom : "g g'. g  G  g'  G  T (g + g') = T g + T g'"
  and     supp: "supp T  G" 

abbreviation (in GroupHom) "Ker  ker T  G"
abbreviation (in GroupHom) "ImG  T ` G"

locale GroupEnd = GroupHom G T
  for G :: "'g::group_add set"
  and T :: "'g  'g"
+ assumes endomorph: "ImG  G"

locale GroupIso = GroupHom G T
  for   G :: "'g::group_add set"
  and   T :: "'g  'h::group_add"
+ fixes H :: "'h set"
  assumes bijective: "bij_betw T G H"

subsubsection ‹Basic facts›

lemma (in Group) trivial_GroupHom : "GroupHom G (0::('g'h::group_add))"
proof
  fix g g'
  define z z_map where "z = (0::'h)" and "z_map = (0::'g'h)"
  thus "z_map (g + g') = z_map g + z_map g'" by simp
qed (rule supp_zerofun_subset_any)

lemma (in Group) GroupHom_idhom : "GroupHom G (idG)"
  using add_closed supp_restrict0 by unfold_locales simp

context GroupHom
begin

lemma im_zero : "T 0 = 0"
  using zero_closed hom[of 0 0] add_diff_cancel[of "T 0" "T 0"] by simp

lemma zero_in_Ker : "0  Ker"
  using im_zero kerI zero_closed by fast

lemma comp_zero : "T  0 = 0"
  using im_zero by auto

lemma im_neg : "T (- g) = - T g"
  using im_zero hom[of g "- g"] neg_closed[of g] minus_unique[of "T g"]
        neg_closed[of "-g"] supp suppI_contra[of g T] suppI_contra[of "-g" T]
  by    fastforce

lemma im_diff : "g  G  g'  G  T (g - g') = T g - T g'"
  using hom neg_closed hom[of g "-g'"] im_neg by simp

lemma eq_im_imp_diff_in_Ker : " g  G; h  G; T g = T h   g - h  Ker"
  using im_diff kerI diff_closed[of g h] by force

lemma im_sum_list_prod : 
  "set (map (case_prod f) xys)  G
         T ((x,y)xys. f x y) = ((x,y)xys. T (f x y))"
proof (induct xys)
  case Nil
  show ?case using im_zero by simp
next
  case (Cons xy xys)
  define Tf where "Tf = T  (case_prod f)"
  have "T ((x,y)(xy#xys). f x y) = T ( (case_prod f) xy + ((x,y)xys. f x y) )"
    by simp
  moreover from Cons(2) have "(case_prod f) xy  G" "set (map (case_prod f) xys)  G"
    by auto
  ultimately have "T ((x,y)(xy#xys). f x y) = Tf xy + ((x,y)xys. Tf (x,y))"
    using Tf_def sum_list_closed[of "case_prod f"] hom Cons by auto
  also have " = ((x,y)(xy#xys). Tf (x,y))" by simp
  finally show ?case using Tf_def by simp
qed

lemma distrib_comp_sum_left :
  "range S  G  range S'  G  T  (S + S') = (T  S) + (T  S')"
  using hom by (auto simp add: fun_eq_iff)

lemma Ker_Im_iff : "(Ker = G) = (ImG = 0)"
  using nonempty ker_im_iff[of G T] by fast

lemma Ker0_imp_inj_on :
  assumes "Ker  0"
  shows   "inj_on T G"
proof (rule inj_onI)
  fix x y assume xy: "x  G" "y  G" "T x = T y"
  hence "T (x - y) = 0" using im_diff by simp
  with xy(1,2) have "x - y  Ker" using diff_closed kerI by fast
  with assms show "x = y" using zero_in_Ker by auto
qed

lemma inj_on_imp_Ker0 :
  assumes "inj_on T G"
  shows   "Ker = 0"
  using   zero_in_Ker kerD zero_closed im_zero inj_onD[OF assms]
  by      fastforce

lemma nonzero_Ker_el_imp_n_inj :
  "g  G  g  0  T g = 0  ¬ inj_on T G"
  using inj_on_imp_Ker0 kerI[of T] by auto

lemma Group_Ker : "Group Ker"
proof
  show "Ker  {}" using zero_in_Ker by fast
next
  fix g h assume "g  Ker" "h  Ker" thus "g - h  Ker"
    using im_diff kerD[of g T] kerD[of h T] diff_closed kerI[of T] by auto
qed

lemma Group_Im : "Group ImG"
proof
  show "ImG  {}" using nonempty by fast
next
  fix g' h' assume "g'  ImG" "h'  ImG"
  from this obtain g h where gh: "g  G" "g' = T g" "h  G" "h' = T h" by fast
  thus "g' - h'  ImG" using im_diff diff_closed by force
qed

lemma GroupHom_restrict0_subgroup  :
  assumes "Subgroup H"
  shows   "GroupHom H (T  H)"
proof (intro_locales, rule SubgroupD1[OF assms], unfold_locales)
  show "supp (T  H)  H" using supp_restrict0 by fast
next
  fix h h' assume hh': "h  H" "h'  H"
  with assms show "(T  H) (h + h') = (T  H) h + (T  H) h'"
    using Group.add_closed hom[of h h'] by auto
qed

lemma im_subgroup :
  assumes "Subgroup H"
  shows   "Group.Subgroup ImG (T ` H)"
proof
  from assms have "Group ((T  H) ` H)"
    using GroupHom_restrict0_subgroup GroupHom.Group_Im by fast
  moreover have "(T  H) ` H = T ` H" by auto
  ultimately show "Group (T ` H)" by simp
  from assms show "T ` H  ImG" by fast
qed

lemma GroupHom_composite_left :
  assumes "ImG  H" "GroupHom H S"
  shows   "GroupHom G (S  T)"
proof
  fix g g' assume "g  G" "g'  G"
  with hom assms(1) show "(S  T) (g + g') = (S  T) g + (S  T) g'"
    using GroupHom.hom[OF assms(2)] by fastforce
next
  from supp have "g. g  G  (S  T) g = 0"
    using suppI_contra GroupHom.im_zero[OF assms(2)] by fastforce
  thus "supp (S  T)  G" using suppD_contra by fast
qed

lemma idhom_left : "T ` G  H  (idH)  T = T"
  using supp suppI_contra by fastforce

end (* context GroupHom *)

subsubsection ‹Basic facts about endomorphisms›

context GroupEnd
begin

lemmas hom = hom

lemma range : "range T  G"
proof (rule image_subsetI)
  fix x show "T x  G"
  proof (cases "x  G")
    case True with endomorph show ?thesis by fast
  next
    case False with supp show ?thesis using suppI_contra zero_closed by fastforce
  qed
qed

lemma proj_decomp :
  assumes "g. g  G  T (T g) = T g"
  shows   "G = Ker  ImG"
proof (rule inner_dirsum_doubleI, rule subset_antisym, rule subsetI)
  fix g assume g: "g  G"
  have "g = (g - T g) + T g" using diff_add_cancel[of g] by simp
  moreover have "g - T g  Ker"
  proof
    from g endomorph assms have "T (g - T g) = 0" using im_diff by auto
    thus "g - T g  ker T" using kerI by fast
    from g endomorph show "g - T g  G" using diff_closed by fast
  qed
  moreover from g have "T g  ImG" by fast
  ultimately show "g  Ker + ImG"
    using set_plus_intro[of "g - T g" Ker "T g"] by simp
next
  from endomorph show "G  Ker + ImG" using set_plus_closed by simp
  show "add_independentS [Ker,ImG]"
  proof (rule add_independentS_doubleI)
    fix g h assume gh: "h  ImG" "g  Ker" "g + h = 0"
    from gh(1) obtain g' where "g'  G" "h = T g'" by fast
    with gh(2,3) endomorph assms have "h = 0"
      using im_zero hom[of g "T g'"] kerD by fastforce
    with gh(3) show "g = 0" by simp
  qed
qed

end (* context GroupEnd *)

subsubsection ‹Basic facts about isomorphisms›

context GroupIso
begin

abbreviation "invT  (the_inv_into G T)  H"

lemma ImG : "ImG = H" using bijective bij_betw_imp_surj_on by fast

lemma GroupH : "Group H" using ImG Group_Im by fast

lemma invT_onto : "invT ` H = G"
  using bijective bij_betw_imp_inj_on[of T] ImG the_inv_into_onto[of T] by force

lemma inj_on_invT : "inj_on invT H"
  using     bijective bij_betw_imp_inj_on[of T G] ImG inj_on_the_inv_into[of T]
  unfolding inj_on_def
  by        force

lemma bijective_invT : "bij_betw invT H G"
  using inj_on_invT invT_onto unfolding bij_betw_def by fast

lemma invT_into : "h  H  invT h  G"
  using bijective bij_betw_imp_inj_on ImG the_inv_into_into[of T] by force

lemma T_invT : "h  H  T (invT h) = h"
  using bijective bij_betw_imp_inj_on ImG f_the_inv_into_f[of T] by force

lemma invT_eq: "g  G  T g = h  invT h = g"
  using bijective bij_betw_imp_inj_on ImG the_inv_into_f_eq[of T] by force

lemma inv : "GroupIso H invT G"
proof (intro_locales, rule GroupH, unfold_locales)
  show "supp invT  H" using supp_restrict0 by fast
  show "bij_betw invT H G" using bijective_invT by fast
next
  fix h h' assume "h  H" "h'  H"
  thus "invT (h + h') = invT h + invT h'"
    using invT_into hom T_invT add_closed invT_eq by simp
qed

end (* context GroupIso *)

subsubsection ‹Hom-sets›

definition GroupHomSet :: "'g::group_add set  'h::group_add set  ('g  'h) set"
  where "GroupHomSet G H  {T. GroupHom G T}  {T. T ` G  H}"

lemma GroupHomSetI :
  "GroupHom G T  T ` G  H  T  GroupHomSet G H"
  unfolding GroupHomSet_def by fast

lemma GroupHomSetD_GroupHom :
  "T  GroupHomSet G H  GroupHom G T"
  unfolding GroupHomSet_def by fast

lemma GroupHomSetD_Im : "T  GroupHomSet G H  T ` G  H"
  unfolding GroupHomSet_def by fast

lemma (in Group) Group_GroupHomSet :
  fixes   H :: "'h::ab_group_add set"
  assumes "AbGroup H"
  shows   "Group (GroupHomSet G H)"
proof
  show "GroupHomSet G H  {}"
    using trivial_GroupHom AbGroup.zero_closed[OF assms] GroupHomSetI
    by    fastforce
next
  fix S T assume ST: "S  GroupHomSet G H" "T  GroupHomSet G H"
  show "S - T  GroupHomSet G H"
  proof (rule GroupHomSetI, unfold_locales)
    from ST show "supp (S - T)  G" 
      using GroupHomSetD_GroupHom[of S] GroupHomSetD_GroupHom[of T]
            GroupHom.supp[of G S] GroupHom.supp[of G T]
            supp_diff_subset_union_supp[of S T]
      by    auto
    show "(S - T) ` G  H"
    proof (rule image_subsetI)
      fix g assume "g  G"
      with ST have "S g  H" "T g  H"
        using GroupHomSetD_Im[of S G] GroupHomSetD_Im[of T G] by auto
      thus "(S - T) g  H" using AbGroup.diff_closed[OF assms] by simp
    qed
  next 
    fix g g' assume "g  G" "g'  G"
    with ST show "(S - T) (g + g') = (S - T) g + (S - T) g'"
      using GroupHomSetD_GroupHom[of S] GroupHom.hom[of G S]
            GroupHomSetD_GroupHom[of T] GroupHom.hom[of G T]
      by    simp
  qed
qed




subsection ‹Facts about collections of groups›

lemma listset_Group_plus_closed :
  " Gset Gs. Group G; as  listset Gs; bs  listset Gs
                                                 [a+b. (a,b)zip as bs]  listset Gs"
proof-
  have " length as = length bs; length bs = length Gs;
                as  listset Gs; bs  listset Gs; Gset Gs. Group G
                                                 [a+b. (a,b)zip as bs]  listset Gs"
  proof (induct as bs Gs rule: list_induct3)
    case (Cons a as b bs G Gs)
    thus "[x+y. (x,y)zip (a#as) (b#bs)]  listset (G#Gs)"
      using listset_ConsD[of a] listset_ConsD[of b] Group.add_closed
            listset_ConsI[of "a+b" G]
      by    fastforce
  qed simp
  thus   " Gset Gs. Group G; as  listset Gs; bs  listset Gs
                                                 [a+b. (a,b)zip as bs]  listset Gs"
    using listset_length[of as Gs] listset_length[of bs Gs, THEN sym] by fastforce
qed

lemma AbGroup_set_plus :
  assumes "AbGroup H" "AbGroup G"
  shows   "AbGroup (H + G)"
proof
  from assms show "H + G  {}" using AbGroup.nonempty by blast
next
  fix x y assume "x  H + G" "y  H + G"
  from this obtain xh xg yh yg
    where xy: "xh  H" "xg  G" "x = xh + xg" "yh  H" "yg  G" "y = yh + yg"
    unfolding set_plus_def by fast
  hence "x - y = (xh - yh) + (xg - yg)" by simp
  thus "x - y  H + G" using assms xy(1,2,4,5) AbGroup.diff_closed by auto
qed

lemma AbGroup_sum_list :
  "(Gset Gs. AbGroup G)  AbGroup (GGs. G)"
  using trivial_Group AbGroup.intro AbGroup_set_plus
  by    (induct Gs) auto

lemma AbGroup_subset_sum_list :
  "G  set Gs. AbGroup G  H  set Gs  H  (GGs. G)"
proof (induct Gs arbitrary: H)
  case (Cons G Gs)
  show "H  (X(G#Gs). X)"
  proof (cases "H = G")
    case True with Cons(2) show ?thesis
      using AbGroup_sum_list AbGroup.subset_plus_left by auto
  next
    case False
    with Cons have "H  (GGs. G)" by simp
    with Cons(2) show ?thesis using AbGroup.subset_plus_right by auto
  qed
qed simp

lemma independent_AbGroups_pairwise_int0 :
  " Gset Gs. AbGroup G; add_independentS Gs; G  set Gs; G'  set Gs;
        G  G'   G  G' = 0"
proof (induct Gs arbitrary: G G')
  case (Cons H Hs)
  from Cons(1-3) have "A B.  A  set Hs; B  set Hs; A  B  
                             A  B  0"
    by simp
  moreover have "A. A  set Hs  A  H   A  H  0"
  proof
    fix A g assume A: "A  set Hs" "A  H" and g: "g  A  H"
    from A(1) g Cons(2) have "-g  (XHs. X)"
      using AbGroup.neg_closed AbGroup_subset_sum_list by force
    moreover have "g + (-g) = 0" by simp
    ultimately show "g  0" using g Cons(3) by simp
  qed
  ultimately have "A B.  A  set (H#Hs); B  set (H#Hs); A  B 
                         A  B  0"
    by auto
  with Cons(4-6) have "G  G'  0" by fast
  moreover from Cons(2,4,5) have "0  G  G'"
    using AbGroup.zero_closed by auto
  ultimately show ?case by fast
qed simp

lemma independent_AbGroups_pairwise_int0_double :
  assumes "AbGroup G" "AbGroup G'" "add_independentS [G,G']"
  shows   "G  G' = 0"
proof (cases "G = 0")
  case True with assms(2) show ?thesis using AbGroup.zero_closed by auto
next
  case False show ?thesis
  proof (rule independent_AbGroups_pairwise_int0)
    from assms(1,2) show "Gset [G,G']. AbGroup G" by simp
    from assms(3) show "add_independentS [G,G']" by fast
    show "G  set [G,G']" "G'  set [G,G']" by auto
    show "G  G'"
    proof
      assume GG': "G = G'"
      from False assms(1) obtain g where g: "g  G" "g  0"
        using AbGroup.nonempty by auto
      moreover from assms(2) GG' g(1) have "-g  G'"
        using AbGroup.neg_closed by fast
      moreover have "g + (-g) = 0" by simp
      ultimately show False using assms(3) by force
    qed
  qed
qed


subsection ‹Inner direct sums of Abelian groups›

subsubsection ‹General facts›

lemma AbGroup_inner_dirsum :
  "Gset Gs. AbGroup G  AbGroup (GGs. G)"
  using inner_dirsumD[of Gs] inner_dirsumD2[of Gs] AbGroup_sum_list AbGroup.intro
        trivial_Group
  by    (cases "add_independentS Gs") auto

lemma inner_dirsum_double_leftfull_imp_right0:
  assumes "Group A" "B  {}" "A = A  B"
  shows   "B = 0"
proof (cases "add_independentS [A,B]")
  case True
  with assms(3) have 1: "A = A + B" using inner_dirsum_doubleD by fast
  have "b. b  B  b = 0"
  proof-
    fix b assume b: "b  B"
    from assms(1) obtain a where a: "a  A" using Group.nonempty by fast
    with b 1 have "a + b  A" by fast
    from this obtain a' where a': "a'  A" "a + b = a'" by fast
    hence "(-a'+a) + b = 0" by (simp add: add.assoc)
    with assms(1) True a a'(1) b show "b = 0"
      using Group.neg_add_closed[of A] add_independentS_doubleD[of A B b "-a'+a"]
      by    simp
  qed
  with assms(2) show ?thesis by auto
next
  case False
  hence 1: "A  B = 0" unfolding inner_dirsum_def by auto
  moreover with assms(3) have "A = 0" by fast
  ultimately show ?thesis using inner_dirsum_double_left0 by auto
qed

lemma AbGroup_subset_inner_dirsum :
  " G  set Gs. AbGroup G; add_independentS Gs; H  set Gs 
         H  (GGs. G)"
  using AbGroup_subset_sum_list inner_dirsumD by fast

lemma AbGroup_nth_subset_inner_dirsum :
  " G  set Gs. AbGroup G; add_independentS Gs; n < length Gs 
         Gs!n  (GGs. G)"
  using AbGroup_subset_inner_dirsum by force

lemma AbGroup_inner_dirsum_el_decomp_ex1_double :
  assumes "AbGroup G" "AbGroup H" "add_independentS [G,H]" "x  G  H"
  shows   "∃!gh. fst gh  G  snd gh  H  x = fst gh + snd gh"
proof (rule ex_ex1I)
  from assms(3,4) obtain g h where "x = g + h" "g  G" "h  H"
    using inner_dirsum_doubleD set_plus_elim by blast
  from this have 1: "fst (g,h)  G" "snd (g,h)  H" "x = fst (g,h) + snd (g,h)"
    by auto
  thus "gh. fst gh  G  snd gh  H  x = fst gh + snd gh" by fast
next
  fix gh gh' assume A:
    "fst gh   G  snd gh   H  x = fst gh  + snd gh "
    "fst gh'  G  snd gh'  H  x = fst gh' + snd gh'"
  show "gh = gh'"
  proof
    from A assms(1,2) have "fst gh - fst gh'  G" "snd gh - snd gh'  H"
      using AbGroup.diff_closed by auto
    moreover from A have z: "(fst gh - fst gh') + (snd gh - snd gh') = 0"
      by (simp add: algebra_simps)
    ultimately show "fst gh = fst gh'"
      using assms(3)
            add_independentS_doubleD[of G H "snd gh - snd gh'" "fst gh - fst gh'"]
      by    simp
    with z show "snd gh = snd gh'" by simp
  qed
qed

lemma AbGroup_inner_dirsum_el_decomp_ex1 :
  " G  set Gs. AbGroup G; add_independentS Gs 
         x  (GGs. G). ∃!gslistset Gs. x = sum_list gs"
proof (induct Gs)
  case Nil
  have "x::'a. x  (H[]. H)  ∃!gslistset []. x = sum_list gs"
  proof
    fix x::'a assume "x  (G[]. G)"
    moreover define f :: "'a  'a list" where "f x = []" for x
    ultimately show "f x  listset []  x = sum_list (f x)"
      using inner_dirsum_Nil by auto
  next
    fix x::'a and gs
    assume  x: "x  (G[]. G)"
    and    gs: "gs  listset []  x = sum_list gs"
    thus "gs = []" by simp
  qed
  thus "x::'a  (H[]. H). ∃!gslistset []. x = sum_list gs" by fast
next
  case (Cons G Gs)
  hence prevcase: "x(HGs. H). ∃!gslistset Gs. x = sum_list gs" by auto
  from Cons(2) have grps: "AbGroup G" "AbGroup (HGs. H)"
    using AbGroup_inner_dirsum by auto
  from Cons(3) have ind: "add_independentS [G, HGs. H]"
    using add_independentS_Cons_conv_dirsum_right by fast
  have "x. x  (H(G#Gs). H)  ∃!gslistset (G#Gs). x = sum_list gs"
  proof (rule ex_ex1I)
    fix x assume "x  (H(G#Gs). H)"
    with Cons(3) have "x  G  (HGs. H)"
      using inner_dirsum_Cons by fast
    with grps ind obtain gh
      where gh: "fst gh  G" "snd gh  (HGs. H)" "x = fst gh + snd gh"
      using AbGroup_inner_dirsum_el_decomp_ex1_double
      by    blast
    from gh(2) prevcase obtain gs where gs: "gs  listset Gs" "snd gh = sum_list gs"
      by fast
    with gh(1) gs(1) have "fst gh # gs  listset (G#Gs)"
      using set_Cons_def by fastforce
    moreover from gh(3) gs(2) have "x = sum_list (fst gh # gs)" by simp
    ultimately show "gs. gs  listset (G#Gs)  x = sum_list gs" by fast
  next
    fix x gs hs
    assume "x  (H(G#Gs). H)"
      and gs: "gs  listset (G#Gs)  x = sum_list gs"
      and hs: "hs  listset (G#Gs)  x = sum_list hs"
    hence "gs  set_Cons G (listset Gs)" "hs  set_Cons G (listset Gs)" by auto
    from this obtain a as b bs
      where     a_as: "gs = a#as" "aG" "as  listset Gs"
      and       b_bs: "hs = b#bs" "bG" "bs  listset Gs"
      unfolding set_Cons_def
      by        fast
    from a_as(3) b_bs(3) Cons(3) 
      have  as: "sum_list as  (HGs. H)" and bs: "sum_list bs  (HGs. H)"
      using sum_list_listset_dirsum
      by    auto
    with a_as(2) b_bs(2) grps
      have  "a - b  G" "sum_list as - sum_list bs  (HGs. H)"
      using AbGroup.diff_closed
      by    auto
    moreover from gs hs a_as(1) b_bs(1)
      have z: "(a - b) + (sum_list as - sum_list bs) = 0"
      by   (simp add: algebra_simps)
    ultimately have "a - b = 0" using ind add_independentS_doubleD by blast
    with z have 1: "a = b" and z': "sum_list as = sum_list bs" by auto
    from z' prevcase as a_as(3) bs b_bs(3) have 2: "as = bs" by fast
    from 1 2 a_as(1) b_bs(1) show "gs = hs" by fast
  qed
  thus "x(H(G#Gs). H). ∃!gs. gs  listset (G#Gs)  x = sum_list gs"
    by fast
qed

lemma AbGroup_inner_dirsum_pairwise_int0 :
  " G  set Gs. AbGroup G; add_independentS Gs; G  set Gs; G'  set Gs;
        G  G'   G  G' = 0"
proof (induct Gs arbitrary: G G')
  case (Cons H Hs)
  from Cons(1-3) have "A B.  A  set Hs; B  set Hs; A  B  
                             A  B  0"
    by simp
  moreover have "A. A  set Hs  A  H   A  H  0"
  proof
    fix A g assume A: "A  set Hs" "A  H" and g: "g  A  H"
    from A(1) g Cons(2) have "-g  (XHs. X)"
      using AbGroup.neg_closed AbGroup_subset_sum_list by force
    moreover have "g + (-g) = 0" by simp
    ultimately show "g  0" using g Cons(3) by simp
  qed
  ultimately have "A B.  A  set (H#Hs); B  set (H#Hs); A  B  
                         A  B  0"
    by auto
  with Cons(4-6) have "G  G'  0" by fast
  moreover from Cons(2,4,5) have "0  G  G'"
    using AbGroup.zero_closed by auto
  ultimately show ?case by fast
qed simp

lemma AbGroup_inner_dirsum_pairwise_int0_double :
  assumes "AbGroup G" "AbGroup G'" "add_independentS [G,G']"
  shows   "G  G' = 0"
proof (cases "G = 0")
  case True with assms(2) show ?thesis using AbGroup.zero_closed by auto
next
  case False show ?thesis
  proof (rule AbGroup_inner_dirsum_pairwise_int0)
    from assms(1,2) show "Gset [G,G']. AbGroup G" by simp
    from assms(3) show "add_independentS [G,G']" by fast
    show "G  set [G,G']" "G'  set [G,G']" by auto
    show "G  G'"
    proof
      assume GG': "G = G'"
      from False assms(1) obtain g where g: "g  G" "g  0"
        using AbGroup.nonempty by auto
      moreover from assms(2) GG' g(1) have "-g  G'"
        using AbGroup.neg_closed by fast
      moreover have "g + (-g) = 0" by simp
      ultimately show False using assms(3) by force
    qed
  qed
qed

subsubsection ‹Element decomposition and projection›

definition inner_dirsum_el_decomp ::
  "'g::ab_group_add set list  ('g  'g list)" ("_")
  where "Gs = (λx. if x  (GGs. G)
              then THE gs. gs  listset Gs  x = sum_list gs else [])"

abbreviation inner_dirsum_el_decomp_double ::
  "'g::ab_group_add set  'g set  ('g  'g list)" ("__") where "GH  [G,H]"

abbreviation inner_dirsum_el_decomp_nth ::
  "'g::ab_group_add set list  nat  ('g  'g)" ("__")
  where "Gsn  restrict0 (λx. (Gsx)!n) (GGs. G)"

lemma AbGroup_inner_dirsum_el_decompI :
  " G  set Gs. AbGroup G; add_independentS Gs; x  (GGs. G) 
         (Gsx)  listset Gs  x = sum_list (Gsx)"
  using     AbGroup_inner_dirsum_el_decomp_ex1 theI'[
              of "λgs. gs  listset Gs  x = sum_list gs"
            ]
  unfolding inner_dirsum_el_decomp_def
  by        fastforce

lemma (in AbGroup) abSubgroup_inner_dirsum_el_decomp_set :
  " H  set Hs. Subgroup H; add_independentS Hs; x  (HHs. H) 
     set (Hsx)  G"
  using AbGroup.intro AbGroup_inner_dirsum_el_decompI[of Hs x]
        set_listset_el_subset[of "(Hsx)" Hs G]
  by    fast

lemma AbGroup_inner_dirsum_el_decomp_eq :
  " G  set Gs. AbGroup G; add_independentS Gs; x  (GGs. G);
        gs  listset Gs; x = sum_list gs   (Gsx) = gs"
  using AbGroup_inner_dirsum_el_decomp_ex1[of Gs]
        inner_dirsum_el_decomp_def[of Gs]
  by    force

lemma AbGroup_inner_dirsum_el_decomp_plus :
  assumes "G  set Gs. AbGroup G" "add_independentS Gs" "x  (GGs. G)"
          "y  (GGs. G)"
  shows   "(Gs(x+y)) = [a+b. (a,b)zip (Gsx) (Gsy)]"
proof-
  define xs ys where "xs = (Gsx)" and "ys = (Gsy)"
  with assms
    have  xy: "xs  listset Gs" "x = sum_list xs" "ys  listset Gs" "y = sum_list ys"
    using AbGroup_inner_dirsum_el_decompI
    by    auto
  from assms(1) xy(1,3) have "[a+b. (a,b)zip xs ys]  listset Gs"
    using AbGroup.axioms listset_Group_plus_closed by fast
  moreover from xy have "x + y = sum_list [a+b. (a,b)zip xs ys]"
    using listset_length[of xs Gs] listset_length[of ys Gs, THEN sym] sum_list_plus
    by    simp
  ultimately show "(Gs(x+y)) = [a+b. (a,b)zip xs ys]"
    using assms AbGroup_inner_dirsum AbGroup.add_closed
          AbGroup_inner_dirsum_el_decomp_eq
    by    fast
qed

lemma AbGroup_length_inner_dirsum_el_decomp :
  " G  set Gs. AbGroup G; add_independentS Gs; x  (GGs. G) 
         length (Gsx) = length Gs"
  using AbGroup_inner_dirsum_el_decompI listset_length by fastforce

lemma AbGroup_inner_dirsum_el_decomp_in_nth :
  assumes "G  set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
          "x  Gs!n"
  shows   "(Gsx) = (replicate (length Gs) 0)[n := x]"
proof-
  from assms have x: "x  (GGs. G)"
    using AbGroup_nth_subset_inner_dirsum by fast
  define xgs where "xgs = (replicate (length Gs) (0::'a))[n := x]"
  hence "length xgs = length Gs" by simp
  moreover have "k<length xgs. xgs!k  Gs!k"
  proof-
    have "k. k < length xgs  xgs!k  Gs!k"
    proof-
      fix k assume "k < length xgs"
      with assms(1,4) xgs_def show "xgs!k  Gs!k" 
        using AbGroup.zero_closed[of "Gs!k"] by (cases "k = n") auto
    qed
    thus ?thesis by fast
  qed
  ultimately have "xgs  listset Gs" using listsetI_nth by fast
  moreover from xgs_def assms(3) have "x = sum_list xgs"
    using sum_list_update[of n "replicate (length Gs) 0" x] nth_replicate sum_list_replicate0
    by    simp
  ultimately show "(Gsx) = xgs"
    using assms(1,2) x xgs_def AbGroup_inner_dirsum_el_decomp_eq by fast
qed

lemma AbGroup_inner_dirsum_el_decomp_nth_in_nth :
  " G  set Gs. AbGroup G; add_independentS Gs; k < length Gs;
        n < length Gs; x  Gs!n   (Gsk) x = (if k = n then x else 0)"
  using AbGroup_nth_subset_inner_dirsum
        AbGroup_inner_dirsum_el_decomp_in_nth[of Gs n x]
  by    auto

lemma AbGroup_inner_dirsum_el_decomp_nth_id_on_nth :
  " G  set Gs. AbGroup G; add_independentS Gs; n < length Gs; x  Gs!n  
         (Gsn) x = x"
  using AbGroup_inner_dirsum_el_decomp_nth_in_nth by fastforce

lemma AbGroup_inner_dirsum_el_decomp_nth_onto_nth :
  assumes "G  set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
  shows   "(Gsn) ` (GGs. G) = Gs!n"
proof
  from assms show "(Gsn) ` (GGs. G)  Gs!n"
    using AbGroup_nth_subset_inner_dirsum[of Gs n]
          AbGroup_inner_dirsum_el_decomp_nth_id_on_nth[of Gs n]
    by    force
  from assms show "(Gsn) ` (GGs. G)  Gs!n"
      using AbGroup_inner_dirsum_el_decompI listset_length listsetD_nth by fastforce
qed

lemma AbGroup_inner_dirsum_subset_proj_eq_0 :
  assumes "Gs  []" "G  set Gs. AbGroup G" "add_independentS Gs"
          "X  (GGs. G)" "i < length Gs. (Gsi) ` X = 0"
  shows   "X = 0"
proof-
  have "X  0"
  proof
    fix x assume x: "x  X"
    with assms(2-4) have "x = (i=0..< length Gs. (Gsi) x)"
      using AbGroup_inner_dirsum_el_decompI sum_list_sum_nth[of "(Gsx)"]
            AbGroup_length_inner_dirsum_el_decomp
      by    fastforce
    moreover from x assms(5) have "i<length Gs. (Gsi) x = 0" by auto
    ultimately show "x  0" by simp
  qed
  moreover from assms(1,5) have "X  {}" by auto
  ultimately show ?thesis by auto
qed

lemma GroupEnd_inner_dirsum_el_decomp_nth :
  assumes "G  set Gs. AbGroup G" "add_independentS Gs" "n < length Gs"
  shows   "GroupEnd (GGs. G) (Gsn)"
proof (intro_locales)
  from assms(1) show grp: "Group (GGs. G)"
    using AbGroup_inner_dirsum AbGroup.axioms by fast
  show "GroupHom_axioms (GGs. G) Gsn"
  proof
    show "supp (Gsn)  (GGs. G)" using supp_restrict0 by fast
  next
    fix x y assume xy: "x  (GGs. G)" "y  (GGs. G)"
    with assms(1,2) have "(Gs(x+y)) = [x+y. (x,y)zip (Gsx) (Gsy)]"
      using AbGroup_inner_dirsum_el_decomp_plus by fast
    hence "(Gs(x+y)) = map (case_prod (+)) (zip (Gsx) (Gsy))"
      using concat_map_split_eq_map_split_zip by simp
    moreover from assms xy
      have  "n < length (Gsx)" "n < length (Gsy)"
            "n < length (zip (Gsx) (Gsy))"
      using AbGroup_length_inner_dirsum_el_decomp[of Gs x]
            AbGroup_length_inner_dirsum_el_decomp[of Gs y]
      by    auto
    ultimately show "(Gsn) (x + y) = (Gsn) x + (Gsn) y"
      using xy assms(1) AbGroup_inner_dirsum
            AbGroup.add_closed[of "GGs. G"]
      by    auto
  qed
  show "GroupEnd_axioms (GGs. G) Gsn"
    using assms AbGroup_inner_dirsum_el_decomp_nth_onto_nth AbGroup_nth_subset_inner_dirsum
    by    unfold_locales fast
qed


subsection ‹Rings›

subsubsection ‹Preliminaries›

lemma (in ring_1) map_times_neg1_eq_map_uminus : "[(-1)*r. rrs] = [-r. rrs]"
  using map_eq_conv by simp

subsubsection ‹Locale and basic facts›

text ‹Define a Ring1› to be a multiplicatively closed additive subgroup of @{term UNIV} for
        the ring_1› class.›

(* Don't need to use AbGroup for R because ring_1 already assumes add_commute *)
locale Ring1 = Group R
  for R :: "'r::ring_1 set"
+ assumes one_closed : "1  R"
  and     mult_closed: "r s. r  R  s  R  r * s  R"
begin

lemma AbGroup : "AbGroup R"
  using Ring1_axioms Ring1.axioms(1) AbGroup.intro by fast

lemmas zero_closed         = zero_closed
lemmas add_closed          = add_closed
lemmas neg_closed          = neg_closed
lemmas diff_closed         = diff_closed
lemmas zip_add_closed      = zip_add_closed
lemmas sum_closed       = AbGroup.sum_closed[OF AbGroup]
lemmas sum_list_closed      = sum_list_closed
lemmas sum_list_closed_prod = sum_list_closed_prod
lemmas list_diff_closed    = list_diff_closed

abbreviation Subring1 :: "'r set  bool" where "Subring1 S  Ring1 S  S  R"

lemma Subring1D1 : "Subring1 S  Ring1 S" by fast

end (* context Ring1 *)

lemma (in ring_1) full_Ring1 : "Ring1 UNIV" 
  by unfold_locales auto


subsection ‹The group ring›

subsubsection ‹Definition and basic facts›

text ‹
  Realize the group ring as the set of almost-every-zero functions from group to ring. One can
  recover the usual notion of group ring element by considering such a function to send group
  elements to their coefficients. Here the codomain of such functions is not restricted to some
  Ring1› subset since we will not be interested in having the ability to change the ring of
  scalars for a group ring.
›

context Group
begin

abbreviation group_ring :: "('a::zero, 'g) aezfun set"
  where "group_ring  aezfun_setspan G"

lemmas group_ringD = aezfun_setspan_def[of G]

lemma RG_one_closed : "(1::('r::zero_neq_one,'g) aezfun)  group_ring"
proof-
  have "supp (aezfun (1::('r,'g) aezfun))  G"
    using supp_aezfun1 zeroS_closed by fast
  thus ?thesis using group_ringD by fast
qed

lemma RG_zero_closed : "(0::('r::zero,'g) aezfun)  group_ring"
proof-
  have "aezfun (0::('r,'g) aezfun) = (0::'g'r)" using zero_aezfun.rep_eq by fast
  hence "supp (aezfun (0::('r,'g) aezfun)) = supp (0::'g'r)" by simp
  moreover have "supp (0::'g'r)  G" using supp_zerofun_subset_any by fast
  ultimately show ?thesis using group_ringD by fast
qed

lemma RG_n0 : "group_ring  (0::('r::zero_neq_one, 'g) aezfun set)"
  using RG_one_closed zero_neq_one by force

lemma RG_mult_closed :
  defines RG: "RG  group_ring :: ('r::ring_1, 'g) aezfun set"
  shows   "x  RG  y  RG  x * y  RG"
  using   RG supp_aezfun_times[of x y]
          set_plus_closed[of "supp (aezfun x)" "supp (aezfun y)"]
          group_ringD
  by      blast

lemma Ring1_RG :
  defines RG: "RG  group_ring :: ('r::ring_1, 'g) aezfun set"
  shows   "Ring1 RG"
proof
  from RG show "RG  {}" "1  RG" "x y. x  RG  y  RG  x * y  RG"
    using RG_one_closed RG_mult_closed by auto
next
  fix x y assume "x  RG" "y  RG"
  with RG show "x - y  RG" using supp_aezfun_diff[of x y] group_ringD by blast
qed

lemma RG_aezdeltafun_closed :
  defines RG: "RG  group_ring :: ('r::ring_1, 'g) aezfun set"
  assumes "g  G"
  shows   "r δδ g  RG"
proof-
  have supp: "supp (aezfun (r δδ g)) = supp (r δ g)"
    using aezdeltafun arg_cong[of _ _ "supp"] by fast
  have "supp (aezfun (r δδ g))  G"
  proof (cases "r = 0")
    case True with supp show ?thesis using supp_delta0fun by fast
  next
    case False with assms supp show ?thesis using supp_deltafun[of r g] by fast
  qed
  with RG show ?thesis using group_ringD by fast
qed

lemma RG_aezdelta0fun_closed : "(r::'r::ring_1) δδ 0  group_ring"
  using zero_closed RG_aezdeltafun_closed[of 0] by fast

lemma RG_sum_list_rddg_closed :
  defines RG: "RG  group_ring :: ('r::ring_1, 'g) aezfun set"
  assumes "set (map snd rgs)  G"
  shows   "((r,g)rgs. r δδ g)  RG"
proof (rule Ring1.sum_list_closed_prod)
  from RG show "Ring1 RG" using Ring1_RG by fast
  from assms show "set (map (case_prod aezdeltafun) rgs)  RG"
    using RG_aezdeltafun_closed by fastforce
qed

lemmas RG_el_decomp_aezdeltafun = aezfun_setspan_el_decomp_aezdeltafun[of _ G]

lemma Subgroup_imp_Subring :
  fixes   H  :: "'g set"
  and     FH :: "('r::ring_1,'g) aezfun set"
  and     FG :: "('r,'g) aezfun set"
  defines "FH  Group.group_ring H"
  and     "FG  group_ring"
  shows   "Subgroup H  Ring1.Subring1 FG FH"
  using   assms Group.Ring1_RG Group.RG_el_decomp_aezdeltafun RG_sum_list_rddg_closed
  by      fast

end (* context Group *)

lemma (in FinGroup) group_ring_spanning_set :
  "gs. distinct gs  set gs = G
         (f (group_ring :: ('b::semiring_1, 'g) aezfun set). bs.
          length bs = length gs  f = ((b,g)zip bs gs. (b δδ 0) * (1 δδ g)) )"
  using     finite aezfun_common_supp_spanning_set_decomp[of G] group_ringD
  by        fast

subsubsection ‹Projecting almost-everywhere-zero functions onto a group ring›

context Group
begin

abbreviation "RG_proj  aezfun_setspan_proj G"

lemmas RG_proj_in_RG        = aezfun_setspan_proj_in_setspan
lemmas RG_proj_sum_list_prod = aezfun_setspan_proj_sum_list_prod[of G]

lemma RG_proj_mult_leftdelta' :
  fixes   r s :: "'r::{comm_monoid_add,mult_zero}"
  shows   "g  G  RG_proj (r δδ g * (s δδ g')) = r δδ g * RG_proj (s δδ g')"
  using   add_closed add_closed_inverse_right times_aezdeltafun_aezdeltafun[of r g]
          aezfun_setspan_proj_aezdeltafun[of G "r*s"]
          aezfun_setspan_proj_aezdeltafun[of G s]
  by      simp

lemma RG_proj_mult_leftdelta :
  fixes   r :: "'r::semiring_1"
  assumes "g  G"
  shows   "RG_proj ((r δδ g) * x) = r δδ g * RG_proj x"
proof-                                                                                
  from aezfun_decomp_aezdeltafun obtain rgs
    where rgs: "x = ((s,h)rgs. s δδ h)"
    using RG_el_decomp_aezdeltafun
    by    fast
  hence "RG_proj ((r δδ g) * x) = ((s,h)rgs. RG_proj ((r δδ g) * (s δδ h)))"
    using sum_list_const_mult_prod[of "r δδ g" "λs h. s δδ h"] RG_proj_sum_list_prod
    by    simp
  also from assms rgs have " = (r δδ g) * RG_proj x"
    using RG_proj_mult_leftdelta'[of g r]
          sum_list_const_mult_prod[of "r δδ g" "λs h. RG_proj (s δδ h)"]
          RG_proj_sum_list_prod[of "λs h. s δδ h" rgs]
    by    simp
  finally show ?thesis by fast
qed

lemma RG_proj_mult_rightdelta' :
  fixes   r s :: "'r::{comm_monoid_add,mult_zero}"
  assumes "g'  G"
  shows   "RG_proj (r δδ g * (s δδ g')) = RG_proj (r δδ g) * (s δδ g')"
  using   assms times_aezdeltafun_aezdeltafun[of r g]
          aezfun_setspan_proj_aezdeltafun[of G "r*s"]
          add_closed add_closed_inverse_left aezfun_setspan_proj_aezdeltafun[of G r]
  by      simp

lemma RG_proj_mult_rightdelta :
  fixes   r :: "'r::semiring_1"
  assumes "g  G"
  shows   "RG_proj (x * (r δδ g)) = (RG_proj x) * (r δδ g)"
proof-
  from aezfun_decomp_aezdeltafun obtain rgs
    where rgs: "x = ((s,h)rgs. s δδ h)"
    using RG_el_decomp_aezdeltafun
    by    fast
  hence "RG_proj (x * (r δδ g)) = ((s,h)rgs. RG_proj ((s δδ h) * (r δδ g)))"
    using sum_list_mult_const_prod[of "λs h. s δδ h" rgs] RG_proj_sum_list_prod
    by    simp
  with assms rgs show ?thesis
    using RG_proj_mult_rightdelta'[of g _ _ r]
          sum_list_prod_cong[of
            rgs "λs h. RG_proj ((s δδ h) * (r δδ g))"
            "λs h. RG_proj (s δδ h) * (r δδ g)"
          ]
          sum_list_mult_const_prod[of "λs h. RG_proj (s δδ h)" rgs]
          RG_proj_sum_list_prod[of "λs h. s δδ h" rgs]
          sum_list_mult_const_prod[of "λs h. RG_proj (s δδ h)" rgs "r δδ g"]
          RG_proj_sum_list_prod[of "λs h. s δδ h" rgs]
    by    simp
qed

lemma RG_proj_mult_right :
  "x  (group_ring :: ('r::ring_1, 'g) aezfun set)
         RG_proj (y * x) = RG_proj y * x"
  using RG_el_decomp_aezdeltafun sum_list_const_mult_prod[of y "λr g. r δδ g"]
        RG_proj_sum_list_prod[of "λr g. y * (r δδ g)"] RG_proj_mult_rightdelta[of _ y]
        sum_list_prod_cong[
          of _ "λr g. RG_proj (y * (r δδ g))" "λr g. RG_proj y * (r δδ g)"
        ]
        sum_list_const_mult_prod[of "RG_proj y" "λr g. r δδ g"]
  by    fastforce

end (* context Group *)


section ‹Modules›


subsection ‹Locales and basic facts›

subsubsection ‹Locales›

locale scalar_mult =
  fixes smult :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)

locale R_scalar_mult = scalar_mult smult + Ring1 R
  for R     :: "'r::ring_1 set"
  and smult :: "'r  'm::ab_group_add  'm" (infixr "" 70)

lemma (in scalar_mult) R_scalar_mult : "R_scalar_mult UNIV"
  using full_Ring1 R_scalar_mult.intro by fast

lemma (in R_scalar_mult) Ring1 : "Ring1 R" ..

locale RModule = R_scalars?: R_scalar_mult R smult + VecGroup?: Group M
  for R     :: "'r::ring_1 set"
  and smult :: "'r  'm::ab_group_add  'm" (infixr "" 70)
  and M     :: "'m set"
+ assumes smult_closed : " r  R; m  M   r  m  M"
  and smult_distrib_left  [simp] : " r  R; m  M; n  M 
                                           r  (m + n) = r  m + r  n"
  and smult_distrib_right [simp] : " r  R; s  R; m  M 
                                           (r + s)  m = r  m + s  m"
  and smult_assoc [simp] : " r  R; s  R; m  M 
                                   r  s  m = (r * s)  m"
  and one_smult [simp] : "m  M  1  m = m"

lemmas RModuleI = RModule.intro[OF R_scalar_mult.intro]

locale Module = RModule UNIV smult M
  for smult :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)
  and M     :: "'m set"

lemmas ModuleI = RModuleI[of UNIV, OF full_Ring1, THEN Module.intro]

subsubsection ‹Basic facts›

lemma trivial_RModule :
  fixes   smult :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)  
  assumes "Ring1 R" "rR. smult r (0::'m::ab_group_add) = 0"
  shows   "RModule R smult (0::'m set)"
proof (rule RModuleI, rule assms(1), rule trivial_Group, unfold_locales)
  define Z where "Z = (0::'m set)"
  fix r s m n assume rsmn: "r  R" "s  R" "m  Z" "n  Z"
  from rsmn(1,3) Z_def assms(2) show "r  m  Z" by simp
  from rsmn(1,3,4) Z_def assms(2) show "r  (m+n) = r  m + r  n" by simp
  from rsmn(1-3) Z_def assms show "(r + s)  m = r  m + s  m"
    using Ring1.add_closed by auto
  from rsmn(1-3) Z_def assms show "r  (s  m) = (r*s)  m"
    using Ring1.mult_closed by auto
next
  define Z where "Z = (0::'m set)"
  fix m assume "m  Z" with Z_def assms show "1  m = m"
    using Ring1.one_closed by auto
qed

context RModule
begin

abbreviation RSubmodule :: "'m set  bool"
  where "RSubmodule N  RModule R smult N  N  M"

lemma Group : "Group M"
  using RModule_axioms RModule.axioms(2) by fast

lemma Subgroup_RSubmodule : "RSubmodule N  Subgroup N"
  using RModule.Group by fast

lemma AbGroup : "AbGroup M"
  using AbGroup.intro Group by fast

lemmas zero_closed     = zero_closed
lemmas diff_closed     = diff_closed
lemmas set_plus_closed = set_plus_closed
lemmas sum_closed   = AbGroup.sum_closed[OF AbGroup]

lemma map_smult_closed :
  "r  R  set ms  M  set (map ((⋅) r) ms)  M"
  using smult_closed by (induct ms) auto

lemma zero_smult : "m  M  0  m = 0"
  using R_scalars.zero_closed smult_distrib_right[of 0] add_left_imp_eq by simp

lemma smult_zero : "r  R  r  0 = 0"
  using zero_closed smult_distrib_left[of r 0] by simp

lemma neg_smult : "r  R  m  M  (-r)  m = - (r  m)"
  using R_scalars.neg_closed smult_distrib_right[of r "-r" m]
        zero_smult minus_unique[of "r  m"]
  by    simp

lemma neg_eq_neg1_smult : "m  M  (-1)  m = - m"
  using one_closed neg_smult one_smult by fastforce

lemma smult_neg : "r  R  m  M  r  (- m) = - (r  m)"
  using neg_eq_neg1_smult one_closed R_scalars.neg_closed smult_assoc[of r "- 1"]
        smult_closed
  by    force

lemma smult_distrib_left_diff :
  " r  R; m  M; n  M   r  (m - n) = r  m - r  n"
  using neg_closed smult_distrib_left[of r m "-n"] smult_neg by (simp add: algebra_simps)

lemma smult_distrib_right_diff :
  " r  R; s  R; m  M   (r - s)  m = r  m - s  m"
  using R_scalars.neg_closed smult_distrib_right[of r "-s"] neg_smult
  by    (simp add: algebra_simps)

lemma smult_sum_distrib :
  assumes "r  R"
  shows   "finite A  f ` A  M  r  (aA. f a) = (aA. r  f a)"
proof (induct set: finite)
  case empty from assms show ?case using smult_zero by simp
next
  case (insert a A) with assms show ?case using sum_closed[of A] by simp
qed

lemma sum_smult_distrib :
  assumes "m  M"
  shows   "finite A  f ` A  R  (aA. f a)  m = (aA. (f a)  m)"
proof (induct set: finite)
  case empty from assms show ?case using zero_smult by simp
next
  case (insert a A) with assms show ?case using R_scalars.sum_closed[of A] by simp
qed

lemma smult_sum_list_distrib :
  "r  R  set ms  M  r  (sum_list ms) = (mms. r  m)"
  using smult_zero sum_list_closed[of id] by (induct ms) auto

lemma sum_list_prod_map_smult_distrib :
  "m  M  set (map (case_prod f) xys)  R
         ((x,y)xys. f x y)  m = ((x,y)xys. f x y  m)"
  using zero_smult R_scalars.sum_list_closed_prod[of f]
  by    (induct xys) auto

lemma RSubmoduleI :
  assumes "Subgroup N" "r n. r  R  n  N  r  n  N"
  shows   "RSubmodule N"
proof
  show "RModule R smult N"
  proof (intro_locales, rule SubgroupD1[OF assms(1)], unfold_locales)
    from assms(2) show "r m. r  R  m  N  r  m  N" by fast
    from assms(1)
      show  "r m n.  r  R; m  N; n  N   r  (m + n) = r  m + r  n"
      using smult_distrib_left
      by    blast
    from assms(1)
      show  "r s m.  r  R; s  R; m  N   (r + s)  m = r  m + s  m"
      using smult_distrib_right
      by    blast
    from assms(1)
      show  "r s m.  r  R; s  R; m  N   r  s  m = (r * s)  m"
      using smult_assoc
      by    blast
    from assms(1) show "m. m  N  1  m = m" using one_smult by blast
  qed
  from assms(1) show "N  M" by fast
qed

end (* context RModule *)

lemma (in R_scalar_mult) listset_RModule_Rsmult_closed :
  " Mset Ms. RModule R smult M; r  R; ms  listset Ms  
         [r  m. mms]  listset Ms"
proof-
  have " length ms = length Ms; ms  listset Ms;
              Mset Ms. RModule R smult M; r  R 
                 [r  m. mms]  listset Ms"
  proof (induct ms Ms rule: list_induct2)
    case (Cons m ms M Ms) thus ?case
      using listset_ConsD[of m] RModule.smult_closed listset_ConsI[of "r  m" M]
      by    fastforce
  qed simp
  thus " Mset Ms. RModule R smult M; r  R; ms  listset Ms  
               [r  m. mms]  listset Ms"
    using listset_length[of ms Ms] by fast
qed

context Module
begin

abbreviation Submodule :: "'m set  bool"
  where "Submodule  RModule.RSubmodule UNIV smult M"

lemmas AbGroup    = AbGroup
lemmas SubmoduleI = RSubmoduleI

end (* context Module *)

subsubsection ‹Module and submodule instances›

lemma (in R_scalar_mult) trivial_RModule :
  "(r. r  R  r  0 = 0)  RModule R smult 0"
  using trivial_Group add_closed mult_closed one_closed by unfold_locales auto

context RModule
begin

lemma trivial_RSubmodule : "RSubmodule 0"
  using zeroS_closed smult_zero trivial_RModule by fast

lemma RSubmodule_set_plus :
  assumes "RSubmodule L" "RSubmodule N"
  shows   "RSubmodule (L + N)"
proof (rule RSubmoduleI)
  from assms have "Group (L + N)"
    using RModule.AbGroup AbGroup_set_plus[of L N] AbGroup.axioms by fast
  moreover from assms have "L + N  M"
    using Group Group.set_plus_closed by auto
  ultimately show "Subgroup (L + N)" by fast
next
  fix r x assume rx: "r  R" "x  L + N"
  from rx(2) obtain m n where mn: "m  L" "n  N" "x = m + n"
    using set_plus_def[of L N] by fast
  with assms rx(1) show "r  x  L + N"
    using RModule.smult_closed[of R smult L] RModule.smult_closed[of R smult N]
          smult_distrib_left set_plus_def
    by    fast
qed

lemma RSubmodule_sum_list :
  "(Nset Ns. RSubmodule N)  RSubmodule (NNs. N)"
  using trivial_RSubmodule RSubmodule_set_plus
  by    (induct Ns) auto

lemma RSubmodule_inner_dirsum :
  assumes "(Nset Ns. RSubmodule N)"
  shows   "RSubmodule (NNs. N)"
proof (cases "add_independentS Ns")
  case True with assms show ?thesis
    using RSubmodule_sum_list inner_dirsumD by fastforce
next
  case False thus ?thesis
    using inner_dirsumD2[of Ns] trivial_RSubmodule by simp
qed

lemma RModule_inner_dirsum :
  "(Nset Ns. RSubmodule N)  RModule R smult (NNs. N)"
  using RSubmodule_inner_dirsum by fast

lemma SModule_restrict_scalars :
  assumes "Subring1 S"
  shows   "RModule S smult M"
proof (rule RModuleI, rule Subring1D1[OF assms], rule Group, unfold_locales)
  from assms show
    "r m. r  S  m  M  r  m  M"
    "r m n. r  S  m  M  n  M  r  (m + n) = r  m + r  n"
    "m. m  M  1  m = m"
    using smult_closed smult_distrib_left
    by    auto
  from assms
    show  "r s m. r  S  s  S  m  M  (r + s)  m = r  m + s  m"
    using Ring1.add_closed smult_distrib_right
    by    fast
  from assms
    show  "r s m. r  S  s  S  m  M  r  s  m = (r * s)  m"
    using Ring1.mult_closed smult_assoc
    by    fast
qed

end (* context RModule *)


subsection ‹Linear algebra in modules›

subsubsection ‹Linear combinations: lincomb›

context scalar_mult
begin

definition lincomb :: "'r list  'm list  'm" (infix "∙⋅" 70)
  where "rs ∙⋅ ms = ((r,m)zip rs ms. r  m)"

text ‹Note: zip› will truncate if lengths of coefficient and vector lists differ.›

lemma lincomb_Nil : "rs = []  ms = []  rs ∙⋅ ms = 0"
  unfolding lincomb_def by auto

lemma lincomb_singles : "[a] ∙⋅ [m] = a  m"
  using lincomb_def by simp

lemma lincomb_Cons : "(r # rs) ∙⋅ (m # ms) = r  m + rs ∙⋅ ms"
  unfolding lincomb_def by simp

lemma lincomb_append :
  "length rs = length ms  (rs@ss) ∙⋅ (ms@ns) = rs ∙⋅ ms + ss ∙⋅ ns"
  unfolding lincomb_def by simp

lemma lincomb_append_left :
  "(rs @ ss) ∙⋅ ms = rs ∙⋅ ms + ss ∙⋅ drop (length rs) ms"
  using zip_append_left[of rs ss ms] unfolding lincomb_def by simp

lemma lincomb_append_right :
  "rs ∙⋅ (ms@ns) = rs ∙⋅ ms + (drop (length ms) rs) ∙⋅ ns"
  using zip_append_right[of rs ms] unfolding lincomb_def by simp

lemma lincomb_conv_take_right : "rs ∙⋅ ms = rs ∙⋅ take (length rs) ms"
  using lincomb_Nil lincomb_Cons by (induct rs ms rule: list_induct2') auto

end (* context scalar_mult *)

context RModule
begin

lemmas lincomb_Nil  = lincomb_Nil
lemmas lincomb_Cons = lincomb_Cons

lemma lincomb_closed : "set rs  R  set ms  M  rs ∙⋅ ms  M"
proof (induct ms arbitrary: rs)
  case Nil show ?case using lincomb_Nil zero_closed by simp
next
  case (Cons m ms)
  hence Cons1: "rs. set rs  R  rs ∙⋅ ms  M" "m  M" "set rs  R" by auto
  show "rs ∙⋅ (m#ms)  M"
  proof (cases rs)
    case Nil thus ?thesis using lincomb_Nil zero_closed by simp
  next
    case Cons with Cons1 show ?thesis
      using lincomb_Cons smult_closed add_closed by fastforce
  qed
qed

lemma smult_lincomb :
  " set rs  R; s  R; set ms  M   s  (rs ∙⋅ ms) = [s*r. rrs] ∙⋅ ms"
  using lincomb_Nil smult_zero lincomb_Cons smult_closed lincomb_closed
  by    (induct rs ms rule: list_induct2') auto

lemma neg_lincomb :
  "set rs  R  set ms  M  - (rs ∙⋅ ms) = [-r. rrs] ∙⋅ ms"
  using lincomb_closed neg_eq_neg1_smult one_closed R_scalars.neg_closed[of 1]
        smult_lincomb[of rs "- 1"] map_times_neg1_eq_map_uminus
  by    auto

lemma lincomb_sum_left :
  " set rs  R; set ss  R; set ms  M; length rs  length ss 
         [r + s. (r,s)zip rs ss] ∙⋅ ms = rs ∙⋅ ms + (take (length rs) ss) ∙⋅ ms"
proof (induct rs ss arbitrary: ms rule: list_induct2')
  case 1 show ?case using lincomb_Nil by simp
next
  case (2 r rs)
  show "ms. length (r#rs)  length []
               [a + b. (a,b)zip (r#rs) []] ∙⋅ ms
                = (r#rs) ∙⋅ ms + (take (length (r#rs)) []) ∙⋅ ms"
    by simp
next
  case 3 show ?case using lincomb_Nil by simp
next
  case (4 r rs s ss)
  thus "[a+b. (a,b)zip (r#rs) (s#ss)] ∙⋅ ms
              = (r#rs) ∙⋅ ms + (take (length (r#rs)) (s#ss)) ∙⋅ ms"
    using lincomb_Nil lincomb_Cons by (cases ms) auto
qed

lemma lincomb_sum :
  assumes "set rs  R" "set ss  R" "set ms  M" "length rs  length ss"
  shows   "rs ∙⋅ ms + ss ∙⋅ ms
                = ([a + b. (a,b)zip rs ss] @ (drop (length rs) ss)) ∙⋅ ms"
proof-
  define zs fss bss
    where "zs = [a + b. (a,b)zip rs ss]"
      and "fss = take (length rs) ss"
      and "bss = drop (length rs) ss"
  from assms(4) zs_def fss_def have "length zs = length rs" "length fss = length rs"
    using length_concat_map_split_zip[of "λa b. a + b" rs] by auto
  hence "(zs @ bss) ∙⋅ ms = rs ∙⋅ ms + (fss @ bss) ∙⋅ ms"
    using assms(1,2,3) zs_def fss_def lincomb_sum_left lincomb_append_left
    by    simp
  thus ?thesis using fss_def bss_def zs_def by simp
qed

lemma lincomb_diff_left :
  " set rs  R; set ss  R; set ms  M; length rs  length ss 
         [r - s. (r,s)zip rs ss] ∙⋅ ms = rs ∙⋅ ms - (take (length rs) ss) ∙⋅ ms"
proof (induct rs ss arbitrary: ms rule: list_induct2')
  case 1 show ?case using lincomb_Nil by simp
next
  case (2 r rs)
  show "ms. length (r#rs)  length []
               [a - b. (a,b)zip (r#rs) []] ∙⋅ ms
                = (r#rs) ∙⋅ ms - (take (length (r#rs)) []) ∙⋅ ms"
    by simp
next
  case 3 show ?case using lincomb_Nil by simp
next
  case (4 r rs s ss)
  thus "[a-b. (a,b)zip (r#rs) (s#ss)] ∙⋅ ms
              = (r#rs) ∙⋅ ms - (take (length (r#rs)) (s#ss)) ∙⋅ ms"
    using lincomb_Nil lincomb_Cons smult_distrib_right_diff by (cases ms) auto
qed

lemma lincomb_replicate_left : 
  "r  R  set ms  M  (replicate k r) ∙⋅ ms = r  ( m(take k ms). m )"
proof (induct k arbitrary: ms)
  case 0 thus ?case using lincomb_Nil smult_zero by simp
next
  case (Suc k)
  show ?case
  proof (cases ms)
    case Nil with Suc(2) show ?thesis using lincomb_Nil smult_zero by simp
  next
    case (Cons m ms) with Suc show ?thesis
      using lincomb_Cons set_take_subset[of k ms] sum_list_closed[of id]
      by    auto
  qed
qed

lemma lincomb_replicate0_left : "set ms  M  (replicate k 0) ∙⋅ ms = 0"
proof-
  assume ms: "set ms  M"
  hence "(replicate k 0) ∙⋅ ms = 0  (m(take k ms). m)" 
    using R_scalars.zero_closed lincomb_replicate_left by fast
  moreover from ms have "(m(take k ms). m)  M"
    using set_take_subset sum_list_closed by fastforce
  ultimately show "(replicate k 0) ∙⋅ ms = 0" using zero_smult by simp
qed

lemma lincomb_0coeffs : "set ms  M  sset rs. s = 0  rs ∙⋅ ms = 0"
  using lincomb_Nil lincomb_Cons zero_smult
  by    (induct rs ms rule: list_induct2') auto

lemma delta_scalars_lincomb_eq_nth :
  "set ms  M  n < length ms
         ((replicate (length ms) 0)[n := 1]) ∙⋅ ms = ms!n"
proof (induct ms arbitrary: n)
  case (Cons m ms) thus ?case
    using lincomb_Cons lincomb_replicate0_left zero_smult by (cases n) auto
qed simp

lemma lincomb_obtain_same_length_Rcoeffs :
  "set rs  R  set ms  M
         ss. set ss  R  length ss = length ms
           take (length rs) ss = take (length ms) rs  rs ∙⋅ ms = ss ∙⋅ ms"
proof (induct rs ms rule: list_induct2')
  case 1 show ?case using lincomb_Nil by simp
next
  case 2 thus ?case using lincomb_Nil by simp
next
  case (3 m ms)
  define ss where "ss = replicate (Suc (length ms)) (0::'r)"
  from 3(2) ss_def
    have  "set ss  R" "length ss = length (m#ms)" "[] ∙⋅ (m#ms) = ss ∙⋅ (m#ms)"
    using R_scalars.zero_closed lincomb_Nil
          lincomb_replicate0_left[of "m#ms" "Suc (length ms)"]
    by    auto
  thus ?case by auto
next
  case (4 r rs m ms)
  from this obtain ss
    where ss: "set ss  R" "length ss = length ms"
              "take (length rs) ss = take (length ms) rs" "rs ∙⋅ ms = ss ∙⋅ ms"
      by  auto
  from 4(2) ss have 
    "set (r#ss)  R" "length (r#ss) = length (m#ms)"
    "take (length (r#rs)) (r#ss) = take (length (m#ms)) (r#rs)"
    "(r#rs) ∙⋅ (m#ms) = (r#ss) ∙⋅ (m#ms)"
    using lincomb_Cons
    by    auto
  thus ?case by fast
qed

lemma lincomb_concat :
  "list_all2 (λrs ms. length rs = length ms) rss mss
         (concat rss) ∙⋅ (concat mss) = ((rs,ms)zip rss mss. rs ∙⋅ ms)"
  using lincomb_Nil lincomb_append by (induct rss mss rule: list_induct2') auto

lemma lincomb_snoc0 : "set ms  M  (as@[0]) ∙⋅ ms = as ∙⋅ ms"
  using lincomb_append_left set_drop_subset lincomb_replicate0_left[of _ 1] by fastforce

lemma lincomb_strip_while_0coeffs :
  assumes "set ms  M"
  shows   "(strip_while ((=) 0) as) ∙⋅ ms = as ∙⋅ ms"
proof (induct as rule: rev_induct)
  case (snoc a as)
  hence caseassm: "strip_while ((=) 0) as ∙⋅ ms = as ∙⋅ ms" by fast
  show ?case
  proof (cases "a = 0")
    case True
    moreover with assms have "(as@[a]) ∙⋅ ms = as ∙⋅ ms"
      using lincomb_snoc0 by fast
    ultimately show "strip_while ((=) 0) (as @ [a]) ∙⋅ ms = (as@[a]) ∙⋅ ms"
      using caseassm by simp
  qed simp
qed simp

end (* context RModule *)

lemmas (in Module) lincomb_obtain_same_length_coeffs = lincomb_obtain_same_length_Rcoeffs
lemmas (in Module) lincomb_concat                    = lincomb_concat

subsubsection ‹Spanning: RSpan› and Span›

context R_scalar_mult
begin

primrec RSpan :: "'m list  'm set"
  where "RSpan [] = 0"
      | "RSpan (m#ms) = { r  m | r. r  R } + RSpan ms"

lemma RSpan_single : "RSpan [m] = { r  m | r. r  R }"
  using add_0_right[of "{ r  m | r. r  R }"] by simp

lemma RSpan_Cons : "RSpan (m#ms) = RSpan [m] + RSpan ms"
  using RSpan_single by simp

lemma in_RSpan_obtain_same_length_coeffs :
  "n  RSpan ms  rs. set rs  R  length rs = length ms  n = rs ∙⋅ ms"
proof (induct ms arbitrary: n)
  case Nil
  hence "n = 0" by simp
  thus "rs. set rs  R  length rs = length []  n = rs ∙⋅ []"
    using lincomb_Nil by simp
next
  case (Cons m ms)
  from this obtain r rs
    where "set (r#rs)  R" "length (r#rs) = length (m#ms)" "n = (r#rs) ∙⋅ (m#ms)"
    using set_plus_def[of _ "RSpan ms"] lincomb_Cons
    by    fastforce
  thus "rs. set rs  R  length rs = length (m#ms)  n = rs ∙⋅ (m#ms)" by fast
qed

lemma in_RSpan_Cons_obtain_same_length_coeffs :
  "n  RSpan (m#ms)  r rs. set (r#rs)  R  length rs = length ms 
         n = r  m + rs ∙⋅ ms"
proof-
  assume "n  RSpan (m#ms)"
  from this obtain x y where "x  RSpan [m]" "y  RSpan ms" "n = x + y"
    using RSpan_Cons set_plus_def[of "RSpan [m]"] by auto
  thus "r rs. set (r # rs)  R  length rs = length ms  n = r  m + rs ∙⋅ ms"
    using RSpan_single in_RSpan_obtain_same_length_coeffs[of y ms] by auto
qed

lemma RSpanD_lincomb :
  "RSpan ms = { rs ∙⋅ ms | rs. set rs  R  length rs = length ms}"
proof
  show "RSpan ms  {rs ∙⋅ ms |rs. set rs  R  length rs = length ms}"
    using in_RSpan_obtain_same_length_coeffs by fast
  show "{rs ∙⋅ ms |rs. set rs  R  length rs = length ms}  RSpan ms"
  proof
    fix x assume "x  {rs ∙⋅ ms |rs. set rs  R   length rs = length ms}"
    from this obtain rs where rs: "set rs  R" "length rs = length ms" "x = rs ∙⋅ ms"
      by fast
    from rs(2) have "set rs  R  rs ∙⋅ ms  RSpan ms"
      using lincomb_Nil lincomb_Cons by (induct rs ms rule: list_induct2) auto
    with rs(1,3) show "x  RSpan ms" by fast
  qed
qed

lemma RSpan_append : "RSpan (ms @ ns) = RSpan ms + RSpan ns"
proof (induct ms)
  case Nil show ?case using add_0_left[of "RSpan ns"] by simp
next
  case (Cons m ms) thus ?case
    using RSpan_Cons[of m "ms@ns"] add.assoc by fastforce
qed

end (* context R_scalar_mult *)

context scalar_mult
begin

abbreviation "Span  R_scalar_mult.RSpan UNIV smult"

lemmas Span_append = R_scalar_mult.RSpan_append[OF R_scalar_mult, of smult]
lemmas SpanD_lincomb
          = R_scalar_mult.RSpanD_lincomb [OF R_scalar_mult, of smult]

lemmas in_Span_obtain_same_length_coeffs
          = R_scalar_mult.in_RSpan_obtain_same_length_coeffs[
              OF R_scalar_mult, of _ smult
            ]

end (* context scalar_mult *)

context RModule
begin

lemma RSpan_contains_spanset_single : "m  M  m  RSpan [m]"
  using one_closed RSpan_single by fastforce

lemma RSpan_single_nonzero : "m  M  m  0  RSpan [m]  0"
  using RSpan_contains_spanset_single by auto

lemma Group_RSpan_single :
  assumes "m  M"
  shows   "Group (RSpan [m])"
proof
  from assms show "RSpan [m]  {}" using RSpan_contains_spanset_single by fast
next
  fix x y assume "x  RSpan [m]" "y  RSpan [m]"
  from this obtain r s where rs: "r  R" "x = r  m" "s  R" "y = s  m"
    using RSpan_single by auto
  with assms have "x - y = (r - s)  m" using smult_distrib_right_diff by simp
  with rs(1,3) show "x - y  RSpan [m]"
    using R_scalars.diff_closed[of r s] RSpan_single[of m] by auto
qed

lemma Group_RSpan : "set ms  M  Group (RSpan ms)"
proof (induct ms)
  case Nil show ?case using trivial_Group by simp
next
  case (Cons m ms)
  hence "Group (RSpan [m])" "Group (RSpan ms)"
    using Group_RSpan_single[of m] by auto
  thus ?case
    using RSpan_Cons[of m ms] AbGroup.intro AbGroup_set_plus AbGroup.axioms(1)
    by    fastforce
qed

lemma RSpanD_lincomb_arb_len_coeffs :
  "set ms  M  RSpan ms = { rs ∙⋅ ms | rs. set rs  R }"
proof
  show "RSpan ms  { rs ∙⋅ ms | rs. set rs  R }" using RSpanD_lincomb by fast
  show "set ms  M  RSpan ms  { rs ∙⋅ ms | rs. set rs  R }"
  proof (induct ms)
    case Nil show ?case using lincomb_Nil by auto
  next
    case (Cons m ms) show ?case
    proof
      fix x assume "x  { rs ∙⋅ (m#ms) | rs. set rs  R }"
      from this obtain rs where rs: "set rs  R" "x = rs ∙⋅ (m#ms)" by fast
      with Cons show "x  RSpan (m#ms)"
        using lincomb_Nil Group_RSpan[of "m#ms"] Group.zero_closed lincomb_Cons
        by    (cases rs) auto
    qed
  qed
qed

lemma RSpanI_lincomb_arb_len_coeffs :
  "set rs  R  set ms  M  rs ∙⋅ ms  RSpan ms"
  using RSpanD_lincomb_arb_len_coeffs by fast

lemma RSpan_contains_RSpans_Cons_left :
  "set ms  M  RSpan [m]  RSpan (m#ms)"
  using RSpan_Cons Group_RSpan AbGroup.intro AbGroup.subset_plus_left by fast

lemma RSpan_contains_RSpans_Cons_right :
  "m  M  RSpan ms  RSpan (m#ms)"
  using RSpan_Cons Group_RSpan_single AbGroup.intro AbGroup.subset_plus_right by fast

lemma RSpan_contains_RSpans_append_left :
  "set ns  M  RSpan ms  RSpan (ms@ns)"
  using RSpan_append Group_RSpan AbGroup.intro AbGroup.subset_plus_left
  by    fast

lemma RSpan_contains_spanset : "set ms  M  set ms  RSpan ms"
proof (induct ms)
  case Nil show ?case by simp
next
  case (Cons m ms) thus ?case
    using RSpan_contains_spanset_single
          RSpan_contains_RSpans_Cons_left[of ms m]
          RSpan_contains_RSpans_Cons_right[of m ms]
    by    auto
qed

lemma RSpan_contains_spanset_append_left :
  "set ms  M  set ns  M  set ms  RSpan (ms@ns)"
  using RSpan_contains_spanset[of "ms@ns"] by simp

lemma RSpan_contains_spanset_append_right :
  "set ms  M  set ns  M  set ns  RSpan (ms@ns)"
  using RSpan_contains_spanset[of "ms@ns"] by simp

lemma RSpan_zero_closed : "set ms  M  0  RSpan ms"
  using Group_RSpan Group.zero_closed by fast

lemma RSpan_single_closed : "m  M  RSpan [m]  M"
  using RSpan_single smult_closed by auto

lemma RSpan_closed : "set ms  M  RSpan ms  M"
proof (induct ms)
  case Nil show ?case using zero_closed by simp
next
  case (Cons m ms) thus ?case 
    using RSpan_single_closed RSpan_Cons Group Group.set_plus_closed[of M]
    by    simp
qed

lemma RSpan_smult_closed :
  assumes "r  R" "set ms  M" "n  RSpan ms"
  shows "r  n  RSpan ms"
proof-
  from assms(2,3) obtain rs where rs: "set rs  R" "n = rs ∙⋅ ms"
    using RSpanD_lincomb_arb_len_coeffs by fast
  with assms(1,2) show ?thesis
    using smult_lincomb[OF rs(1) assms(1,2)] mult_closed
          RSpanI_lincomb_arb_len_coeffs[of "[r*a. ars]" ms]
    by    auto
qed

lemma RSpan_add_closed :
  assumes "set ms  M" "n  RSpan ms" "n'  RSpan ms"
  shows   "n + n'  RSpan ms"
proof-
  from assms (2,3) obtain rs ss
    where rs: "set rs  R" "length rs = length ms" "n = rs ∙⋅ ms"
    and   ss: "set ss  R" "length ss = length ms" "n' = ss ∙⋅ ms"
    using RSpanD_lincomb by auto
  with assms(1) have "n + n' = [r + s. (r,s)zip rs ss] ∙⋅ ms"
    using lincomb_sum_left by simp
  moreover from rs(1) ss(1) have "set [r + s. (r,s)zip rs ss]  R"
    using set_zip_leftD[of _ _ rs ss] set_zip_rightD[of _ _ rs ss]  
          R_scalars.add_closed R_scalars.zip_add_closed by blast
  ultimately show "n + n'  RSpan ms"
    using assms(1) RSpanI_lincomb_arb_len_coeffs by simp
qed

lemma RSpan_lincomb_closed :
  " set rs  R; set ms  M; set ns  RSpan ms   rs ∙⋅ ns  RSpan ms"
  using lincomb_Nil RSpan_zero_closed lincomb_Cons RSpan_smult_closed RSpan_add_closed
  by    (induct rs ns rule: list_induct2') auto

lemma RSpanI : "set ms  M  M  RSpan ms  M = RSpan ms"
  using RSpan_closed by fast

lemma RSpan_contains_RSpan_take :
  "set ms  M  RSpan (take k ms)  RSpan ms"
  using append_take_drop_id set_drop_subset
        RSpan_contains_RSpans_append_left[of "drop k ms"]
  by    fastforce

lemma RSubmodule_RSpan_single :
  assumes "m  M"
  shows   "RSubmodule (RSpan [m])"
proof (rule RSubmoduleI)
  from assms show "Subgroup (RSpan [m])"
    using Group_RSpan_single RSpan_closed[of "[m]"] by simp
next
  fix r n assume rn: "r  R" "n  RSpan [m]"
  from rn(2) obtain s where s: "s  R" "n = s  m" using RSpan_single by fast
  with assms rn(1) have "r * s  R" "r  n = (r * s)  m"
    using mult_closed by auto
  thus "r  n  RSpan [m]" using RSpan_single by fast
qed

lemma RSubmodule_RSpan : "set ms  M  RSubmodule (RSpan ms)"
proof (induct ms)
  case Nil show ?case using trivial_RSubmodule by simp
next
  case (Cons m ms)
  hence "RSubmodule (RSpan [m])" "RSubmodule (RSpan ms)"
    using RSubmodule_RSpan_single by auto
  thus ?case using RSpan_Cons RSubmodule_set_plus by simp
qed

lemma RSpan_RSpan_closed :
  "set ms  M  set ns  RSpan ms  RSpan ns  RSpan ms"
  using RSpanD_lincomb[of ns] RSpan_lincomb_closed by auto

lemma spanset_reduce_Cons :
  "set ms  M  m  RSpan ms  RSpan (m#ms) = RSpan ms"
  using RSpan_Cons RSpan_RSpan_closed[of ms "[m]"]
        RSpan_contains_RSpans_Cons_right[of m ms]
        RSubmodule_RSpan[of ms]
        RModule.set_plus_closed[of R smult "RSpan ms" "RSpan [m]" "RSpan ms"]
  by    auto

lemma RSpan_replace_hd :
  assumes "n  M" "set ms  M" "m  RSpan (n # ms)"
  shows   "RSpan (m # ms)  RSpan (n # ms)"
proof
  fix x assume "x  RSpan (m # ms)"
  from this assms(3) obtain r rs s ss
    where r_rs: "r  R" "set rs  R" "length rs = length ms" "x = r  m + rs ∙⋅ ms"
    and   s_ss: "s  R" "set ss  R" "length ss = length ms" "m = s  n + ss ∙⋅ ms"
    using in_RSpan_Cons_obtain_same_length_coeffs[of x m ms]
          in_RSpan_Cons_obtain_same_length_coeffs[of m n ms]
    by    fastforce
  from r_rs(1) s_ss(2) have set1: "set [r*a. ass]  R" using mult_closed by auto
  have "x = ((r * s) # [a + b. (a,b)zip [r*a. ass] rs]) ∙⋅ (n # ms)"
  proof-
    from r_rs(2,3) s_ss(3) assms(2)
      have  "[r*a. ass] ∙⋅ ms + rs ∙⋅ ms
                  = [a + b. (a,b)zip [r*a. ass] rs] ∙⋅ ms"
      using set1 lincomb_sum
      by    simp
    moreover from assms(1,2) r_rs(1,2,4) s_ss(1,2,4)
      have  "x = (r * s)  n + ([r*a. ass] ∙⋅ ms + rs ∙⋅ ms)"
      using smult_closed lincomb_closed smult_lincomb mult_closed lincomb_sum
      by    simp
    ultimately show ?thesis using lincomb_Cons by simp
  qed
  moreover have "set ((r * s) # [a + b. (a,b)zip [r*a. ass] rs])  R"
  proof-
    from r_rs(2) have "set [a + b. (a,b)zip [r*a. ass] rs]  R" 
      using set1 R_scalars.zip_add_closed by fast
    with r_rs(1) s_ss(1) show ?thesis using mult_closed by simp
  qed
  ultimately show "x  RSpan (n # ms)"
    using assms(1,2) RSpanI_lincomb_arb_len_coeffs[of _ "n#ms"] by fastforce
qed

end (* context RModule *)

lemmas (in scalar_mult)
  Span_Cons = R_scalar_mult.RSpan_Cons[OF R_scalar_mult, of smult]

context Module
begin

lemmas SpanD_lincomb_arb_len_coeffs       = RSpanD_lincomb_arb_len_coeffs
lemmas SpanI                              = RSpanI
lemmas SpanI_lincomb_arb_len_coeffs       = RSpanI_lincomb_arb_len_coeffs
lemmas Span_contains_Spans_Cons_right     = RSpan_contains_RSpans_Cons_right
lemmas Span_contains_spanset              = RSpan_contains_spanset
lemmas Span_contains_spanset_append_left  = RSpan_contains_spanset_append_left
lemmas Span_contains_spanset_append_right = RSpan_contains_spanset_append_right
lemmas Span_closed                        = RSpan_closed
lemmas Span_smult_closed                  = RSpan_smult_closed
lemmas Span_contains_Span_take            = RSpan_contains_RSpan_take
lemmas Span_replace_hd                    = RSpan_replace_hd
lemmas Submodule_Span                     = RSubmodule_RSpan

end (* context Module *)

subsubsection ‹Finitely generated modules›

context R_scalar_mult
begin

abbreviation "R_fingen M  (ms. set ms  M  RSpan ms = M)"

text ‹
  Similar to definition of card› for finite sets, we default dim› to 0 if no finite
  spanning set exists. Note that @{term "RSpan [] = 0"} implies that @{term "dim_R {0} = 0"}.
›

definition dim_R :: "'m set  nat"
  where "dim_R M = (if R_fingen M then (
                LEAST n. ms. length ms = n  set ms  M  RSpan ms = M
              ) else 0)"

lemma dim_R_nonzero :
  assumes "dim_R M > 0"
  shows   "M  0"
proof
  assume M: "M = 0"
  hence "dim_R M
              = (LEAST n. ms. length ms = n  set ms  M  RSpan ms = M)"
    using dim_R_def by simp
  moreover from M have "length [] = 0  set []  M  RSpan [] = M" by simp
  ultimately show False using assms by simp
qed

end (* context R_scalar_mult *)


hide_const real_vector.dim
hide_const (open) Real_Vector_Spaces.dim

abbreviation (in scalar_mult) "fingen  R_scalar_mult.R_fingen UNIV smult"
abbreviation (in scalar_mult) "dim     R_scalar_mult.dim_R UNIV smult"

lemmas (in Module) dim_nonzero = dim_R_nonzero

subsubsection @{term R}-linear independence›

context R_scalar_mult
begin

primrec R_lin_independent :: "'m list  bool" where
  R_lin_independent_Nil: "R_lin_independent [] = True" |
  R_lin_independent_Cons:
  "R_lin_independent (m#ms) = (R_lin_independent ms
         (r rs. (set (r#rs)  R  (r#rs) ∙⋅ (m#ms) = 0)  r = 0))"

lemma R_lin_independent_ConsI :
  assumes "R_lin_independent ms"
          "r rs. set (r#rs)  R  (r#rs) ∙⋅ (m#ms) = 0  r = 0"
  shows   "R_lin_independent (m#ms)"
  using   assms R_lin_independent_Cons
  by      fast

lemma R_lin_independent_ConsD1 :
  "R_lin_independent (m#ms)  R_lin_independent ms"
  by simp

lemma R_lin_independent_ConsD2 :
  " R_lin_independent (m#ms); set (r#rs)  R; (r#rs) ∙⋅ (m#ms) = 0  
         r = 0"
  by auto

end (* context R_scalar_mult *)

context RModule
begin

lemma R_lin_independent_imp_same_scalars :
  " length rs = length ss; length rs  length ms; set rs  R; set ss  R;
        set ms  M; R_lin_independent ms; rs ∙⋅ ms = ss ∙⋅ ms   rs = ss"
proof (induct rs ss arbitrary: ms rule: list_induct2)
  case (Cons r rs s ss)
  from Cons(3) have "ms  []" by auto
  from this obtain n ns where ms: "ms = n#ns"
    using neq_Nil_conv[of ms] by fast
  from Cons(4,5) have "set ([a-b. (a,b)zip (r#rs) (s#ss)])  R"
    using Ring1 Ring1.list_diff_closed by fast
  hence "set ((r-s)#[a-b. (a,b)zip rs ss])  R" by simp
  moreover from Cons(1,4-6,8) ms
    have  1: "((r-s)#[a-b. (a,b)zip rs ss]) ∙⋅ (n#ns) = 0"
    using lincomb_diff_left[of "r#rs" "s#ss"]
    by    simp
  ultimately have "r - s = 0" using Cons(7) ms R_lin_independent_Cons by fast
  hence 2: "r = s" by simp
  with 1 Cons(1,4-6) ms have "rs ∙⋅ ns = ss ∙⋅ ns"
    using lincomb_Cons zero_smult lincomb_diff_left by simp
  with Cons(2-7) ms have "rs = ss" by simp
  with 2 show ?case by fast
qed fast

lemma R_lin_independent_obtain_unique_scalars :
  " set ms  M; R_lin_independent ms; n  RSpan ms 
         (∃! rs. set rs  R  length rs = length ms  n = rs ∙⋅ ms)"
  using in_RSpan_obtain_same_length_coeffs[of n ms]
        R_lin_independent_imp_same_scalars[of _ _ ms]
  by    auto

lemma R_lin_independentI_all_scalars :
  "set ms  M 
        (rs. set rs  R  length rs = length ms  rs ∙⋅ ms = 0  set rs  0)
           R_lin_independent ms"
proof (induct ms)
  case (Cons m ms) show ?case
  proof (rule R_lin_independent_ConsI)
    have "rs.  set rs  R; length rs = length ms; rs ∙⋅ ms = 0   set rs  0"
    proof-
      fix rs assume rs: "set rs  R" "length rs = length ms" "rs ∙⋅ ms = 0"
      with Cons(2) have "set (0#rs)  R" "length (0#rs)
                              = length (m#ms)" "(0#rs) ∙⋅ (m#ms) = 0"
        using R_scalars.zero_closed lincomb_Cons zero_smult by auto
      with Cons(3) have "set (0#rs)  0" by fast
      thus "set rs  0" by simp
    qed
    with Cons(1,2) show "R_lin_independent ms" by simp
  next
    fix r rs assume r_rs: "set (r # rs)  R" "(r # rs) ∙⋅ (m # ms) = 0"
    from r_rs(1) Cons(2) obtain ss
      where ss: "set ss  R" "length ss = length ms" "rs ∙⋅ ms = ss ∙⋅ ms"
      using lincomb_obtain_same_length_Rcoeffs[of rs ms]
      by    auto
    with r_rs have "(r#ss) ∙⋅ (m#ms) = 0" using lincomb_Cons by simp
    moreover from r_rs(1) ss(1) have "set (r#ss)  R" by simp
    moreover from ss(2) have "length (r#ss) = length (m#ms)" by simp
    ultimately have "set (r#ss)  0" using Cons(3) by fast
    thus "r = 0" by simp
  qed
qed simp

lemma R_lin_independentI_concat_all_scalars :
  defines eq_len: "eq_len  λxs ys. length xs = length ys"
  assumes "set (concat mss)  M"
          "rss. set (concat rss)  R  list_all2 eq_len rss mss
               (concat rss) ∙⋅ (concat mss) = 0  (rs  set rss. set rs  0)"
  shows   "R_lin_independent (concat mss)"
  using   assms(2)
proof (rule R_lin_independentI_all_scalars)
  have "rs.  set rs  R; length rs = length (concat mss); rs ∙⋅ concat mss = 0 
               set rs  0"
  proof-
    fix rs
    assume rs: "set rs  R" "length rs = length (concat mss)" "rs ∙⋅ concat mss = 0"
    from rs(2) eq_len obtain rss where "rs = concat rss" "list_all2 eq_len rss mss"
      using match_concat by fast
    with rs(1,3) assms(3) show "set rs  0" by auto
  qed
  thus "rs. set rs  R  length rs = length (concat mss)  rs ∙⋅ concat mss = 0
               set rs  0"
    by auto
qed

lemma R_lin_independentD_all_scalars :
  " set rs  R; set ms  M; length rs  length ms; R_lin_independent ms;
        rs ∙⋅ ms = 0   set rs  0"
proof (induct rs ms rule: list_induct2')
  case (4 r rs m ms)
  from 4(2,5,6) have "r = 0" by auto
  moreover with 4 have "set rs  0" using lincomb_Cons zero_smult by simp
  ultimately show ?case by simp
qed auto

lemma R_lin_independentD_all_scalars_nth :
  assumes "set rs  R" "set ms  M" "R_lin_independent ms" "rs ∙⋅ ms = 0"
          "k < min (length rs) (length ms)"
  shows   "rs!k = 0"
proof-
  from assms(1,2) obtain ss
    where ss: "set ss  R" "length ss = length ms"
              "take (length rs) ss = take (length ms) rs" "rs ∙⋅ ms = ss ∙⋅ ms"
    using lincomb_obtain_same_length_Rcoeffs[of rs ms]
    by    fast
  from ss(1,2,4) assms(2,3,4) have "set ss  0"
    using R_lin_independentD_all_scalars by auto
  moreover from assms(5) ss(3) have "rs!k = (take (length rs) ss)!k" by simp
  moreover from assms(5) ss(2) have "k < length (take (length rs) ss)" by simp
  ultimately show ?thesis using in_set_conv_nth by force
qed

lemma R_lin_dependent_dependence_relation :
  "set ms  M  ¬ R_lin_independent ms
         rs. set rs  R  set rs  0  length rs = length ms  rs ∙⋅ ms = 0"
proof (induct ms)
  case (Cons m ms) show ?case
  proof (cases "R_lin_independent ms")
    case True
    with Cons(3)
      have "¬ (r rs. (set (r#rs)  R  (r#rs) ∙⋅ (m#ms) = 0)  r = 0)"
      by   simp
    from this obtain r rs
      where r_rs: "set (r#rs)  R" "(r#rs) ∙⋅ (m#ms) = 0" "r  0"
      by    fast
    from r_rs(1) Cons(2) obtain ss  
      where ss: "set ss  R" "length ss = length ms" "rs ∙⋅ ms = ss ∙⋅ ms"
      using lincomb_obtain_same_length_Rcoeffs[of rs ms]
      by    auto
    from ss r_rs have "set (r#ss)  R  set (r#ss)  0
                             length (r#ss) = length (m#ms)  (r#ss) ∙⋅ (m#ms) = 0"
      using lincomb_Cons
      by    simp
    thus ?thesis by fast
  next
    case False
    with Cons(1,2) obtain rs  
      where rs: "set rs  R" "set rs  0" "length rs = length ms" "rs ∙⋅ ms = 0"
      by    fastforce
    from False rs Cons(2)
      have  "set (0#rs)  R  set (0#rs)  0  length (0#rs) = length (m#ms)
                   (0#rs) ∙⋅ (m#ms) = 0"
      using Ring1.zero_closed[OF Ring1] lincomb_Cons[of 0 rs m ms]
            zero_smult[of m] empty_set_diff_single[of "set rs"]
      by    fastforce
    thus ?thesis by fast
  qed
qed simp

lemma R_lin_independent_imp_distinct :
  "set ms  M  R_lin_independent ms  distinct ms"
proof (induct ms)
  case (Cons m ms)
  have "n. n  set ms  m  n"
  proof
    fix n assume n: "n  set ms" "m = n"
    from n(1) obtain xs ys where "ms = xs @ n # ys" using split_list by fast
    with Cons(2) n(2)
      have  "(1 # replicate (length xs) 0 @ [-1]) ∙⋅ (m # ms) = 0"
      using lincomb_Cons lincomb_append lincomb_replicate0_left lincomb_Nil neg_eq_neg1_smult
      by    simp
    with Cons(3) have "1 = 0"
      using R_scalars.zero_closed one_closed R_scalars.neg_closed by force
    thus False using one_neq_zero by fast
  qed
  with Cons show ?case by auto
qed simp

lemma R_lin_independent_imp_independent_take : 
  "set ms  M  R_lin_independent ms  R_lin_independent (take n ms)"
proof (induct ms arbitrary: n)
  case (Cons m ms) show ?case
  proof (cases n)
    case (Suc k)
    hence "take n (m#ms) = m # take k ms" by simp
    moreover have "R_lin_independent (m # take k ms)"
    proof (rule R_lin_independent_ConsI)
      from Cons show "R_lin_independent (take k ms)" by simp
    next
      fix r rs assume r_rs: "set (r#rs)  R" "(r#rs)∙⋅(m # take k ms) = 0"
      from r_rs(1) Cons(2) obtain ss
        where ss: "set ss  R" "length ss = length (take k ms)"
                  "rs ∙⋅ take k ms = ss ∙⋅ take k ms"
        using set_take_subset[of k ms] lincomb_obtain_same_length_Rcoeffs
        by    force
      from r_rs(1) ss(1) have "set (r#ss)  R" by simp
      moreover from r_rs(2) ss have "(r#ss) ∙⋅ (m#ms) = 0"
        using lincomb_Cons lincomb_Nil
              lincomb_append_right[of ss "take k ms" "drop k ms"]
        by    simp
      ultimately show "r = 0" using Cons(3) by auto
    qed
    ultimately show ?thesis by simp
  qed simp
qed simp

lemma R_lin_independent_Cons_imp_independent_RSpans :
  assumes "m  M" "R_lin_independent (m#ms)"
  shows   "add_independentS [RSpan [m], RSpan ms]"
proof (rule add_independentS_doubleI)
  fix x y assume xy: "x  RSpan [m]" "y  RSpan ms" "x + y = 0"
  from xy(1,2) obtain r rs where r_rs: "r  R" "x = r  m" "set rs  R" "y = rs ∙⋅ ms"
    using RSpan_single RSpanD_lincomb by fast
  with xy(3) have "set (r#rs)  R" "(r#rs) ∙⋅ (m#ms) = 0"
    using lincomb_Cons by auto
  with assms r_rs(2) show "x = 0" using zero_smult by auto
qed

lemma hd0_imp_R_lin_dependent : "¬ R_lin_independent (0#ms)"
  using lincomb_Cons[of 1 "[]" 0 ms] lincomb_Nil[of "[]" ms] smult_zero one_closed 
        R_lin_independent_Cons
  by    fastforce

lemma R_lin_independent_imp_hd_n0 : "R_lin_independent (m#ms)  m  0"
  using hd0_imp_R_lin_dependent by fast

lemma R_lin_independent_imp_hd_independent_from_RSpan :
  assumes "m  M" "set ms  M" "R_lin_independent (m#ms)"
  shows   "m  RSpan ms"
proof
  assume m: "m  RSpan ms"
  with assms(2) have "(-1)  m  RSpan ms"
    using RSubmodule_RSpan[of ms]
          RModule.smult_closed[of R smult "RSpan ms" "-1" m]
          one_closed R_scalars.neg_closed[of 1]
    by    simp
  moreover from assms(1) have "m + (-1)  m = 0"
    using neg_eq_neg1_smult by simp
  ultimately show False
    using RSpan_contains_spanset_single assms R_lin_independent_Cons_imp_independent_RSpans
          add_independentS_doubleD R_lin_independent_imp_hd_n0
    by    fast
qed

lemma R_lin_independent_reduce :
  assumes "n  M"
  shows   "set ms  M  R_lin_independent (ms @ n # ns)
                 R_lin_independent (ms @ ns)"
proof (induct ms)
  case (Cons m ms)
  moreover have "r rs. set (r#rs)  R  (r#rs) ∙⋅ (m#ms@ns) = 0
                       r = 0"
  proof-
    fix r rs assume r_rs: "set (r#rs)  R" "(r#rs) ∙⋅ (m # ms @ ns) = 0"
    from Cons(2) r_rs(1) obtain ss
      where ss: "set ss  R" "length ss = length ms" "rs ∙⋅ ms = ss ∙⋅ ms"
      using lincomb_obtain_same_length_Rcoeffs[of rs ms]
      by    auto
    from assms ss(2,3) r_rs(2)
      have  "(r # ss @ 0 # drop (length ms) rs) ∙⋅ (m # ms @ n # ns) = 0"
      using lincomb_Cons
            lincomb_append_right add.assoc[of "rm" "rs∙⋅ms" "(drop (length ms) rs)∙⋅ns"]
            zero_smult lincomb_append
      by    simp
    moreover from r_rs(1) ss(1)
      have  "set (r # ss @ 0 # drop (length ms) rs)  R"
      using R_scalars.zero_closed set_drop_subset[of _ rs]
      by    auto
    ultimately show "r = 0"
      using Cons(3)
            R_lin_independent_ConsD2[of m _ r "ss @ 0 # drop (length ms) rs"]
      by    simp
  qed
  ultimately show "R_lin_independent ( (m#ms) @ ns)" by auto
qed simp

lemma R_lin_independent_vs_lincomb0 :
  assumes "set (ms@n#ns)  M" "R_lin_independent (ms @ n # ns)"
          "set (rs@s#ss)  R" "length rs = length ms"
          "(rs@s#ss) ∙⋅ (ms@n#ns) = 0"
  shows   "s = 0"
proof-
  define k where "k = length rs"
  hence "(rs@s#ss)!k = s" by simp
  moreover from k_def assms(4) have "k < min (length (rs@s#ss)) (length (ms@n#ns))"
    by simp
  ultimately show ?thesis
    using assms(1,2,3,5) R_lin_independentD_all_scalars_nth[of "rs@s#ss" "ms@n#ns"]
    by    simp
qed

lemma R_lin_independent_append_imp_independent_RSpans :
  "set ms  M  R_lin_independent (ms@ns)
         add_independentS [RSpan ms, RSpan ns]"
proof (induct ms)
  case (Cons m ms)
  show ?case
  proof (rule add_independentS_doubleI)
    fix x y assume xy: "y  RSpan ns""x  RSpan (m#ms)"  "x + y = 0"
    from xy(2) obtain x1 x2
      where x1_x2: "x1  RSpan [m]" "x2  RSpan ms" "x = x1 + x2"
      using RSpan_Cons set_plus_def[of "RSpan [m]"]
      by    auto
    from x1_x2(1,2) xy(1) obtain r rs ss
      where r_rs_ss: "set (r#(rs@ss))  R" "length rs = length ms" "x1 = r  m"
                     "x2 = rs ∙⋅ ms" "y = ss ∙⋅ ns"
      using RSpan_single in_RSpan_obtain_same_length_coeffs[of x2 ms]
            RSpanD_lincomb[of ns]
      by    auto
    have x1_0: "x1 = 0"
    proof-
      from xy(3) x1_x2(3) r_rs_ss(2-5) have "(r#(rs@ss)) ∙⋅ (m#(ms@ns)) = 0"
        using lincomb_append lincomb_Cons by (simp add: algebra_simps)
      with r_rs_ss(1,3) Cons(2,3) show ?thesis
        using R_lin_independent_ConsD2[of m "ms@ns" r "rs@ss"] zero_smult by simp
    qed
    moreover have "x2 = 0"
    proof-
      from x1_0 xy(3) x1_x2(3) have "x2 + y = 0" by simp
      with xy(1) x1_x2(2) Cons show ?thesis
        using add_independentS_doubleD by simp
    qed
    ultimately show "x = 0" using x1_x2(3) by simp
  qed
qed simp

end (* context RModule *)

subsubsection ‹Linear independence over UNIV›

context scalar_mult
begin

abbreviation "lin_independent ms
                     R_scalar_mult.R_lin_independent UNIV smult ms"

lemmas lin_independent_ConsI
              = R_scalar_mult.R_lin_independent_ConsI [OF R_scalar_mult, of smult]
lemmas lin_independent_ConsD1
              = R_scalar_mult.R_lin_independent_ConsD1[OF R_scalar_mult, of smult]

end (* context scalar_mult *)

context Module
begin

lemmas lin_independent_imp_independent_take = R_lin_independent_imp_independent_take
lemmas lin_independent_reduce               = R_lin_independent_reduce
lemmas lin_independent_vs_lincomb0          = R_lin_independent_vs_lincomb0
lemmas lin_dependent_dependence_relation    = R_lin_dependent_dependence_relation
lemmas lin_independent_imp_distinct         = R_lin_independent_imp_distinct

lemmas lin_independent_imp_hd_independent_from_Span
                                                = R_lin_independent_imp_hd_independent_from_RSpan
lemmas lin_independent_append_imp_independent_Spans
                                                = R_lin_independent_append_imp_independent_RSpans

end (* context Module *)

subsubsection ‹Rank›

context R_scalar_mult
begin

definition R_finrank :: "'m set  bool"
  where "R_finrank M = (n. ms. set ms  M
               R_lin_independent ms  length ms  n)"

lemma R_finrankI :
  "(ms. set ms  M  R_lin_independent ms  length ms  n) 
         R_finrank M"
  unfolding R_finrank_def by blast

lemma R_finrankD :
  "R_finrank M  n. ms. set ms  M  R_lin_independent ms 
         length ms  n"
  unfolding R_finrank_def by fast

lemma submodule_R_finrank : "R_finrank M  N  M  R_finrank N"
  unfolding R_finrank_def by blast

end (* context R_scalar_mult *)

context scalar_mult
begin

abbreviation finrank :: "'m set  bool"
  where "finrank  R_scalar_mult.R_finrank UNIV smult"

lemmas finrankI = R_scalar_mult.R_finrankI[OF R_scalar_mult, of _ smult]
lemmas finrankD = R_scalar_mult.R_finrankD[OF R_scalar_mult, of smult]
lemmas submodule_finrank
              = R_scalar_mult.submodule_R_finrank [OF R_scalar_mult, of smult]

end (* context scalar_mult *)


subsection ‹Module homomorphisms›

subsubsection ‹Locales›

locale RModuleHom = Domain?: RModule R smult M
+ Codomain?: scalar_mult smult'
+ GroupHom?: GroupHom M T
  for R      :: "'r::ring_1 set"
  and smult  :: "'r  'm::ab_group_add  'm" (infixr "" 70)
  and M      :: "'m set"
  and smult' :: "'r  'n::ab_group_add  'n" (infixr "" 70)
  and T      :: "'m  'n"
+ assumes R_map: "r m. r  R  m  M  T (r  m) = r  T m"

abbreviation (in RModuleHom) lincomb' :: "'r list  'n list  'n" (infix "∙⋆" 70)
  where "lincomb'  Codomain.lincomb"

lemma (in RModule) RModuleHomI :
  assumes "GroupHom M T"
          "r m. r  R  m  M  T (r  m) = smult' r (T m)"
  shows   "RModuleHom R smult M smult' T"
  by      (
            rule RModuleHom.intro, rule RModule_axioms, rule assms(1), unfold_locales,
            rule assms(2)
          )

locale RModuleEnd = RModuleHom R smult M smult T
  for R     :: "'r::ring_1 set"
  and smult :: "'r  'm::ab_group_add  'm" (infixr "" 70)
  and M     :: "'m set"
  and T     :: "'m  'm"
+ assumes endomorph: "ImG  M"

locale ModuleHom = RModuleHom UNIV smult M smult' T
  for smult  :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)
  and M      :: "'m set"
  and smult' :: "'r  'n::ab_group_add  'n" (infixr "" 70)
  and T      :: "'m  'n"

lemmas (in ModuleHom) hom = hom

lemmas (in Module) ModuleHomI = RModuleHomI[THEN ModuleHom.intro]

locale ModuleEnd = ModuleHom smult M smult T
  for smult :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)
  and M     :: "'m set" and T :: "'m  'm"
+ assumes endomorph: "ImG  M"

locale RModuleIso = RModuleHom R smult M smult' T
  for   R      :: "'r::ring_1 set"
  and   smult  :: "'r  'm::ab_group_add  'm" (infixr "" 70)
  and   M      :: "'m set"
  and   smult' :: "'r  'n::ab_group_add  'n" (infixr "" 70)
  and   T      :: "'m  'n"
+ fixes N      :: "'n set"
  assumes bijective: "bij_betw T M N"

lemma (in RModule) RModuleIsoI :
  assumes "GroupIso M T N"
          "r m. r  R  m  M  T (r  m) = smult' r (T m)"
  shows   "RModuleIso R smult M smult' T N"
proof (rule RModuleIso.intro)
  from assms show "RModuleHom R (⋅) M smult' T"
    using GroupIso.axioms(1) RModuleHomI by fastforce
  from assms(1) show "RModuleIso_axioms M T N"
    using GroupIso.bijective by unfold_locales
qed

subsubsection ‹Basic facts›

lemma (in RModule) trivial_RModuleHom :
  "rR. smult' r 0 = 0  RModuleHom R smult M smult' 0"
  using trivial_GroupHom RModuleHomI by fastforce

lemma (in RModule) RModHom_idhom : "RModuleHom R smult M smult (idM)"
  using RModule_axioms GroupHom_idhom
proof (rule RModuleHom.intro)
  show "RModuleHom_axioms R (⋅) M (⋅) (id  M)"
    using smult_closed by unfold_locales simp
qed

context RModuleHom
begin

lemmas additive        = hom
lemmas supp            = supp
lemmas im_zero         = im_zero
lemmas im_diff         = im_diff
lemmas Ker_Im_iff      = Ker_Im_iff
lemmas Ker0_imp_inj_on = Ker0_imp_inj_on

lemma GroupHom : "GroupHom M T" ..

lemma codomain_smult_zero : "r  R  r  0 = 0"
  using im_zero smult_zero zero_closed R_map[of r 0] by simp

lemma RSubmodule_Ker : "Domain.RSubmodule Ker"
proof (rule Domain.RSubmoduleI, rule conjI, rule Group_Ker)
  fix r m assume r: "r  R" and m: "m  Ker"
  thus "r  m  Ker"
    using R_map[of r m] kerD[of m T] codomain_smult_zero kerI Domain.smult_closed
    by    simp
qed fast

lemma RModule_Im : "RModule R smult' ImG"
  using Ring1 Group_Im
proof (rule RModuleI, unfold_locales)
  show "n. n  T ` M  1  n = n" using one_closed R_map[of 1] by auto
next
  fix r s m n assume r: "r  R" and s: "s  R" and m: "m  T ` M"
    and n: "n  T ` M"
  from m n obtain m' n'
    where m': "m'  M" "m = T m'" and n': "n'  M" "n = T n'"
    by    fast
  from m' r R_map have "r  m = T (r  m')" by simp
  with r m'(1) show "r  m  T ` M" using smult_closed by fast
  from r m' n' show "r  (m + n) = r  m + r  n"
    using hom add_closed R_map[of r "m'+n'"] smult_closed R_map[of r] by simp
  from r s m' show "(r + s)  m = r  m + s  m"
    using R_scalars.add_closed R_map[of "r+s"] smult_closed hom R_map by simp
  from r s m' show "r  s  m = (r * s)  m"
    using smult_closed R_map[of s] R_map[of r "s  m'"] mult_closed R_map[of "r*s"]
    by    simp
qed

lemma im_submodule :
  assumes "RSubmodule N"
  shows   "RModule.RSubmodule R smult' ImG (T ` N)"
proof (rule RModule.RSubmoduleI, rule RModule_Im)
  from assms show "Group.Subgroup (T ` M) (T ` N)"
    using im_subgroup Subgroup_RSubmodule by fast
  from assms R_map  show "r n. r  R  n  T ` N  r  n  T ` N"
    using RModule.smult_closed by force
qed

lemma RModHom_composite_left :
  assumes "T ` M  N" "RModuleHom R smult' N smult'' S"
  shows   "RModuleHom R smult M smult'' (S  T)"
proof (rule RModule.RModuleHomI, rule RModule_axioms)
  from assms(1) show "GroupHom M (S  T)"
    using RModuleHom.GroupHom[OF assms(2)] GroupHom_composite_left
    by    auto
  from assms(1)
    show  "r m. r  R  m  M  (S  T) (r  m) = smult'' r ((S  T) m)"
    using R_map RModuleHom.R_map[OF assms(2)]
    by    auto
qed

lemma RModuleHom_restrict0_submodule :
  assumes "RSubmodule N"
  shows   "RModuleHom R smult N smult' (T  N)"
proof (rule RModuleHom.intro)
  from assms show "RModule R (⋅) N" by fast
  from assms show "GroupHom N (T  N)"
    using RModule.Group GroupHom_restrict0_subgroup by fast
  show "RModuleHom_axioms R (⋅) N (⋆) (T  N)"
  proof
    fix r m assume "r  R" "m  N"
    with assms show "(T  N) (r  m) = r  (T  N) m"
      using RModule.smult_closed R_map by fastforce
  qed
qed

lemma distrib_lincomb :
  "set rs  R  set ms  M  T (rs ∙⋅ ms) = rs ∙⋆ map T ms"
  using Domain.lincomb_Nil im_zero Codomain.lincomb_Nil R_map Domain.lincomb_Cons
        Domain.smult_closed Domain.lincomb_closed additive Codomain.lincomb_Cons
  by    (induct rs ms rule: list_induct2') auto

lemma same_image_on_RSpanset_imp_same_hom :
  assumes "RModuleHom R smult M smult' S" "set ms  M"
          "M = Domain.R_scalars.RSpan ms" "mset ms. S m = T m"
  shows   "S = T"
proof
  fix m show "S m = T m"
  proof (cases "m  M")
    case True
    with assms(2,3) obtain rs where rs: "set rs  R" "m = rs ∙⋅ ms"
      using Domain.RSpanD_lincomb_arb_len_coeffs by fast
    from rs(1) assms(2) have "S (rs ∙⋅ ms) = rs ∙⋆ (map S ms)"
      using RModuleHom.distrib_lincomb[OF assms(1)] by simp
    moreover from rs(1) assms(2) have "T (rs ∙⋅ ms) = rs ∙⋆ (map T ms)"
      using distrib_lincomb by simp
    ultimately show ?thesis using assms(4) map_ext[of ms S T] rs(2) by auto
  next
    case False with assms(1) supp show ?thesis
      using RModuleHom.supp suppI_contra[of _ S] suppI_contra[of _ T] by fastforce
  qed
qed

end (* context RModuleHom *)

lemma RSubmodule_eigenspace :
  fixes   smult :: "'r::ring_1  'm::ab_group_add  'm" (infixr "" 70)
  assumes RModHom: "RModuleHom R smult M smult T"
  and     r: "r  R" "s m. s  R  m  M  s  r  m = r  s  m"
  defines E: "E  {m  M. T m = r  m}"
  shows   "RModule.RSubmodule R smult M E"
proof (rule RModule.RSubmoduleI)
  from RModHom show rmod: "RModule R smult M"
    using RModuleHom.axioms(1) by fast
  have "Group E"
  proof
    from r(1) E show "E  {}"
      using RModule.zero_closed[OF rmod] RModuleHom.im_zero[OF RModHom]
            RModule.smult_zero[OF rmod]
      by    auto
  next
    fix m n assume "m  E" "n  E"
    with r(1) E show "m - n  E"
      using RModule.diff_closed[OF rmod] RModuleHom.im_diff[OF RModHom] 
            RModule.smult_distrib_left_diff[OF rmod]
      by    simp
  qed
  with E show "Group.Subgroup M E" by fast
  show "s m. s  R  m  E  s  m  E"
  proof-
    fix s m assume "s  R" "m  E"
    with E r RModuleHom.R_map[OF RModHom] show "s  m  E"
      using RModule.smult_closed[OF rmod] by simp
  qed
qed

subsubsection ‹Basic facts about endomorphisms›

lemma (in RModule) Rmap_endomorph_is_RModuleEnd :
  assumes grpend: "GroupEnd M T"
  and     Rmap  : "r m. r  R  m  M  T (r  m) = r  (T m)"
  shows   "RModuleEnd R smult M T"
proof (rule RModuleEnd.intro, rule RModuleHomI)
  from grpend show "GroupHom M T" using GroupEnd.axioms(1) by fast
  from grpend show "RModuleEnd_axioms M T"
    using GroupEnd.endomorph by unfold_locales
qed (rule Rmap)

lemma (in RModuleEnd) GroupEnd : "GroupEnd M T"
proof (rule GroupEnd.intro)
  from endomorph show "GroupEnd_axioms M T" by unfold_locales
qed (unfold_locales)

lemmas (in RModuleEnd) proj_decomp    = GroupEnd.proj_decomp[OF GroupEnd]

lemma (in ModuleEnd) RModuleEnd : "RModuleEnd UNIV smult M T"
  using endomorph RModuleEnd.intro by unfold_locales

lemmas (in ModuleEnd) GroupEnd = RModuleEnd.GroupEnd[OF RModuleEnd]

lemma RModuleEnd_over_UNIV_is_ModuleEnd :
  "RModuleEnd UNIV rsmult M T  ModuleEnd rsmult M T"
proof (rule ModuleEnd.intro, rule ModuleHom.intro)
  assume endo: "RModuleEnd UNIV rsmult M T"
  thus "RModuleHom UNIV rsmult M rsmult T"
    using RModuleEnd.axioms(1) by fast
  from endo show "ModuleEnd_axioms M T"
    using RModuleEnd.endomorph by unfold_locales
qed

subsubsection ‹Basic facts about isomorphisms›

context RModuleIso
begin

abbreviation "invT  (the_inv_into M T)  N"

lemma GroupIso : "GroupIso M T N"
proof (rule GroupIso.intro)
  show "GroupHom M T" ..
  from bijective show "GroupIso_axioms M T N" by unfold_locales
qed

lemmas ImG           = GroupIso.ImG         [OF GroupIso]
lemmas GroupHom_inv = GroupIso.inv        [OF GroupIso]
lemmas invT_into    = GroupIso.invT_into  [OF GroupIso]
lemmas T_invT       = GroupIso.T_invT     [OF GroupIso]
lemmas invT_eq      = GroupIso.invT_eq    [OF GroupIso]

lemma RModuleN : "RModule R smult' N" using RModule_Im ImG by fast

lemma inv : "RModuleIso R smult' N smult invT M"
  using RModuleN GroupHom_inv
proof (rule RModule.RModuleIsoI)
  fix r n assume rn: "r  R" "n  N"
  thus "invT (r  n) = r  invT n"
    using invT_into smult_closed R_map T_invT invT_eq by simp
qed

end (* context RModuleIso *)


subsection ‹Inner direct sums of RModules›

lemma (in RModule) RModule_inner_dirsum_el_decomp_Rsmult :
  assumes "Nset Ns. RSubmodule N" "add_independentS Ns" "r  R"
          "x  (NNs. N)"
  shows   "(Ns(r  x)) = [r  m. m(Nsx)]"
proof-
  define xs where "xs = (Nsx)"
  with assms have x: "xs  listset Ns" "x = sum_list xs"
    using RModule.AbGroup[of R] AbGroup_inner_dirsum_el_decompI[of Ns x]
    by    auto
  from assms(1,2,4) xs_def have xs_M: "set xs  M"
    using Subgroup_RSubmodule
          AbGroup.abSubgroup_inner_dirsum_el_decomp_set[OF AbGroup]
    by    fast
  from assms(1,3) x(1) have "[r  m. mxs]  listset Ns"
    using listset_RModule_Rsmult_closed by fast
  moreover from x assms(3) xs_M have "r  x = sum_list [r  m. mxs]"
    using smult_sum_list_distrib by fast
  moreover from assms(1,3,4) have "r  x  (MNs. M)" 
    using RModule_inner_dirsum RModule.smult_closed by fast
  ultimately show "(Ns(r  x)) = [r  m. mxs]"
    using assms(1,2) RModule.AbGroup AbGroup_inner_dirsum_el_decomp_eq
     by   fast
qed

lemma (in RModule) RModuleEnd_inner_dirsum_el_decomp_nth :
  assumes "N  set Ns. RSubmodule N" "add_independentS Ns" "n < length Ns"
  shows   "RModuleEnd R smult (NNs. N) (Nsn)"
proof (rule RModule.Rmap_endomorph_is_RModuleEnd)
  from assms(1) show "RModule R smult (NNs. N)"
    using RSubmodule_inner_dirsum by fast
  from assms show "GroupEnd (NNs. N) Nsn"
    using RModule.AbGroup GroupEnd_inner_dirsum_el_decomp_nth[of Ns] by fast
  show "r m. r  R  m  (NNs. N)
               (Nsn) (r  m) = r  ((Nsn) m)"
  proof-
    fix r m assume "r  R" "m  (NNs. N)"
    moreover with assms(1) have "r  m  (MNs. M)" 
      using RModule_inner_dirsum RModule.smult_closed by fast
    ultimately show "(Nsn) (r  m) = r  (Nsn) m"
      using assms RModule.AbGroup[of R smult]
            AbGroup_length_inner_dirsum_el_decomp[of Ns]
            RModule_inner_dirsum_el_decomp_Rsmult
      by    simp
  qed
qed




section ‹Vector Spaces›


subsection ‹Locales and basic facts›

text ‹Here we don't care about being able to switch scalars.›

locale fscalar_mult = scalar_mult smult
  for smult :: "'f::field  'v::ab_group_add  'v" (infixr "" 70)

abbreviation (in fscalar_mult) "findim  fingen"

locale VectorSpace = Module smult V
  for smult :: "'f::field  'v::ab_group_add  'v" (infixr "" 70)
  and V     :: "'v set"

lemmas VectorSpaceI = ModuleI[THEN VectorSpace.intro]

sublocale VectorSpace < fscalar_mult proof- qed

locale FinDimVectorSpace = VectorSpace
+ assumes findim: "findim V"

lemma (in VectorSpace) FinDimVectorSpaceI :
  "findim V  FinDimVectorSpace (⋅) V"
  by unfold_locales fast

context VectorSpace
begin

abbreviation Subspace :: "'v set  bool" where "Subspace  Submodule"

lemma SubspaceD1 : "Subspace U  VectorSpace smult U"
  using VectorSpace.intro Module.intro by fast

lemmas AbGroup                           = AbGroup
lemmas add_closed                        = add_closed
lemmas smult_closed                      = smult_closed
lemmas one_smult                         = one_smult
lemmas smult_assoc                       = smult_assoc
lemmas smult_distrib_left                = smult_distrib_left
lemmas smult_distrib_right               = smult_distrib_right
lemmas zero_closed                       = zero_closed
lemmas zero_smult                        = zero_smult
lemmas smult_zero                        = smult_zero
lemmas smult_lincomb                     = smult_lincomb
lemmas smult_distrib_left_diff           = smult_distrib_left_diff
lemmas smult_sum_distrib              = smult_sum_distrib
lemmas sum_smult_distrib              = sum_smult_distrib
lemmas lincomb_sum                       = lincomb_sum
lemmas lincomb_closed                    = lincomb_closed
lemmas lincomb_concat                    = lincomb_concat
lemmas lincomb_replicate0_left           = lincomb_replicate0_left
lemmas delta_scalars_lincomb_eq_nth      = delta_scalars_lincomb_eq_nth
lemmas SpanI                             = SpanI
lemmas Span_closed                       = Span_closed
lemmas SpanD_lincomb_arb_len_coeffs      = SpanD_lincomb_arb_len_coeffs
lemmas SpanI_lincomb_arb_len_coeffs      = SpanI_lincomb_arb_len_coeffs
lemmas in_Span_obtain_same_length_coeffs = in_Span_obtain_same_length_coeffs
lemmas SubspaceI                         = SubmoduleI
lemmas subspace_finrank                  = submodule_finrank

lemma cancel_scalar: " a  0; u  V; v  V; a  u = a  v   u = v"
  using smult_assoc[of "1/a" a u] by simp

end (* context VectorSpace *)


subsection ‹Linear algebra in vector spaces›

subsubsection ‹Linear independence and spanning›

context VectorSpace
begin

lemmas Subspace_Span                         = Submodule_Span
lemmas lin_independent_Nil                   = R_lin_independent_Nil
lemmas lin_independentI_concat_all_scalars   = R_lin_independentI_concat_all_scalars
lemmas lin_independentD_all_scalars          = R_lin_independentD_all_scalars
lemmas lin_independent_obtain_unique_scalars = R_lin_independent_obtain_unique_scalars

lemma lincomb_Cons_0_imp_in_Span :
  " v  V; set vs  V; a  0; (a#as) ∙⋅ (v#vs) = 0   v  Span vs"
  using lincomb_Cons eq_neg_iff_add_eq_0[of "a  v" "as ∙⋅ vs"]
        neg_lincomb smult_assoc[of "1/a" a v] smult_lincomb SpanD_lincomb_arb_len_coeffs
  by    auto

lemma lin_independent_Cons_conditions :  
  " v  V; set vs  V; v  Span vs; lin_independent vs 
         lin_independent (v#vs)"
  using lincomb_Cons_0_imp_in_Span lin_independent_ConsI by fast

lemma coeff_n0_imp_in_Span_others :
  assumes "v  V" "set us  V" "set vs  V" "b  0" "length as = length us"
          "w = (as @ b # bs) ∙⋅ (us @ v # vs)"
  shows   "v  Span (w # us @ vs)"
proof-
  define x where "x = (1 # [- c. cas@bs]) ∙⋅ (w # us @ vs)"
  from assms(1,4-6) have "v = (1/b)  (w + - ( (as@bs) ∙⋅ (us@vs) ))"
    using lincomb_append lincomb_Cons by simp
  moreover from assms(1,2,3,6) have w: "w  V" using lincomb_closed by simp
  ultimately have "v = (1/b)  x"
    using x_def assms(2,3) neg_lincomb[of _ "us@vs"] lincomb_Cons[of 1 _ w] by simp
  with x_def w assms(2,3) show ?thesis
    using SpanD_lincomb_arb_len_coeffs[of "w # us @ vs"]
          Span_smult_closed[of "1/b" "w # us @ vs" x]
    by    auto
qed

lemma lin_independent_replace1_by_lincomb :
  assumes "set us  V" "v  V" "set vs  V" "lin_independent (us @ v # vs)"
          "length as = length us" "b  0"
  shows   "lin_independent ( ((as @ b # bs) ∙⋅ (us @ v # vs)) # us @ vs )"
proof-
  define w where "w = (as @ b # bs) ∙⋅ (us @ v # vs)"
  from assms(1,2,4) have "lin_independent (us @ vs)"
    using lin_independent_reduce by fast
  hence "lin_independent (w # us @ vs)"
  proof (rule lin_independent_ConsI)
    fix c cs assume A: "(c#cs) ∙⋅ (w # us @ vs) = 0"
    from assms(1,3) obtain ds es fs
      where dsesfs: "length ds = length vs" "bs ∙⋅ vs = ds ∙⋅ vs"
                    "length es = length vs" "(drop (length us) cs) ∙⋅ vs = es ∙⋅ vs"
                    "length fs = length us" "cs ∙⋅ us = fs ∙⋅ us"
      using lincomb_obtain_same_length_coeffs[of bs vs]
            lincomb_obtain_same_length_coeffs[of "drop (length us) cs" vs]
            lincomb_obtain_same_length_coeffs[of cs us]
      by    auto
    define xs ys
      where "xs = [x+y. (x,y)zip [c*a. aas] fs]"
        and "ys = [x+y. (x,y)zip es [c*d. dds]]"
    with assms(5) dsesfs(5) have len_xs: "length xs = length us"
      using length_concat_map_split_zip[of _ "[c*a. aas]" fs] by simp
    from A w_def assms(1-3,5) dsesfs(2,4,6)
      have "0 = c  as ∙⋅ us + fs ∙⋅ us + (c * b)  v + es ∙⋅ vs + c  ds ∙⋅ vs"
      using lincomb_Cons lincomb_append_right lincomb_append add_closed smult_closed
            lincomb_closed
      by    (simp add: algebra_simps)
    also from assms(1,3,5) dsesfs(1,3,5) xs_def ys_def len_xs
      have " = (xs @ (c * b) # ys) ∙⋅ (us @ v # vs)"
      using smult_lincomb lincomb_sum lincomb_Cons lincomb_append by simp
    finally have "(xs @ (c * b) # ys) ∙⋅ (us @ v # vs) = 0" by simp
    with assms(1-3,4,6) len_xs show "c = 0"
      using lin_independent_vs_lincomb0 by fastforce
  qed
  with w_def show ?thesis by fast
qed

lemma build_lin_independent_seq :
  assumes us_V: "set us  V"
  and     indep_us: "lin_independent us"
  shows   "ws. set ws  V  lin_independent (ws @ us)  (Span (ws @ us) = V
                 length ws = n)"
proof (induct n)
  case 0 from indep_us show ?case by force
next
  case (Suc m)
  from this obtain ws 
    where ws: "set ws  V" "lin_independent (ws @ us)"
              "Span (ws@us) = V  length ws = m"
    by    auto
  show ?case
  proof (cases "V = Span (ws@us)")
    case True with ws show ?thesis by fast
  next
    case False
    moreover from ws(1) us_V have ws_us_V: "set (ws @ us)  V" by simp
    ultimately have "Span (ws@us)  V" using Span_closed by fast
    from this obtain w where w: "w  V" "w  Span (ws@us)" by fast
    define vs where "vs = w # ws"
    with w ws_us_V ws(2,3)
      have  "set (vs @ us)  V" "lin_independent (vs @ us)" "length vs = Suc m"
      using lin_independent_Cons_conditions[of w "ws@us"]
      by    auto
    thus ?thesis by auto
  qed
qed

end (* context VectorSpace *)

subsubsection ‹Basis for a vector space: basis_for›

abbreviation (in fscalar_mult) basis_for :: "'v set  'v list  bool"
  where "basis_for V vs  (set vs  V  V = Span vs  lin_independent vs)"

context VectorSpace
begin

lemma spanset_contains_basis :
  "set vs  V  us. set us  set vs  basis_for (Span vs) us"
proof (induct vs)
  case Nil show ?case using lin_independent_Nil by simp
next
  case (Cons v vs)
  from this obtain ws where ws: "set ws  set vs" "basis_for (Span vs) ws" by auto
  show ?case
  proof (cases "v  Span vs")
    case True
    with Cons(2) ws(2) have "basis_for (Span (v#vs)) ws"
      using spanset_reduce_Cons by force
    with ws(1) show ?thesis by auto
  next
    case False
    from Cons(2) ws
      have  "set (v#ws)  set (v#vs)" "set (v#ws)  Span (v#vs)"
            "Span (v#vs) = Span (v#ws)"
      using Span_contains_spanset[of "v#vs"]
            Span_contains_Spans_Cons_right[of v vs] Span_Cons
      by    auto
    moreover have "lin_independent (v#ws)"
    proof (rule lin_independent_Cons_conditions)
      from Cons(2) ws(1) show "v  V" "set ws  V" by auto
      from ws(2) False show "v  Span ws" "lin_independent ws" by auto
    qed
    ultimately show ?thesis by blast
  qed
qed

lemma basis_for_Span_ex : "set vs  V  us. basis_for (Span vs) us"
  using spanset_contains_basis by fastforce

lemma replace_basis_one_step :
  assumes closed: "set vs  V" "set us  V" and indep: "lin_independent (us@vs)"
  and     new_w: "w  Span (us@vs) - Span us"
  shows   "xs y ys. vs = xs @ y # ys
                 basis_for (Span (us@vs)) (w # us @ xs @ ys)"
proof-
  from new_w obtain u v where uv: "u  Span us" "v  Span vs" "w = u + v"
    using Span_append set_plus_def[of "Span us"] by auto
  from uv(1,3) new_w have v_n0: "v  0" by auto
  from uv(1,2) obtain as bs
    where as_bs: "length as = length us" "u = as ∙⋅ us" "length bs = length vs"
                 "v = bs ∙⋅ vs"
    using in_Span_obtain_same_length_coeffs
    by    blast
  from v_n0 as_bs(4) closed(1) obtain b where b: "b  set bs" "b  0"
    using lincomb_0coeffs[of vs] by auto
  from b(1) obtain cs ds where cs_ds: "bs = cs @ b # ds" using split_list by fast
  define n where "n = length cs"
  define fvs where "fvs = take n vs"
  define y where "y = vs!n"
  define bvs where "bvs = drop (Suc n) vs"
  define ufvs where "ufvs = us @ fvs"
  define acs where "acs = as @ cs"
  from as_bs(1,3) cs_ds n_def acs_def ufvs_def fvs_def
    have n_len_vs: "n < length vs" and len_acs: "length acs = length ufvs"
    by   auto
  from n_len_vs fvs_def y_def bvs_def have vs_decomp: "vs = fvs @ y # bvs"
    using id_take_nth_drop by simp
  with uv(3) as_bs(1,2,4) cs_ds acs_def ufvs_def
    have  w_decomp: "w = (acs @ b # ds) ∙⋅ (ufvs @ y # bvs)"
    using lincomb_append
    by    simp
  from closed(1) vs_decomp
    have y_V: "y  V" and fvs_V: "set fvs  V" and bvs_V: "set bvs  V"
    by   auto
  from ufvs_def fvs_V closed(2) have ufvs_V: "set ufvs  V" by simp
  from w_decomp ufvs_V y_V bvs_V have w_V: "w  V"
    using lincomb_closed by simp
  have "Span (us@vs) = Span (w # ufvs @ bvs)"
  proof
    from vs_decomp ufvs_def have 1: "Span (us@vs) = Span (y # ufvs @ bvs)"
      using Span_append Span_Cons[of y bvs] Span_Cons[of y ufvs]
            Span_append[of "y#ufvs" bvs]
      by    (simp add: algebra_simps)
    with new_w y_V ufvs_V bvs_V show "Span (w # ufvs @ bvs)  Span (us@vs)"
      using Span_replace_hd by simp
    from len_acs w_decomp y_V ufvs_V bvs_V have "y  Span (w # ufvs @ bvs)"
      using b(2) coeff_n0_imp_in_Span_others by simp
    with w_V ufvs_V bvs_V have "Span (y # ufvs @ bvs)  Span (w # ufvs @ bvs)"
      using Span_replace_hd by simp
    with 1 show "Span (us@vs)  Span (w # ufvs @ bvs)" by fast
  qed
  moreover from ufvs_V y_V bvs_V ufvs_def indep vs_decomp w_decomp len_acs b(2)
    have  "lin_independent (w # ufvs @ bvs)"
    using lin_independent_replace1_by_lincomb[of ufvs y bvs acs b ds]
    by    simp
  moreover have "set (w # (us@fvs) @ bvs)  Span (us@vs)"
  proof-
    from new_w have "w  Span (us@vs)" by fast
    moreover from closed have "set us  Span (us@vs)"
      using Span_contains_spanset_append_left by fast
    moreover from closed fvs_def have "set fvs  Span (us@vs)"
      using Span_contains_spanset_append_right[of us] set_take_subset by fastforce
    moreover from closed bvs_def have "set bvs  Span (us@vs)"
      using Span_contains_spanset_append_right[of us] set_drop_subset by fastforce
    ultimately show ?thesis by simp
  qed
  ultimately show ?thesis using ufvs_def vs_decomp by auto
qed

lemma replace_basis :
  assumes closed: "set vs  V" and indep_vs: "lin_independent vs"
  shows   " length us  length vs; set us  Span vs; lin_independent us 
                 pvs. length pvs = length vs  set pvs = set vs
                   basis_for (Span vs) (take (length vs) (us @ pvs))"
proof (induct us)
  case Nil from closed indep_vs show ?case
    using Span_contains_spanset[of vs] by fastforce
next
  case (Cons u us)
  from this obtain ppvs
    where ppvs: "length ppvs = length vs" "set ppvs = set vs"
                "basis_for (Span vs) (take (length vs) (us @ ppvs))"
    using lin_independent_ConsD1[of u us]
    by    auto
  define fppvs bppvs
    where "fppvs = take (length vs - length us) ppvs"
      and "bppvs = drop (length vs - length us) ppvs"
  with ppvs(1) Cons(2)
    have ppvs_decomp: "ppvs = fppvs @ bppvs"
    and  len_fppvs  : "length fppvs = length vs - length us"
    by    auto
  from closed Cons(3) have uus_V:  "u  V" "set us  V"
    using Span_closed by auto
  from closed ppvs(2) have "set ppvs  V" by fast
  with fppvs_def have fppvs_V: "set fppvs  V" using set_take_subset[of _ ppvs] by fast
  from fppvs_def Cons(2)
    have prev_basis_decomp: "take (length vs) (us @ ppvs) = us @ fppvs"
    by   auto
  with Cons(3,4) ppvs(3) fppvs_V uus_V obtain xs y ys
    where xs_y_ys: "fppvs = xs @ y # ys" "basis_for (Span vs) (u # us @ xs @ ys)"
    using lin_independent_imp_hd_independent_from_Span
          replace_basis_one_step[of fppvs us u]
    by    auto
  define pvs where "pvs = xs @ ys @ y # bppvs"
  with xs_y_ys len_fppvs ppvs_decomp ppvs(1,2)
    have "length pvs = length vs" "set pvs = set vs" 
         "basis_for (Span vs) (take (length vs) ((u # us) @ pvs))"
    using take_append[of "length vs" "u # us @ xs @ ys"]
    by    auto
  thus ?case by fast
qed

lemma replace_basis_completely :
  " set vs  V; lin_independent vs; length us = length vs;
        set us  Span vs; lin_independent us   basis_for (Span vs) us"
  using replace_basis[of vs us] by auto

lemma basis_for_obtain_unique_scalars :
  "basis_for V vs  v  V  ∃! as. length as = length vs  v = as ∙⋅ vs"
  using lin_independent_obtain_unique_scalars by fast

lemma add_unique_scalars :
  assumes vs: "basis_for V vs" and v: "v  V" and v': "v'  V"
  defines as: "as  (THE ds. length ds = length vs  v = ds ∙⋅ vs)"
  and     bs: "bs  (THE ds. length ds = length vs  v' = ds ∙⋅ vs)"
  and     cs: "cs  (THE ds. length ds = length vs  v+v' = ds ∙⋅ vs)"
  shows   "cs = [a+b. (a,b)zip as bs]"
proof-
  from vs v v' as bs
    have  as': "length as = length vs  v = as ∙⋅ vs"
    and   bs': "length bs = length vs  v' = bs ∙⋅ vs"
    using basis_for_obtain_unique_scalars theI'[
            of "λds. length ds = length vs  v = ds ∙⋅ vs"
          ]
          theI'[of "λds. length ds = length vs  v' = ds ∙⋅ vs"]
    by    auto
  have "length [a+b. (a,b)zip as bs] = length (zip as bs)"
    by (induct as bs rule: list_induct2') auto
  with vs as' bs'
    have  "length [a+b. (a,b)zip as bs]
                = length vs  v + v' = [a + b. (a,b)zip as bs] ∙⋅ vs"
    using lincomb_sum
    by    auto
  moreover from vs v v' have "∃! ds. length ds = length vs  v+v' = ds ∙⋅ vs"
    using add_closed basis_for_obtain_unique_scalars by force
  ultimately show ?thesis using cs the1_equality by fast
qed

lemma smult_unique_scalars :
  fixes   a::'f
  assumes vs: "basis_for V vs" and v: "v  V"
  defines as: "as  (THE cs. length cs = length vs  v = cs ∙⋅ vs)"
  and     bs: "bs  (THE cs. length cs = length vs  a  v = cs ∙⋅ vs)"
  shows   "bs = map ((*) a) as"
proof-
  from vs v as have "length as = length vs  v = as ∙⋅ vs"
    using basis_for_obtain_unique_scalars theI'[
            of "λcs. length cs = length vs  v = cs ∙⋅ vs"
          ]
    by    auto
  with vs have "length (map ((*) a) as)
                      = length vs  a  v = (map ((*) a) as) ∙⋅ vs"
    using smult_lincomb by auto
  moreover from vs v have "∃! cs. length cs = length vs  a  v = cs ∙⋅ vs"
    using smult_closed basis_for_obtain_unique_scalars by fast
  ultimately show ?thesis using bs the1_equality by fast
qed

lemma max_lin_independent_set_in_Span :
  assumes "set vs  V" "set us  Span vs" "lin_independent us"
  shows   "length us  length vs"
proof (cases us)
  case (Cons x xs)
  from assms(1) spanset_contains_basis[of vs] obtain bvs
    where bvs: "set bvs  set vs" "basis_for (Span vs) bvs"
    by    auto
  with assms(1) have len_bvs: "length bvs  length vs"
    using lin_independent_imp_distinct[of bvs] distinct_card finite_set 
          card_mono[of "set vs" "set bvs"] card_length[of vs]
    by    fastforce
  moreover have "length (x#xs) > length bvs  ¬ lin_independent (x#xs)"
  proof
    assume A: "length (x#xs) > length bvs" "lin_independent (x#xs)"
    define ws where "ws = take (length bvs) xs"
    from Cons assms(1,2) have xxs_V: "x  V" "set xs  V"
      using Span_closed by auto
    from ws_def A(1) have "length ws = length bvs" by simp
    moreover from Cons assms(2) bvs(2) ws_def have "set ws  Span bvs"
      using set_take_subset by fastforce
    ultimately have "basis_for (Span vs) ws"
      using A(2) ws_def assms(1) bvs xxs_V lin_independent_ConsD1
            lin_independent_imp_independent_take replace_basis_completely[of bvs ws]
      by    force
    with Cons assms(2) ws_def A(2) xxs_V show False
      using Span_contains_Span_take[of xs]
            lin_independent_imp_hd_independent_from_Span[of x xs]
      by    auto
  qed
  ultimately show ?thesis using Cons assms(3) by fastforce
qed simp

lemma finrank_Span : "set vs  V  finrank (Span vs)"
  using max_lin_independent_set_in_Span finrankI by blast

end (* context VectorSpace *)


subsection ‹Finite dimensional spaces›

context VectorSpace
begin

lemma dim_eq_size_basis : "basis_for V vs  length vs = dim V"
  using max_lin_independent_set_in_Span
        Least_equality[
          of "λn::nat. us. length us = n  set us  V  RSpan us = V" "length vs"
        ]
  unfolding dim_R_def by fastforce

lemma finrank_imp_findim :
  assumes "finrank V"
  shows   "findim V"
proof-
  from assms obtain n
    where "vs. set vs  V  lin_independent vs  length vs  n"
    using finrankD
    by    fastforce
  moreover from build_lin_independent_seq[of "[]"] obtain ws
    where "set ws  V" "lin_independent ws" "Span ws = V  length ws = Suc n"
    by    auto
  ultimately show ?thesis by auto
qed

lemma subspace_Span_is_findim :
  " set vs  V; Subspace W; W  Span vs   findim W"
  using finrank_Span subspace_finrank[of "Span vs" W] SubspaceD1[of W]
        VectorSpace.finrank_imp_findim
  by    auto

end (* context VectorSpace *)

context FinDimVectorSpace
begin

lemma Subspace_is_findim : "Subspace U  findim U"
  using findim subspace_Span_is_findim by fast

lemma basis_ex : "vs. basis_for V vs"
  using findim basis_for_Span_ex by auto

lemma lin_independent_length_le_dim :
  "set us  V  lin_independent us  length us  dim V"
  using basis_ex max_lin_independent_set_in_Span dim_eq_size_basis
  by    force

lemma too_long_lin_dependent :
  "set us  V  length us > dim V  ¬ lin_independent us"
  using lin_independent_length_le_dim by fastforce

lemma extend_lin_independent_to_basis :
  assumes "set us  V" "lin_independent us"
  shows   "vs. basis_for V (vs @ us)"
proof-
  define n where "n = Suc (dim V - length us)"
  from assms obtain vs
    where vs: "set vs  V" "lin_independent (vs @ us)"
              "Span (vs @ us) = V  length vs = n"
    using build_lin_independent_seq[of us n]
    by    fast
  with assms n_def show ?thesis
    using set_append lin_independent_length_le_dim[of "vs @ us"] by auto
qed

lemma extend_Subspace_basis :
  "U  V  basis_for U us  vs. basis_for V (vs@us)"
  using Span_contains_spanset extend_lin_independent_to_basis by fast

lemma Subspace_dim_le :
  assumes "Subspace U"
  shows   "dim U  dim V"
  using   assms findim 
proof-
  from assms obtain us where "basis_for U us"
    using Subspace_is_findim SubspaceD1
          VectorSpace.FinDimVectorSpaceI[of "(⋅)" U]
          FinDimVectorSpace.basis_ex[of "(⋅)" U]
    by    auto
  with assms show ?thesis
    using RSpan_contains_spanset[of us] lin_independent_length_le_dim[of us]
          SubspaceD1 VectorSpace.dim_eq_size_basis[of "(⋅)" U us]
    by    auto
qed

lemma Subspace_eqdim_imp_equal :
  assumes "Subspace U" "dim U = dim V"
  shows   "U = V"
proof-
  from assms(1) obtain us where us: "basis_for U us"
    using Subspace_is_findim SubspaceD1
          VectorSpace.FinDimVectorSpaceI[of "(⋅)" U]
          FinDimVectorSpace.basis_ex[of "(⋅)" U]
    by    auto
  with assms(1) obtain vs where vs: "basis_for V (vs@us)"
    using extend_Subspace_basis[of U us] by fast
  from assms us vs show ?thesis
    using SubspaceD1 VectorSpace.dim_eq_size_basis[of smult U]
          dim_eq_size_basis[of "vs@us"]
    by    auto
qed

lemma Subspace_dim_lt : "Subspace U  U  V  dim U < dim V"
  using Subspace_dim_le Subspace_eqdim_imp_equal by fastforce

lemma semisimple :
  assumes "Subspace U"
  shows   "W. Subspace W  (V = W  U)"
proof-
  from assms obtain us where us: "basis_for U us"
    using SubspaceD1 Subspace_is_findim VectorSpace.FinDimVectorSpaceI
          FinDimVectorSpace.basis_ex[of _ U]
    by    fastforce
  with assms obtain ws where basis: "basis_for V (ws@us)"
    using extend_Subspace_basis by fastforce
  hence ws_V: "set ws  V" and ind_ws_us: "lin_independent (ws@us)"
    and V_eq: "V = Span (ws@us)"
    by  auto
  have "V = Span ws  Span us"
  proof (rule inner_dirsum_doubleI)
    from V_eq show "V = Span ws + Span us" using Span_append by fast
    from ws_V ind_ws_us show "add_independentS [Span ws, Span us]"
      using lin_independent_append_imp_independent_Spans by auto
  qed
  with us ws_V have "Subspace (Span ws)  V = (Span ws)  U"
    using Subspace_Span by auto
  thus ?thesis by fast
qed

end (* context FinDimVectorSpace *)


subsection ‹Vector space homomorphisms›

subsubsection ‹Locales›

locale VectorSpaceHom = ModuleHom smult V smult' T
  for smult  :: "'f::field  'v::ab_group_add  'v" (infixr "" 70)
  and V      :: "'v set"
  and smult' :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  and T      :: "'v  'w"

sublocale VectorSpaceHom < VectorSpace ..

lemmas (in VectorSpace)
  VectorSpaceHomI = ModuleHomI[THEN VectorSpaceHom.intro]

lemma (in VectorSpace) VectorSpaceHomI_fromaxioms :
  assumes "g g'. g  V  g'  V  T (g + g') = T g + T g'"
          "supp T  V"
          "r m. r  UNIV  m  V  T (r  m) = smult' r (T m)"
  shows   "VectorSpaceHom smult V smult' T"
  using   assms
  by      unfold_locales

locale VectorSpaceEnd = VectorSpaceHom smult V smult T
  for smult :: "'f::field  'v::ab_group_add  'v" (infixr "" 70)
  and V     :: "'v set"
  and T     :: "'v  'v"
+ assumes endomorph: "ImG  V"

abbreviation (in VectorSpace) "VEnd  VectorSpaceEnd smult V"

lemma VectorSpaceEndI :
  fixes   smult :: "'f::field  'v::ab_group_add  'v"
  assumes "VectorSpaceHom smult V smult T" "T ` V  V"
  shows   "VectorSpaceEnd smult V T"
  by      (rule VectorSpaceEnd.intro, rule assms(1), unfold_locales, rule assms(2))

lemma (in VectorSpaceEnd) VectorSpaceHom: "VectorSpaceHom smult V smult T"
  ..

lemma (in VectorSpaceEnd) ModuleEnd : "ModuleEnd smult V T"
  using endomorph ModuleEnd.intro by unfold_locales

locale VectorSpaceIso = VectorSpaceHom smult V smult' T
  for   smult  :: "'f::field  'v::ab_group_add  'v" (infixr "" 70)
  and   V      :: "'v set"
  and   smult' :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  and   T      :: "'v  'w"
+ fixes W      :: "'w set"
  assumes bijective: "bij_betw T V W"

abbreviation (in VectorSpace) isomorphic ::
  "('f  'w::ab_group_add  'w)  'w set  bool"
  where "isomorphic smult' W  ( T. VectorSpaceIso smult V smult' T W)"

subsubsection ‹Basic facts›

lemma (in VectorSpace) trivial_VectorSpaceHom :
  "(a. smult' a 0 = 0)  VectorSpaceHom smult V smult' 0"
  using trivial_RModuleHom[of smult'] ModuleHom.intro VectorSpaceHom.intro
  by    fast

lemma (in VectorSpace) VectorSpaceHom_idhom :
  "VectorSpaceHom smult V smult (idV)"
  using smult_zero RModHom_idhom ModuleHom.intro VectorSpaceHom.intro
  by    fast

context VectorSpaceHom
begin

lemmas hom             = hom
lemmas supp            = supp
lemmas f_map           = R_map
lemmas im_zero         = im_zero
lemmas im_sum_list_prod = im_sum_list_prod
lemmas additive        = additive
lemmas GroupHom        = GroupHom
lemmas distrib_lincomb = distrib_lincomb

lemmas same_image_on_spanset_imp_same_hom
  = same_image_on_RSpanset_imp_same_hom[
      OF ModuleHom.axioms(1), OF VectorSpaceHom.axioms(1)
    ]

lemma VectorSpace_Im : "VectorSpace smult' ImG"
  using RModule_Im VectorSpace.intro Module.intro by fast

lemma VectorSpaceHom_scalar_mul :
  "VectorSpaceHom smult V smult' (λv. a  T v)"
proof
  show "v v'. v  V  v'  V  a  T (v + v') = a  T v + a  T v'"
    using additive VectorSpace.smult_distrib_left[OF VectorSpace_Im] by simp
  have "v. v  V  v  supp (λv. a  T v)"
  proof-
    fix v assume "v  V"
    hence "a  T v = 0"
      using supp suppI_contra[of _ T] codomain_smult_zero by fastforce
    thus "v  supp (λv. a  T v)" using suppD_contra by fast
  qed
  thus "supp (λv. a  T v)  V" by fast
  show "c v. v  V  a  T (c  v) = c  a  T v"
    using f_map VectorSpace.smult_assoc[OF VectorSpace_Im] by (simp add: field_simps)
qed

lemma VectorSpaceHom_composite_left :
  assumes "ImG  W" "VectorSpaceHom smult' W smult'' S"
  shows   "VectorSpaceHom smult V smult'' (S  T)"
proof-
  have "RModuleHom UNIV smult' W smult'' S"
    using VectorSpaceHom.axioms(1)[OF assms(2)] ModuleHom.axioms(1)
    by    fast
  with assms(1) have "RModuleHom UNIV smult V smult'' (S  T)"
    using RModHom_composite_left[of W] by fast
  thus ?thesis using ModuleHom.intro VectorSpaceHom.intro by fast
qed

lemma findim_domain_findim_image :
  assumes "findim V"
  shows   "fscalar_mult.findim smult' ImG"
proof-
  from assms obtain vs where vs: "set vs  V" "scalar_mult.Span smult vs = V"
    by fast
  define ws where "ws = map T vs"
  with vs(1) have 1: "set ws  ImG" by auto
  moreover have "Span ws = ImG"
  proof
    show "Span ws  ImG"
      using 1 VectorSpace.Span_closed[OF VectorSpace_Im] by fast
    from vs ws_def show "Span ws  ImG"
      using 1 SpanD_lincomb_arb_len_coeffs distrib_lincomb
            VectorSpace.SpanD_lincomb_arb_len_coeffs[OF VectorSpace_Im]
      by auto
  qed
  ultimately show ?thesis by fast
qed

end (* context VectorSpaceHom *)

lemma (in VectorSpace) basis_im_defines_hom :
  fixes   smult'   :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  and     lincomb' :: "'f list  'w list  'w" (infixr "∙⋆" 70)
  defines lincomb'  : "lincomb'  scalar_mult.lincomb smult'"
  assumes VSpW      : "VectorSpace smult' W"
  and     basisV    : "basis_for V vs"
  and     basisV_im : "set ws  W" "length ws = length vs"
  shows   "∃! T. VectorSpaceHom smult V smult' T  map T vs = ws"
proof (rule ex_ex1I)
  define T where "T = restrict0 (λv. (THE as. length as = length vs  v = as ∙⋅ vs) ∙⋆ ws) V"
  have "VectorSpaceHom (⋅) V smult' T"
  proof
    fix v v' assume vv': "v  V" "v'  V"
    with T_def lincomb' basisV basisV_im(1) show "T (v + v') = T v + T v'"
      using basis_for_obtain_unique_scalars theI'[
              of "λds. length ds = length vs  v = ds ∙⋅ vs"
            ]
            theI'[of "λds. length ds = length vs  v' = ds ∙⋅ vs"] add_closed
            add_unique_scalars VectorSpace.lincomb_sum[OF VSpW]
      by    auto
  next
    from T_def show "supp T  V" using supp_restrict0 by fast
  next
    fix a v assume v: "v  V"
    with basisV basisV_im(1) T_def lincomb' show "T (a  v) = a  T v"
      using smult_closed smult_unique_scalars VectorSpace.smult_lincomb[OF VSpW] by auto
  qed
  moreover have "map T vs = ws"
  proof (rule nth_equalityI)
    from basisV_im(2) show "length (map T vs) = length ws" by simp
    have "i. i<length (map T vs)  map T vs ! i = ws ! i"
    proof-
      fix i assume i: "i < length (map T vs)"
      define zs where "zs = (replicate (length vs) (0::'f))[i:=1]"
      with basisV i have "length zs = length vs  vs!i = zs ∙⋅ vs" 
        using delta_scalars_lincomb_eq_nth by auto
      moreover from basisV i have "vs!i  V" by auto
      ultimately show "(map T vs)!i = ws!i"
        using basisV basisV_im T_def lincomb' zs_def i
              basis_for_obtain_unique_scalars[of vs "vs!i"]
              the1_equality[of "λzs. length zs = length vs  vs!i = zs ∙⋅ vs"]
              VectorSpace.delta_scalars_lincomb_eq_nth[OF VSpW, of ws]
        by    force
    qed
    thus "i. i < length (map T vs)  map T vs ! i = ws ! i" by fast
  qed
  ultimately have "VectorSpaceHom (⋅) V smult' T  map T vs = ws" by fast
  thus "T. VectorSpaceHom (⋅) V smult' T  map T vs = ws" by fast
next
  fix S T assume
    "VectorSpaceHom (⋅) V smult' S  map S vs = ws" 
    "VectorSpaceHom (⋅) V smult' T  map T vs = ws"
  with basisV show "S = T"
    using VectorSpaceHom.same_image_on_spanset_imp_same_hom map_eq_conv
    by    fastforce  (* slow *)
qed

subsubsection ‹Hom-sets›

definition VectorSpaceHomSet ::
  "('f::field  'v::ab_group_add  'v)  'v set  ('f  'w::ab_group_add  'w)
         'w set  ('v  'w) set"
  where "VectorSpaceHomSet fsmult V fsmult' W
               {T. VectorSpaceHom fsmult V fsmult' T}  {T. T ` V  W}"

abbreviation (in VectorSpace) "VectorSpaceEndSet  {S. VEnd S}"

lemma VectorSpaceHomSetI :
  "VectorSpaceHom fsmult V fsmult' T  T ` V  W
         T  VectorSpaceHomSet fsmult V fsmult' W"
  unfolding VectorSpaceHomSet_def by fast

lemma VectorSpaceHomSetD_VectorSpaceHom :
  "T  VectorSpaceHomSet fsmult V fsmult' N
         VectorSpaceHom fsmult V fsmult' T"
  unfolding VectorSpaceHomSet_def by fast

lemma VectorSpaceHomSetD_Im :
  "T  VectorSpaceHomSet fsmult V fsmult' W  T ` V  W"
  unfolding VectorSpaceHomSet_def by fast

context VectorSpace
begin

lemma VectorSpaceHomSet_is_fmaps_in_GroupHomSet :
  fixes smult' :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  shows "VectorSpaceHomSet smult V smult' W
              = (GroupHomSet V W)  {T. a. vV. T (a  v) = a  (T v)}"
proof
  show "VectorSpaceHomSet smult V smult' W
               (GroupHomSet V W)  {T. a. vV. T (a  v) = a  (T v)}"
    using VectorSpaceHomSetD_VectorSpaceHom[of _ smult]
          VectorSpaceHomSetD_Im[of _ smult]
          VectorSpaceHom.GroupHom[of smult] GroupHomSetI[of V _ W]
          VectorSpaceHom.f_map[of smult]
    by    fastforce
  show "VectorSpaceHomSet smult V smult' W
               (GroupHomSet V W)  {T. a. vV. T (a  v) = a  (T v)}"
  proof
    fix T assume T: "T  (GroupHomSet V W)
                           {T. a. vV. T (a  v) = a  (T v)}"
    have "VectorSpaceHom smult V smult' T"
    proof (rule VectorSpaceHom.intro, rule ModuleHom.intro, rule RModuleHom.intro)
      show "RModule UNIV (⋅) V" ..
      from T show "GroupHom V T" using GroupHomSetD_GroupHom by fast
      from T show "RModuleHom_axioms UNIV smult V smult' T"
        by unfold_locales fast
    qed
    with T show "T  VectorSpaceHomSet smult V smult' W"
      using GroupHomSetD_Im[of T] VectorSpaceHomSetI by fastforce
  qed
qed

lemma Group_VectorSpaceHomSet :
  fixes   smult' :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  assumes "VectorSpace smult' W"
  shows   "Group (VectorSpaceHomSet smult V smult' W)"
proof
  show "VectorSpaceHomSet smult V smult' W  {}"
    using VectorSpace.smult_zero[OF assms] VectorSpace.zero_closed[OF assms]
          trivial_VectorSpaceHom[of smult'] VectorSpaceHomSetI
    by    fastforce
next
  fix S T
  assume S: "S  VectorSpaceHomSet smult V smult' W"
    and  T: "T  VectorSpaceHomSet smult V smult' W"
  from S T
    have  ST: "S  (GroupHomSet V W)
                     {T. a. vV. T (a  v) = a  (T v)}"
              "T  (GroupHomSet V W)  {T. a. vV. T (a  v) = a  (T v)}"
    using VectorSpaceHomSet_is_fmaps_in_GroupHomSet
    by    auto
  hence "S - T  GroupHomSet V W"
    using VectorSpace.AbGroup[OF assms] Group_GroupHomSet Group.diff_closed
    by    fast
  moreover have "a v. v  V  (S - T) (a  v) = a  ((S-T) v)"
  proof-
    fix a v assume "v  V"
    with ST show "(S - T) (a  v) = a  ((S - T) v)" 
      using GroupHomSetD_Im
            VectorSpace.smult_distrib_left_diff[OF assms, of a "S v" "T v"]
      by    fastforce
  qed
  ultimately show "S - T  VectorSpaceHomSet (⋅) V (⋆) W"
    using VectorSpaceHomSet_is_fmaps_in_GroupHomSet[of smult' W] by fast
qed

lemma VectorSpace_VectorSpaceHomSet :
  fixes   smult'    :: "'f  'w::ab_group_add  'w" (infixr "" 70)
  and     hom_smult :: "'f  ('v  'w)  ('v  'w)" (infixr "⋆⋅" 70)
  defines hom_smult: "hom_smult  λa T v. a  T v"
  assumes VSpW: "VectorSpace smult' W"
  shows   "VectorSpace hom_smult (VectorSpaceHomSet smult V smult' W)"
proof (rule VectorSpace.intro, rule Module.intro, rule RModule.intro, rule R_scalar_mult)

  from VSpW show "Group (VectorSpaceHomSet (⋅) V (⋆) W)"
    using Group_VectorSpaceHomSet by fast

  show "RModule_axioms UNIV hom_smult (VectorSpaceHomSet (⋅) V (⋆) W)"
  proof
    fix a b S T
    assume S: "S  VectorSpaceHomSet (⋅) V (⋆) W"
      and  T: "T  VectorSpaceHomSet (⋅) V (⋆) W"
    show "a ⋆⋅ T  VectorSpaceHomSet (⋅) V (⋆) W"
    proof (rule VectorSpaceHomSetI)
      from assms T show "VectorSpaceHom (⋅) V (⋆) (a ⋆⋅ T)"
        using VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHomSetD_Im
              VectorSpaceHom.VectorSpaceHom_scalar_mul
        by    fast
      from hom_smult show "(a ⋆⋅ T) ` V  W"
        using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_closed[OF VSpW]
        by    auto
    qed

    show "a ⋆⋅ (S + T) = a ⋆⋅ S + a ⋆⋅ T"
    proof
      fix v from assms show "(a ⋆⋅ (S + T)) v = (a ⋆⋅ S + a ⋆⋅ T) v"
        using VectorSpaceHomSetD_Im[OF S] VectorSpaceHomSetD_Im[OF T]
              VectorSpace.smult_distrib_left[OF VSpW, of a "S v" "T v"]
              VectorSpaceHomSetD_VectorSpaceHom[OF S]
              VectorSpaceHomSetD_VectorSpaceHom[OF S]
              VectorSpaceHom.supp suppI_contra[of v S] suppI_contra[of v T]
              VectorSpace.smult_zero
        by    fastforce
    qed

    show "(a + b) ⋆⋅ T = a ⋆⋅ T + b ⋆⋅ T"
    proof
      fix v from assms show "((a + b) ⋆⋅ T) v = (a ⋆⋅ T + b ⋆⋅ T) v"
        using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_distrib_right
              VectorSpaceHomSetD_VectorSpaceHom[OF T] VectorSpaceHom.supp
              suppI_contra[of v] VectorSpace.smult_zero
        by    fastforce
    qed

    show "a ⋆⋅ b ⋆⋅ T = (a * b) ⋆⋅ T"
    proof
      fix v from assms show "(a ⋆⋅ b ⋆⋅ T) v = ((a * b) ⋆⋅ T) v"
        using VectorSpaceHomSetD_Im[OF T] VectorSpace.smult_assoc
              VectorSpaceHomSetD_VectorSpaceHom[OF T]
              VectorSpaceHom.supp suppI_contra[of v]
              VectorSpace.smult_zero[OF VSpW, of b]
              VectorSpace.smult_zero[OF VSpW, of a]
              VectorSpace.smult_zero[OF VSpW, of "a * b"]
        by    fastforce
    qed

    show "1 ⋆⋅ T = T"
    proof
      fix v from assms T show "(1 ⋆⋅ T) v = T v"
        using VectorSpaceHomSetD_Im VectorSpace.one_smult
              VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHom.supp
              suppI_contra[of v] VectorSpace.smult_zero
        by    fastforce
    qed

  qed
qed

end (* context VectorSpace *)

subsubsection ‹Basic facts about endomorphisms›

lemma ModuleEnd_over_field_is_VectorSpaceEnd :
  fixes   smult :: "'f::field  'v::ab_group_add  'v"
  assumes "ModuleEnd smult V T"
  shows   "VectorSpaceEnd smult V T"
proof (rule VectorSpaceEndI, rule VectorSpaceHom.intro)
  from assms show "ModuleHom smult V smult T"
    using ModuleEnd.axioms(1) by fast
  from assms show "T ` V   V" using ModuleEnd.endomorph by fast
qed

context VectorSpace
begin

lemmas VectorSpaceEnd_inner_dirsum_el_decomp_nth =
  RModuleEnd_inner_dirsum_el_decomp_nth[
    THEN RModuleEnd_over_UNIV_is_ModuleEnd,
    THEN ModuleEnd_over_field_is_VectorSpaceEnd
  ]

abbreviation end_smult :: "'f  ('v  'v)  ('v  'v)" (infixr "⋅⋅" 70) 
  where "a ⋅⋅ T  (λv. a  T v)"

abbreviation end_lincomb
  :: "'f list  (('v  'v) list)  ('v  'v)" (infixr "∙⋅⋅" 70)
  where "end_lincomb  scalar_mult.lincomb end_smult"

lemma end_smult0: "a ⋅⋅ 0 = 0"
  using smult_zero by auto

lemma end_0smult: "range T  V  0 ⋅⋅ T = 0"
  using zero_smult by fastforce

lemma end_smult_distrib_left :
  assumes "range S  V" "range T  V"
  shows   "a ⋅⋅ (S + T) = a ⋅⋅ S + a ⋅⋅ T"
proof
  fix v from assms show "(a ⋅⋅ (S + T)) v = (a ⋅⋅ S  + a ⋅⋅ T) v"
    using smult_distrib_left[of a "S v" "T v"] by fastforce
qed

lemma end_smult_distrib_right :
  assumes "range T  V"
  shows   "(a+b) ⋅⋅ T = a ⋅⋅ T + b ⋅⋅ T"
proof
  fix v from assms show "((a+b) ⋅⋅ T) v = (a ⋅⋅ T + b ⋅⋅ T) v"
    using smult_distrib_right[of a b "T v"] by fastforce
qed

lemma end_smult_assoc :
  assumes "range T  V"
  shows   "a ⋅⋅ b ⋅⋅ T = (a * b) ⋅⋅ T"
proof
  fix v from assms show "(a ⋅⋅ b ⋅⋅ T) v = ((a * b) ⋅⋅ T) v"
    using smult_assoc[of a b "T v"] by fastforce
qed

lemma end_smult_comp_comm_left : "(a ⋅⋅ T)  S = a ⋅⋅ (T  S)"
  by auto

lemma end_idhom : "VEnd (idV)"
  by (rule VectorSpaceEnd.intro, rule VectorSpaceHom_idhom, unfold_locales) auto

lemma VectorSpaceEndSet_is_VectorSpaceHomSet :
  "VectorSpaceHomSet smult V smult V = {T. VEnd T}"
proof
  show "VectorSpaceHomSet smult V smult V  {T. VEnd T}"
    using VectorSpaceHomSetD_VectorSpaceHom VectorSpaceHomSetD_Im
          VectorSpaceEndI
    by    fast
  show "VectorSpaceHomSet smult V smult V  {T. VEnd T}"
    using VectorSpaceEnd.VectorSpaceHom[of smult V]
          VectorSpaceEnd.endomorph[of smult V]
          VectorSpaceHomSetI[of smult V smult _ V]
    by fast
qed

lemma VectorSpace_VectorSpaceEndSet : "VectorSpace end_smult VectorSpaceEndSet"
  using VectorSpace_axioms VectorSpace_VectorSpaceHomSet
        VectorSpaceEndSet_is_VectorSpaceHomSet
  by    fastforce

end (* context VectorSpace *)

context VectorSpaceEnd
begin

lemmas f_map                         = R_map
lemmas supp                          = supp
lemmas GroupEnd                      = ModuleEnd.GroupEnd[OF ModuleEnd]
lemmas idhom_left                    = idhom_left
lemmas range                         = GroupEnd.range[OF GroupEnd]
lemmas Ker0_imp_inj_on               = Ker0_imp_inj_on
lemmas inj_on_imp_Ker0               = inj_on_imp_Ker0
lemmas nonzero_Ker_el_imp_n_inj      = nonzero_Ker_el_imp_n_inj
lemmas VectorSpaceHom_composite_left
              = VectorSpaceHom_composite_left[OF endomorph]

lemma in_VEndSet : "T  VectorSpaceEndSet"
  using VectorSpaceEnd_axioms by fast

lemma end_smult_comp_comm_right :
  "range S  V  T  (a ⋅⋅ S) = a ⋅⋅ (T  S)"
  using f_map by fastforce

lemma VEnd_end_smult_VEnd : "VEnd (a ⋅⋅ T)"
  using in_VEndSet VectorSpace.smult_closed[OF VectorSpace_VectorSpaceEndSet]
  by    fast

lemma VEnd_composite_left :
  assumes "VEnd S"
  shows   "VEnd (S  T)"
  using endomorph VectorSpaceEnd.axioms(1)[OF assms] VectorSpaceHom_composite_left
        VectorSpaceEnd.endomorph[OF assms] VectorSpaceEndI[of smult V "S  T"]
  by    fastforce

lemma VEnd_composite_right : "VEnd S  VEnd (T  S)"
  using VectorSpaceEnd_axioms VectorSpaceEnd.VEnd_composite_left by fast

end (* context VectorSpaceEnd *)

lemma (in VectorSpace) inj_comp_end :
  assumes "VEnd S" "inj_on S V" "VEnd T" "inj_on T V"
  shows   "inj_on (S  T) V"
proof-
  have "ker (S  T)  V  0"
  proof
    fix v assume "v  ker (S  T)  V"
    moreover hence "T v = 0" using kerD[of v "S  T"]
      using VectorSpaceEnd.endomorph[OF assms(3)] kerI[of S]
            VectorSpaceEnd.inj_on_imp_Ker0[OF assms(1,2)]
      by    auto
    ultimately show "v  0"
      using kerI[of T] VectorSpaceEnd.inj_on_imp_Ker0[OF assms(3,4)] by auto
  qed
  with assms(1,3) show ?thesis
    using VectorSpaceEnd.VEnd_composite_right VectorSpaceEnd.Ker0_imp_inj_on
    by    fast
qed

lemma (in VectorSpace) n_inj_comp_end : 
  " VEnd S; VEnd T; ¬ inj_on (S  T) V   ¬ inj_on S V  ¬ inj_on T V"
  using inj_comp_end by fast

subsubsection ‹Polynomials of endomorphisms›

context VectorSpaceEnd
begin

primrec endpow :: "nat  ('v'v)"
  where endpow0:   "endpow 0 = idV"
  |     endpowSuc: "endpow (Suc n) = T  (endpow n)"

definition polymap :: "'f poly  ('v'v)"
  where "polymap p  (coeffs p) ∙⋅⋅ (map endpow [0..<Suc (degree p)])"

lemma VEnd_endpow : "VEnd (endpow n)"
proof (induct n)
  case 0 show ?case using end_idhom by simp
next
  case (Suc k)
  moreover have "VEnd T" ..
  ultimately have "VEnd (T  (endpow k))" using VEnd_composite_right by fast
  moreover have "endpow (Suc k) = T  (endpow k)" by simp
  ultimately show "VEnd (endpow (Suc k))" by simp
qed

lemma endpow_list_apply_closed :
  "v  V  set (map (λS. S v) (map endpow [0..<k]))  V"
  using VEnd_endpow VectorSpaceEnd.endomorph by fastforce

lemma map_endpow_Suc :
  "map endpow [0..<Suc n] = (idV) # map ((∘) T) (map endpow [0..<n])"
proof (induct n)
  case (Suc k)
  hence "map endpow [0..<Suc (Suc k)] = id  V
              # map ((∘) T) (map endpow [0..<k]) @ map ((∘) T) [endpow k]"
    by auto
  also have " = id  V # map ((∘) T) (map endpow ([0..<Suc k]))" by simp
  finally show ?case by fast
qed simp

lemma T_endpow_list_apply_commute :
  "map T (map (λS. S v) (map endpow [0..<n]))
        = map (λS. S v) (map ((∘) T) (map endpow [0..<n]))"
  by (induct n) auto

lemma polymap0 : "polymap 0 = 0"
  using polymap_def scalar_mult.lincomb_Nil by force

lemma VEnd_polymap : "VEnd (polymap p)"
proof-
  have "set (map endpow [0..<Suc (degree p)])  {S. VEnd S}"
    using VEnd_endpow by auto
  thus ?thesis
    using polymap_def VectorSpace_VectorSpaceEndSet VectorSpace.lincomb_closed
    by    fastforce
qed

lemma polymap_pCons : "polymap (pCons a p) = a ⋅⋅ (idV) + (T  (polymap p))"
proof cases
  assume p: "p = 0"
  show ?thesis
  proof cases
    assume "a = 0" with p show ?thesis
      using polymap0 VectorSpace_VectorSpaceEndSet VectorSpace.zero_smult end_idhom
            comp_zero
      by    fastforce
  next
    assume a: "a  0"
    define zmap where "zmap = (0::'v'v)"
    from a p have "polymap (pCons a p) = a ⋅⋅ (endpow 0)" 
      using polymap_def scalar_mult.lincomb_singles by simp
    moreover have "a ⋅⋅ (idV) + (T  (polymap p)) = a ⋅⋅ (idV)"
      using p polymap0 comp_zero by simp
    ultimately show ?thesis by simp
  qed
next
  assume "p  0"
  hence "polymap (pCons a p)
              = (a # (coeffs p)) ∙⋅⋅ (map endpow [0..<Suc (Suc (degree p))])"
    using polymap_def by simp
  also have " = (a # (coeffs p))
                   ∙⋅⋅ ((idV) # map ((∘) T) (map endpow [0..<Suc (degree p)]))"
    using map_endpow_Suc[of "Suc (degree p)"] by fastforce
  also have " = a ⋅⋅ (idV) + (coeffs p)
                  ∙⋅⋅ (map ((∘) T) (map endpow [0..<Suc (degree p)]))"
    using scalar_mult.lincomb_Cons by simp
  also have " = a ⋅⋅ (idV) + ((c,S)
                  zip (coeffs p) (map ((∘) T) (map endpow [0..<Suc (degree p)])).
                      c ⋅⋅ S)"
    using scalar_mult.lincomb_def by simp
  finally have calc:
    "polymap (pCons a p) = a ⋅⋅ (idV)
      + ((c,k)zip (coeffs p) [0..<Suc (degree p)]. c ⋅⋅ (T  (endpow k)))"
    using sum_list_prod_map2[
            of "λc S. c ⋅⋅ S" "coeffs p" "(∘) T" "map endpow [0..<Suc (degree p)]"
          ]
          sum_list_prod_map2[
            of "λc S. c ⋅⋅ (T  S)" "coeffs p" endpow "[0..<Suc (degree p)]"
          ]
    by    simp
  show ?thesis
  proof
    fix v show "polymap (pCons a p) v = ((a ⋅⋅ (idV)) + (T  (polymap p))) v"
    proof (cases "v  V")
      case True
      with calc
        have "polymap (pCons a p) v = a  v + ((c,k)
                    zip (coeffs p) [0..<Suc (degree p)]. c  T (endpow k v))"
        using sum_list_prod_fun_apply[of "λc k. c ⋅⋅ (T  (endpow k))"] by simp
      hence "polymap (pCons a p) v = a  v + (coeffs p) ∙⋅ (map T
                  (map (λS. S v) (map endpow [0..<Suc (degree p)])))"
        using sum_list_prod_map2[
                of "λc S. c  T (S v)" "coeffs p" endpow "[0..<Suc (degree p)]"
              ]
              sum_list_prod_map2[
                of "λc u. c  T u" "coeffs p" "λS. S v" "map endpow [0..<Suc (degree p)]"
              ]
              sum_list_prod_map2[
                of "λc u. c  u" "coeffs p" T
                   "map (λS. S v) (map endpow [0..<Suc (degree p)])"
              ]
              lincomb_def
        by    simp
      also from True
        have  " = a  v + T ( (coeffs p)
                    ∙⋅ (map (λS. S v) (map endpow [0..<Suc (degree p)])) )"
        using endpow_list_apply_closed[of v "Suc (degree p)"] distrib_lincomb
        by    simp
      finally show ?thesis
        using True lincomb_def
              sum_list_prod_map2[
                of "λc u. c  u" "coeffs p" "λS. S v" "map endpow [0..<Suc (degree p)]"
              ]
              sum_list_prod_fun_apply[of "λc S. c ⋅⋅ S"] polymap_def 
              scalar_mult.lincomb_def[of end_smult]
        by    simp
    next
      case False
      hence "polymap (pCons a p) v = 0"
        using VEnd_polymap VectorSpaceEnd.supp suppI_contra by fast
      moreover from False have "((a ⋅⋅ (idV)) + (T  (polymap p))) v = 0"
        using smult_zero VEnd_polymap[of p] VectorSpaceEnd.supp suppI_contra
              im_zero
        by    fastforce
      ultimately show ?thesis by simp
    qed
  qed
qed

lemma polymap_plus : "polymap (p + q) = polymap p + polymap q"
proof (induct p q rule: pCons_induct2)
  case 00 show ?case using polymap0 by simp
  case lpCons show ?case using polymap0 by simp
  case rpCons show ?case using polymap0 by simp
next
  case (pCons2 a p b q)
  have "polymap (pCons a p + pCons b q) = a ⋅⋅ (idV) + b ⋅⋅ (idV)
              + (T  (polymap (p+q)))"
    using polymap_pCons end_idhom end_smult_distrib_right[OF VectorSpaceEnd.range]
    by    simp
  also from pCons2(3)
    have " = a ⋅⋅ (idV) + b ⋅⋅ (idV) + (T  (polymap p + polymap q))"
    by   auto
  finally show ?case
    using pCons2(3) distrib_comp_sum_left[of "polymap p" "polymap q"] VEnd_polymap
          VectorSpaceEnd.range polymap_pCons
    by    fastforce
qed

lemma polymap_polysmult : "polymap (Polynomial.smult a p) = a ⋅⋅ polymap p"
proof (induct p)
  case 0 show "polymap (Polynomial.smult a 0) = a ⋅⋅ polymap 0"
    using polymap0 end_smult0 by simp
next
  case (pCons b p)
  hence "polymap (Polynomial.smult a (pCons b p))
              = a ⋅⋅ b ⋅⋅ (idV) + a ⋅⋅ (T  polymap p)"
    using polymap_pCons VectorSpaceEnd.range[OF VEnd_polymap]
          end_smult_comp_comm_right VectorSpaceEnd.range[OF end_idhom] end_smult_assoc
    by    simp
  thus "polymap (Polynomial.smult a (pCons b p)) = a ⋅⋅ (polymap (pCons b p))"
    using VectorSpaceEnd.VEnd_end_smult_VEnd[OF end_idhom, of b]
          VEnd_composite_right[OF VEnd_polymap, of p]
          end_smult_distrib_left[
            OF VectorSpaceEnd.range VectorSpaceEnd.range,
            of smult _ smult "T  polymap p"
          ]
          polymap_pCons
    by    simp
qed

lemma polymap_times : "polymap (p * q) = (polymap p)  (polymap q)"
proof (induct p)
  case 0 show ?case using polymap0 by auto
next
  case (pCons a p)
  have "polymap (pCons a p * q) = a ⋅⋅ polymap q + (T  (polymap (p*q)))"
    using polymap_plus polymap_polysmult polymap_pCons end_idhom
          end_0smult[OF VectorSpaceEnd.range]
    by    simp
  also from pCons(2)
    have " = a ⋅⋅ ((idV)  polymap q) + (T  polymap p  polymap q)"
    using VectorSpaceEnd.endomorph[OF VEnd_polymap]
          VectorSpaceEnd.idhom_left[OF VEnd_polymap]
    by    auto
  finally show "polymap (pCons a p * q) = (polymap (pCons a p))  (polymap q)"
    using end_smult_comp_comm_left
          distrib_comp_sum_right[of "a ⋅⋅ id  V" _ "polymap q"]
          polymap_pCons
    by    simp
qed

lemma polymap_apply :
  assumes "v  V"
  shows   "polymap p v = (coeffs p)
                ∙⋅ (map (λS. S v) (map endpow [0..<Suc (degree p)]))"
proof (induct p)
  case 0 show ?case
    using lincomb_Nil scalar_mult.lincomb_Nil[of _ _ end_smult] polymap_def
    by    simp
next
  case (pCons a p)
  show ?case
  proof (cases "p = 0")
    case True
    moreover with pCons(1) have "polymap (pCons a p) = a ⋅⋅ idV"
      using polymap_pCons polymap0 comp_zero by simp
    ultimately show ?thesis using assms pCons(1) lincomb_singles by simp
  next
    case False
    from assms pCons(2)
      have "polymap (pCons a p) v = a  v
                  + T (coeffs p ∙⋅ map (λS. S v) (map endpow [0..<Suc (degree p)]))"
      using polymap_pCons by simp
    with assms pCons(1)
      have  1: "polymap (pCons a p) v = (coeffs (pCons a p)) ∙⋅ (v #
                      map T (map (λS. S v) (map endpow [0..<Suc (degree p)])))"
      using endpow_list_apply_closed[of v "Suc (degree p)"] distrib_lincomb lincomb_Cons
      by    auto
    have 2: "map T (map (λS. S v) (map endpow [0..<Suc (degree p)]))
                  = map (λS. S v) (map ((∘) T) (map endpow [0..<Suc (degree p)]))"
      using T_endpow_list_apply_commute[of v "Suc (degree p)"] by simp
    from 1 2
      have  "polymap (pCons a p) v = (coeffs (pCons a p)) ∙⋅ (v #
                  map (λS. S v) (map ((∘) T) (map endpow [0..<Suc (degree p)])))"
      using subst[
              OF 2, of "λx. polymap (pCons a p) v = (coeffs (pCons a p)) ∙⋅ (v # x)"
            ]
      by    simp
    with assms
      have 3: "polymap (pCons a p) v = (coeffs (pCons a p))
                    ∙⋅ (map (λS. S v) (idV # map ((∘) T)
                      (map endpow [0..<Suc (degree p)])))"
      by   simp
    from False pCons(1)
      have  4: "id  V # map ((∘) T) (map endpow [0..<Suc (degree p)])
                      = map endpow [0..<Suc (degree (pCons a p))]"
      using map_endpow_Suc[of "Suc (degree p)", THEN sym]
      by    simp
    from 3 show ?thesis
      using subst[
              OF 4,
              of "λx. polymap (pCons a p) v
                        = (coeffs (pCons a p)) ∙⋅ (map (λS. S v) x)"
            ]
      by    simp
  qed
qed

lemma polymap_apply_linear : "v  V  polymap [:-c, 1:] v = T v - c  v"
  using polymap_apply lincomb_def neg_smult endomorph by auto

lemma polymap_const_inj :
  assumes "degree p = 0" "p  0"
  shows   "inj_on (polymap p) V"
proof (rule inj_onI)
  fix u v assume uv: "u  V" "v  V" "polymap p u = polymap p v"
  from assms have p: "coeffs p = [coeff p 0]" unfolding coeffs_def by simp
  from uv assms have "(coeff p 0)  u = (coeff p 0)  v"
    using polymap_apply lincomb_singles unfolding coeffs_def by simp
  with assms uv(1,2) show "u = v"
    using const_poly_nonzero_coeff cancel_scalar by auto
qed

lemma n_inj_polymap_times :
  "¬ inj_on (polymap (p * q)) V
         ¬ inj_on (polymap p) V  ¬ inj_on (polymap q) V"
  using polymap_times VEnd_polymap n_inj_comp_end by fastforce

text ‹In the following lemma, @{term "[:-c, 1:]"} is the linear polynomial @{term "x - c"}.›

lemma n_inj_polymap_findlinear :
  assumes alg_closed: "p::'f poly. degree p > 0  c. poly p c = 0"
  shows   "p  0  ¬ inj_on (polymap p) V
                 c. ¬ inj_on (polymap [:-c, 1:]) V"
proof (induct n  "degree p" arbitrary: p)
  case (0 p) thus ?case using polymap_const_inj by simp
next
  case (Suc n p)
  from Suc(2) alg_closed obtain c where c: "poly p c = 0" by fastforce
  define q where "q = synthetic_div p c"
  with c have p_decomp: "p = [:-c, 1:] * q"
    using synthetic_div_correct'[of c p] by simp
  show ?case
  proof (cases "inj_on (polymap q) V")
    case True with Suc(4) show ?thesis
      using p_decomp n_inj_polymap_times by fast
  next
    case False
    then have "n = degree q"
      using degree_synthetic_div [of p c] q_def Suc n = degree p
      by auto
    moreover have "q  0"
      using p  0 p_decomp
      by auto
    ultimately show ?thesis
      using False
      by (rule Suc.hyps)
  qed
qed

end (* context VectorSpaceEnd *)

subsubsection ‹Existence of eigenvectors of endomorphisms of finite-dimensional vector spaces›

lemma (in FinDimVectorSpace) endomorph_has_eigenvector :
  assumes alg_closed: "p::'a poly. degree p > 0  c. poly p c = 0"
  and     dim       : "dim V > 0"
  and     endo      : "VectorSpaceEnd smult V T"
  shows   "c u. u  V  u  0  T u = c  u"
proof-
  define Tpolymap where "Tpolymap = VectorSpaceEnd.polymap smult V T"
  from dim obtain v where v: "v  V" "v  0"
    using dim_nonzero nonempty by auto
  define Tpows where "Tpows = map (VectorSpaceEnd.endpow V T) [0..<Suc (dim V)]"
  define Tpows_v where "Tpows_v = map (λS. S v) Tpows"
  with endo Tpows_def v(1) have Tpows_v_V: "set Tpows_v  V"
    using VectorSpaceEnd.endpow_list_apply_closed by fast
  moreover from Tpows_v_def Tpows_def Tpows_v_V have "¬ lin_independent Tpows_v"
    using too_long_lin_dependent by simp
  ultimately obtain as
    where as: "set as  0" "length as = length Tpows_v" "as ∙⋅ Tpows_v = 0"
    using lin_dependent_dependence_relation
    by    fast
  define p where "p = Poly as"
  with dim Tpows_def Tpows_v_def as(1,2) have p_n0: "p  0"
    using nonzero_coeffs_nonzero_poly[of as] by fastforce
  define Tpows' where "Tpows' = map (VectorSpaceEnd.endpow V T) [0..<Suc (degree p)]"
  define Tpows_v' where "Tpows_v' = map (λS. S v) Tpows'"
  have "Tpows' = take (Suc (degree p)) Tpows"
  proof-
    from Tpows_def
      have  1: "take (Suc (degree p)) Tpows = map (VectorSpaceEnd.endpow V T)
                      (take (Suc (degree p)) [0..<Suc (dim V)])"
      using take_map[of _ _ "[0..<Suc (dim V)]"]
      by    simp
    from p_n0 p_def as(2) Tpows_v_def Tpows_def
      have  2: "take (Suc (degree p)) [0..<Suc (dim V)] = [0..<Suc (degree p)]"
      using length_coeffs_degree[of p] length_strip_while_le[of "(=) 0" as]
            take_upt[of 0 "Suc (degree p)" "Suc (dim V)"]
      by    simp
    from 1 Tpows'_def have "take (Suc (degree p)) Tpows = Tpows'"
      using subst[OF 2] by fast
    thus ?thesis by simp
  qed
  with Tpows_v_def Tpows_v'_def have "Tpows_v' = take (Suc (degree p)) Tpows_v"
    using take_map[of _ "λS. S v" Tpows] by simp
  moreover from p_def Tpows_v_V as(3) Tpows_v'_def have "(coeffs p) ∙⋅ Tpows_v = 0"
    using lincomb_strip_while_0coeffs by simp
  ultimately have "(coeffs p) ∙⋅ Tpows_v' = 0"
    using p_n0 lincomb_conv_take_right[of "coeffs p"] length_coeffs_degree[of p] by simp
  with Tpolymap_def v(1) Tpows_v'_def Tpows'_def have "Tpolymap p v = 0"
    using VectorSpaceEnd.polymap_apply[OF endo] by simp
  with alg_closed Tpolymap_def v endo p_n0 obtain c
    where "¬ inj_on (Tpolymap [:-c, 1:]) V"
    using VectorSpaceEnd.VEnd_polymap VectorSpaceEnd.nonzero_Ker_el_imp_n_inj
          VectorSpaceEnd.n_inj_polymap_findlinear[OF endo]
    by    fastforce
  with Tpolymap_def have "(GroupHom.Ker V (Tpolymap [:-c, 1:])) - 0  {}"
    using VectorSpaceEnd.VEnd_polymap[OF endo] VectorSpaceEnd.Ker0_imp_inj_on
    by    fast
  from this obtain u where "u  V" "Tpolymap [:-c, 1:] u = 0" "u  0"
    using kerD by fastforce
  with Tpolymap_def show ?thesis
    using VectorSpaceEnd.polymap_apply_linear[OF endo] by auto
qed




section ‹Modules Over a Group Ring›

subsection ‹Almost-everywhere-zero functions as scalars›

locale aezfun_scalar_mult = scalar_mult smult
  for smult ::
    "('r::ring_1, 'g::group_add) aezfun  'v::ab_group_add  'v" (infixr "" 70)
begin

definition fsmult :: "'r  'v  'v" (infixr "♯⋅" 70) where "a ♯⋅ v  (a δδ 0)  v"
abbreviation flincomb :: "'r list  'v list  'v" (infixr "∙♯⋅" 70)
  where "as ∙♯⋅ vs  scalar_mult.lincomb fsmult as vs"
abbreviation f_lin_independent :: "'v list  bool"
  where "f_lin_independent  scalar_mult.lin_independent fsmult"
abbreviation fSpan :: "'v list  'v set" where "fSpan  scalar_mult.Span fsmult"
definition Gmult :: "'g  'v  'v" (infixr "*⋅" 70) where "g *⋅ v  (1 δδ g)  v"

lemmas R_scalar_mult = R_scalar_mult

lemma fsmultD : "a ♯⋅ v = (a δδ 0)  v"
  unfolding fsmult_def by fast

lemma GmultD : "g *⋅ v = (1 δδ g)  v"
  unfolding Gmult_def by fast

definition negGorbit_list :: "'g list  ('a  'v)  'a list  'v list list"
  where "negGorbit_list gs T as  map (λg. map (Gmult (-g)  T) as) gs"

lemma negGorbit_Cons :
  "negGorbit_list (g#gs) T as
        = (map (Gmult (-g)  T) as) # negGorbit_list gs T as"
  using negGorbit_list_def[of _ T as] by simp

lemma length_negGorbit_list : "length (negGorbit_list gs T as) = length gs"
  using negGorbit_list_def[of gs T] by simp

lemma length_negGorbit_list_sublist :
  "fs  set (negGorbit_list gs T as)  length fs = length as"
  using negGorbit_list_def[of gs T] by auto

lemma length_concat_negGorbit_list : 
  "length (concat (negGorbit_list gs T as)) = (length gs) * (length as)"
  using length_concat[of "negGorbit_list gs T as"]
        length_negGorbit_list_sublist[of _ gs T as]
        const_sum_list[of "negGorbit_list gs T as" length "length as"] length_negGorbit_list
  by    auto

lemma negGorbit_list_nth : 
  "i. i < length gs  (negGorbit_list gs T as)!i = map (Gmult (-gs!i)  T) as"
proof (induct gs)
  case (Cons g gs) thus ?case using negGorbit_Cons[of _ _ T] by (cases i) auto
qed simp

end (* context aezfun_scalar_mult *)

subsection ‹Locale and basic facts›

locale FGModule = ActingGroup?: Group G
+ FGMod?: RModule ActingGroup.group_ring smult V
  for G     :: "'g::group_add set"
  and smult :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixr "" 70)
  and V     :: "'v set"

sublocale FGModule < aezfun_scalar_mult proof- qed

lemma (in Group) trivial_FGModule :
  fixes   smult :: "('f::field, 'g) aezfun  'v::ab_group_add  'v"
  assumes smult_zero: "agroup_ring. smult a (0::'v) = 0"
  shows   "FGModule G smult (0::'v set)"
proof (rule FGModule.intro)
  from assms show "RModule group_ring  smult 0"
    using Ring1_RG trivial_RModule by fast
qed (unfold_locales)

context FGModule
begin

abbreviation FG :: "('f,'g) aezfun set" where "FG  ActingGroup.group_ring"
abbreviation "FGSubmodule  RSubmodule"
abbreviation "FG_proj      ActingGroup.RG_proj"

lemma GroupG: "Group G" ..

lemmas zero_closed            = zero_closed
lemmas neg_closed             = neg_closed
lemmas diff_closed            = diff_closed
lemmas zero_smult             = zero_smult
lemmas smult_zero             = smult_zero
lemmas AbGroup                = AbGroup
lemmas sum_closed          = AbGroup.sum_closed[OF AbGroup]
lemmas FGSubmoduleI           = RSubmoduleI
lemmas FG_proj_mult_leftdelta = ActingGroup.RG_proj_mult_leftdelta
lemmas FG_proj_mult_right     = ActingGroup.RG_proj_mult_right
lemmas FG_el_decomp           = ActingGroup.RG_el_decomp_aezdeltafun

lemma FG_n0: "FG  0" using ActingGroup.RG_n0 by fast

lemma FG_proj_in_FG : "FG_proj x  FG"
  using ActingGroup.RG_proj_in_RG by fast

lemma FG_fddg_closed : "g  G  a δδ g  FG"
  using ActingGroup.RG_aezdeltafun_closed by fast

lemma FG_fdd0_closed : "a δδ 0  FG"
  using ActingGroup.RG_aezdelta0fun_closed by fast

lemma Gmult_closed : "g  G  v  V  g *⋅ v  V"
  using FG_fddg_closed smult_closed GmultD by simp

lemma map_Gmult_closed :
  "g  G  set vs  V  set (map ((*⋅) g) vs)  V"
  using Gmult_def FG_fddg_closed map_smult_closed[of "1 δδ g" vs] by auto

lemma Gmult0 :
  assumes "v  V"
  shows   "0 *⋅ v = v"
proof-
  have "0 *⋅ v = (1 δδ 0)  v" using GmultD by fast
  moreover have "1 δδ 0 = (1::('f,'g) aezfun)" using one_aezfun_transfer by fast
  ultimately have "0 *⋅ v = (1::('f,'g) aezfun)  v" by simp
  with assms show ?thesis using one_smult by simp
qed

lemma Gmult_assoc :
  assumes "g  G" "h  G" "v  V"
  shows   "g *⋅ h *⋅ v = (g + h) *⋅ v"
proof-
  define n where "n = (1::'f)"
  with assms have "g *⋅ h *⋅ v = ((n δδ g) * (n δδ h))  v"
    using FG_fddg_closed GmultD by simp
  moreover from n_def have "n δδ g * (n δδ h) = n δδ (g + h)"
    using times_aezdeltafun_aezdeltafun[of n g n h] by simp
  ultimately show ?thesis using n_def GmultD by simp
qed

lemma Gmult_distrib_left :
  " g  G; v  V; v'  V   g *⋅ (v + v') = g *⋅ v + g *⋅ v'"
  using GmultD FG_fddg_closed by simp

lemma neg_Gmult : "g  G  v  V  g *⋅ (- v) = - (g *⋅ v)"
  using GmultD FG_fddg_closed smult_neg by simp

lemma Gmult_neg_left : "g  G  v  V  (- g) *⋅ g *⋅ v = v"
  using ActingGroup.neg_closed Gmult_assoc[of "- g" g] Gmult0 by simp

lemma fddg_smult_decomp : "g  G  v  V  (f δδ g)  v = f ♯⋅ g *⋅ v"
  using aezdeltafun_decomp[of f g] FG_fddg_closed FG_fdd0_closed GmultD
        fsmult_def
  by    simp

lemma sum_list_aezdeltafun_smult_distrib :
  assumes "v  V" "set (map snd fgs)  G"
  shows   "((f,g)fgs. f δδ g)  v = ((f,g)fgs. f ♯⋅ g *⋅ v)"
proof-
  from assms(2) have "set (map (case_prod aezdeltafun) fgs)  FG"
    using FG_fddg_closed by auto
  with assms(1) have "((f,g)fgs. f δδ g)  v =  ((f,g)fgs. (f δδ g)  v)"
    using sum_list_prod_map_smult_distrib by auto
  also have " = ((f,g)fgs. f ♯⋅ g *⋅ v)"
    using assms fddg_smult_decomp
          sum_list_prod_cong[of fgs "λ f g. (f δδ g)  v" "λ f g. f ♯⋅ g *⋅ v"]
    by    fastforce
  finally show ?thesis by fast
qed

abbreviation "GSubspace  RSubmodule"
abbreviation "GSpan      RSpan"
abbreviation "G_fingen   R_fingen"

lemma GSubspaceI : "FGModule G smult U  U  V  GSubspace U"
  using FGModule.axioms(2) by fast

lemma GSubspace_is_FGModule :
  assumes "GSubspace U"
  shows   "FGModule G smult U"
proof (rule FGModule.intro, rule GroupG)
  from assms show "RModule FG (⋅) U" by fast
qed (unfold_locales)

lemma restriction_to_subgroup_is_module :
  fixes   H  :: "'g set"
  assumes subgrp: "Group.Subgroup G H"
  shows   "FGModule H smult V"
proof (rule FGModule.intro)
  from subgrp show "Group H" by fast
  from assms show "RModule (Group.group_ring H) (⋅) V"
    using ActingGroup.Subgroup_imp_Subring SModule_restrict_scalars by fast
qed

lemma negGorbit_list_V :
  assumes "set gs  G" "T ` (set as)  V"
  shows   "set (concat (negGorbit_list gs T as))  V"
proof-
  from assms(2)
    have  "set (concat (negGorbit_list gs T as))  (gset gs. (Gmult (-g)) ` V)"
    using set_concat negGorbit_list_def[of gs T as]
    by    force
  moreover from assms(1) have "g. g  set gs  (Gmult (-g)) ` V  V"
    using ActingGroup.neg_closed Gmult_closed by fast
  ultimately show ?thesis by fast    
qed

lemma negGorbit_list_Cons0 :
  "T ` (set as)  V
         negGorbit_list (0#gs) T as = (map T as) # (negGorbit_list gs T as)"
  using negGorbit_Cons[of 0 gs T as] Gmult0 by auto

end (* context FGModule *)

subsection ‹Modules over a group ring as a vector spaces›

context FGModule
begin

lemma fVectorSpace : "VectorSpace fsmult V"
proof (rule VectorSpaceI, unfold_locales)
  fix a::'f show "v. v  V  a ♯⋅ v  V"
    using fsmult_def smult_closed FG_fdd0_closed by simp
next
  fix a::'f show "u v. u  V  v  V  a ♯⋅ (u + v) = a ♯⋅ u + a ♯⋅ v"
    using fsmult_def FG_fdd0_closed by simp
next
  fix a b :: 'f and v :: 'v assume v: "v  V"
  have "(a+b) ♯⋅ v = (a δδ 0 + b δδ 0)  v"
    using aezdeltafun_plus[of a b 0] arg_cong[of _ _ "λr. r  v"] fsmult_def by fastforce
  with v show "(a+b) ♯⋅ v = a ♯⋅ v + b ♯⋅ v"
    using fsmult_def FG_fdd0_closed by simp
next
  fix a b :: 'f show "v. v  V  a ♯⋅ (b ♯⋅ v) = (a * b) ♯⋅ v"
    using times_aezdeltafun_aezdeltafun[of a 0 b 0] arg_cong fsmult_def FG_fdd0_closed
    by    simp
next
  fix v :: 'v assume "v  V" thus "1 ♯⋅ v = v"
    using one_aezfun_transfer arg_cong[of "1 δδ 0" 1 "λa. a  v"] fsmult_def by fastforce
qed

abbreviation "fSubspace   VectorSpace.Subspace fsmult V"
abbreviation "fbasis_for  fscalar_mult.basis_for fsmult"
abbreviation "fdim        scalar_mult.dim fsmult V"

lemma VectorSpace_fSubspace : "fSubspace W  VectorSpace fsmult W"
  using Module.intro VectorSpace.intro by fast

lemma fsmult_closed : "v  V  a ♯⋅ v  V"
  using FG_fdd0_closed smult_closed fsmult_def by simp

lemmas one_fsmult          [simp] = VectorSpace.one_smult   [OF fVectorSpace]
lemmas fsmult_assoc        [simp] = VectorSpace.smult_assoc [OF fVectorSpace]
lemmas fsmult_zero         [simp] = VectorSpace.smult_zero  [OF fVectorSpace]
lemmas fsmult_distrib_left [simp] = VectorSpace.smult_distrib_left
                                          [OF fVectorSpace]
lemmas flincomb_closed       = VectorSpace.lincomb_closed       [OF fVectorSpace]
lemmas fsmult_sum_distrib = VectorSpace.smult_sum_distrib [OF fVectorSpace]
lemmas sum_fsmult_distrib = VectorSpace.sum_smult_distrib [OF fVectorSpace]
lemmas flincomb_concat       = VectorSpace.lincomb_concat       [OF fVectorSpace]
lemmas fSpan_closed          = VectorSpace.Span_closed          [OF fVectorSpace]
lemmas flin_independentD_all_scalars
              = VectorSpace.lin_independentD_all_scalars[OF fVectorSpace]
lemmas in_fSpan_obtain_same_length_coeffs
              = VectorSpace.in_Span_obtain_same_length_coeffs [OF fVectorSpace]

lemma fsmult_smult_comm : "r  FG  v  V  a ♯⋅ r  v = r  a ♯⋅ v"
  using fsmultD FG_fdd0_closed smult_assoc aezdelta0fun_commutes[of r] by simp

lemma fsmult_Gmult_comm : "g  G  v  V  a ♯⋅ g *⋅ v = g *⋅ a ♯⋅ v"
  using aezdeltafun_decomp[of a g] aezdeltafun_decomp'[of a g] FG_fddg_closed
        FG_fdd0_closed fsmult_def GmultD
  by    simp

lemma Gmult_flincomb_comm :
  assumes "g  G" "set vs  V"
  shows   "g *⋅ as ∙♯⋅ vs = as ∙♯⋅ (map (Gmult g) vs)"
proof-
  have "g *⋅ as ∙♯⋅ vs = (1 δδ g)  ((a,v)zip as vs. a ♯⋅ v)"
    using Gmult_def scalar_mult.lincomb_def[of fsmult] by simp
  with assms have "g *⋅ as ∙♯⋅ vs
                        = sum_list (map ((⋅) (1 δδ g)  (λ(x, y). x ♯⋅ y)) (zip as vs))"
    using set_zip_rightD fsmult_closed FG_fddg_closed[of g "1::'f"]
          smult_sum_list_distrib[of "1 δδ g" "map (case_prod (♯⋅)) (zip as vs)"]
          map_map[of "(⋅) (1 δδ g)" "case_prod (♯⋅)" "zip as vs"]
    by    fastforce
  moreover have "(⋅) (1 δδ g)  (λ(x, y). x ♯⋅ y) = (λ(x,y). (1 δδ g)  (x ♯⋅ y))"
    by auto
  ultimately have "g *⋅ as ∙♯⋅ vs = sum_list (map (λ(x,y). g *⋅ x ♯⋅ y) (zip as vs))"
    using Gmult_def by simp
  moreover from assms have "(x,y)  set (zip as vs). g *⋅ x ♯⋅ y = x ♯⋅ g *⋅ y"
    using set_zip_rightD fsmult_Gmult_comm by fastforce
  ultimately have "g *⋅ as ∙♯⋅ vs
                        = sum_list (map (λ(x,y). x ♯⋅ y) (zip as (map (Gmult g) vs)))"
    using sum_list_prod_cong sum_list_prod_map2[of "λx y. x ♯⋅ y" as "Gmult g"]
    by    force
  thus ?thesis using scalar_mult.lincomb_def[of fsmult] by simp
qed

lemma GSubspace_is_Subspace :
  "GSubspace U  VectorSpace.Subspace fsmult V U"
  using GSubspace_is_FGModule FGModule.fVectorSpace VectorSpace.axioms
        Module.axioms
  by    fast


end (* context FGModule *)

subsection ‹Homomorphisms of modules over a group ring›

subsubsection ‹Locales›

locale FGModuleHom = ActingGroup?: Group G
+ RModHom?: RModuleHom ActingGroup.group_ring smult V smult' T
  for G      :: "'g::group_add set"
  and smult  :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixr "" 70)
  and V      :: "'v set"
  and smult' :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and T      :: "'v  'w"

sublocale FGModuleHom < FGModule ..

lemma (in FGModule) FGModuleHomI_fromaxioms :
  assumes "v v'. v  V  v'  V  T (v + v') = T v + T v'"
          "supp T  V" "r m. r  FG  m  V  T (r  m) = smult' r (T m)"
  shows   "FGModuleHom G smult V smult' T"
  using   assms
  by      unfold_locales

locale FGModuleEnd = FGModuleHom G smult V smult T
  for G     :: "'g::group_add set"
  and FG    :: "('f::field,'g) aezfun set"
  and smult :: "('f, 'g) aezfun  'v::ab_group_add  'v" (infixr "" 70)
  and V     :: "'v set"
  and T     :: "'v  'v"
+ assumes endomorph: "ImG  V"

locale FGModuleIso = FGModuleHom G smult V smult' T
  for   G      :: "'g::group_add set"
  and   smult  :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixr "" 70)
  and   V      :: "'v set"
  and   smult' :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and   T      :: "'v  'w"
+ fixes W      :: "'w set"
  assumes bijective: "bij_betw T V W"

abbreviation (in FGModule) isomorphic ::
  "(('f,'g) aezfun  'w::ab_group_add  'w)  'w set  bool"
  where "isomorphic smult' W  ( T. FGModuleIso G smult V smult' T W)"

subsubsection ‹Basic facts›

context FGModule
begin

lemma trivial_FGModuleHom :
  assumes "r. r  FG  smult' r 0 = 0"
  shows   "FGModuleHom G smult V smult' 0"
proof (rule FGModuleHom.intro)
  from assms show "RModuleHom FG (⋅) V smult' 0"
    using trivial_RModuleHom by auto
qed (unfold_locales)

lemma FGModHom_idhom : "FGModuleHom G smult V smult (idV)"
proof (rule FGModuleHom.intro)
  show "RModuleHom FG smult V smult (idV)" using RModHom_idhom by fast
qed (unfold_locales)

lemma VecHom_GMap_is_FGModuleHom :
  fixes   smult'  :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult' :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     Gmult'  :: "'g  'w  'w" (infixr "*⋆" 70)
  defines fsmult': "fsmult'  aezfun_scalar_mult.fsmult smult'"
  and     Gmult' : "Gmult'  aezfun_scalar_mult.Gmult smult'"
  assumes hom  : "VectorSpaceHom fsmult V fsmult' T"
  and     Im_W : "FGModule G smult' W" "T ` V  W"
  and     G_map : "g v. g  G  v  V  T (g *⋅ v) = g *⋆ (T v)"
  shows   "FGModuleHom G smult V smult' T"
proof

  show "v v'. v  V  v'  V  T (v + v') = T v + T v'" 
    using VectorSpaceHom.GroupHom[OF hom] GroupHom.hom by auto

  from hom show "supp T  V" using VectorSpaceHom.supp by fast

  show "r v. r  FG  v  V  T (r  v) = r  T v"
  proof-
    fix r v assume r: "r  FG" and v: "v  V"
    from r obtain fgs
      where fgs: "set (map snd fgs)  G" "r = ((f,g)fgs. f δδ g)"
      using FG_el_decomp
      by    fast
    from fgs v have "r  v = ((f,g)fgs. f ♯⋅ g *⋅ v)"
      using sum_list_aezdeltafun_smult_distrib by simp
    moreover from v fgs(1) have "set (map (λ(f,g). f ♯⋅ g *⋅ v) fgs)  V"
      using Gmult_closed fsmult_closed by auto
    ultimately have "T (r  v) = ((f,g)fgs. T (f ♯⋅ g *⋅ v))"
      using hom VectorSpaceHom.im_sum_list_prod by auto
    moreover from hom G_map fgs(1) v
      have  "(f,g)  set fgs. T (f ♯⋅ g *⋅ v) = f ♯⋆ g *⋆ T v"
      using Gmult_closed VectorSpaceHom.f_map[of fsmult V fsmult' T]
      by    auto
    ultimately have "T (r  v) = ((f,g)fgs. f ♯⋆ g *⋆ T v)"
      using sum_list_prod_cong by simp
    with v fgs fsmult' Gmult' Im_W(2) show "T (r  v) = r  (T v)"
      using FGModule.sum_list_aezdeltafun_smult_distrib[OF Im_W(1)] by auto
  qed

qed

lemma VecHom_GMap_on_fbasis_is_FGModuleHom :
  fixes   smult'    :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult'   :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     Gmult'    :: "'g  'w  'w" (infixr "*⋆" 70)
  and     flincomb' :: "'f list  'w list  'w" (infixr "∙♯⋆" 70)
  defines fsmult'    : "fsmult'  aezfun_scalar_mult.fsmult smult'"
  and     Gmult'     : "Gmult'  aezfun_scalar_mult.Gmult smult'"
  and     flincomb'  : "flincomb'  aezfun_scalar_mult.flincomb smult'"
  assumes fbasis     : "fbasis_for V vs"
  and     hom        : "VectorSpaceHom fsmult V fsmult' T"
  and     Im_W       : "FGModule G smult' W" "T ` V  W"
  and     G_map      : "g v. g  G  v  set vs  T (g *⋅ v) = g *⋆ (T v)"
  shows   "FGModuleHom G smult V smult' T"
proof (rule VecHom_GMap_is_FGModuleHom)
  from fsmult' hom
    show "VectorSpaceHom (♯⋅) V (aezfun_scalar_mult.fsmult (⋆)) T"
    by   fast
next
  fix g v assume g: "g  G" and v: "v  V"
  from v fbasis obtain cs where cs: "v = cs ∙♯⋅ vs" 
    using VectorSpace.in_Span_obtain_same_length_coeffs[OF fVectorSpace] by fast
  with g(1) fbasis fsmult' flincomb'
    have  "T (g *⋅ v) = cs ∙♯⋆ (map (T  (Gmult g)) vs)"
    using Gmult_flincomb_comm map_Gmult_closed
          VectorSpaceHom.distrib_lincomb[OF hom]
    by    auto
  moreover have "T  (Gmult g) = (λv. T (g *⋅ v))" by auto
  ultimately have "T (g *⋅ v) = cs ∙♯⋆ (map (λv. g *⋆ (T v)) vs)"
    using fbasis g(1) G_map map_cong[of vs vs "λv. T (g *⋅ v)"]
    by    simp
  moreover have "(λv. g *⋆ (T v)) = (Gmult' g)  T" by auto
  ultimately have "T (g *⋅ v) = g *⋆ cs ∙♯⋆ (map T vs)"
    using g(1) fbasis Im_W(2) Gmult' flincomb' 
          FGModule.Gmult_flincomb_comm[OF Im_W(1), of g "map T vs"]
    by    fastforce
  thus "T (g *⋅ v) = aezfun_scalar_mult.Gmult (⋆) g (T v)"
    using fbasis fsmult' Gmult' flincomb' cs
          VectorSpaceHom.distrib_lincomb[OF hom]
    by auto
qed (rule Im_W(1), rule Im_W(2))

end (* context FGModule *)

context FGModuleHom
begin

abbreviation fsmult' :: "'f  'w  'w" (infixr "♯⋆" 70) 
  where "fsmult'  aezfun_scalar_mult.fsmult smult'"
abbreviation Gmult' :: "'g  'w  'w" (infixr "*⋆" 70)
  where "Gmult'  aezfun_scalar_mult.Gmult smult'"

lemmas supp                     = supp
lemmas additive                 = additive
lemmas FG_map                   = R_map
lemmas FG_fdd0_closed           = FG_fdd0_closed
lemmas fsmult_smult_domain_comm = fsmult_smult_comm
lemmas GSubspace_Ker            = RSubmodule_Ker
lemmas Ker_Im_iff               = Ker_Im_iff
lemmas Ker0_imp_inj_on          = Ker0_imp_inj_on
lemmas eq_im_imp_diff_in_Ker    = eq_im_imp_diff_in_Ker
lemmas im_submodule             = im_submodule
lemmas fsmultD'                 = aezfun_scalar_mult.fsmultD[of smult']
lemmas GmultD'                  = aezfun_scalar_mult.GmultD[of smult']

lemma f_map : "v  V  T (a ♯⋅ v) = a ♯⋆ T v"
  using fsmultD ActingGroup.RG_aezdelta0fun_closed[of a] FG_map fsmultD'
  by    simp

lemma G_map : "g  G  v  V  T (g *⋅ v) = g *⋆ T v"
  using GmultD ActingGroup.RG_aezdeltafun_closed[of g 1] FG_map GmultD'
  by    simp

lemma VectorSpaceHom : "VectorSpaceHom fsmult V fsmult' T"
  by  (
        rule VectorSpace.VectorSpaceHomI, rule fVectorSpace, unfold_locales,
        rule f_map
      )

lemmas distrib_flincomb = VectorSpaceHom.distrib_lincomb[OF VectorSpaceHom]

lemma FGModule_Im : "FGModule G smult' ImG"
  by (rule FGModule.intro, rule GroupG, rule RModule_Im, unfold_locales)

lemma FGModHom_composite_left :
  assumes "FGModuleHom G smult' W smult'' S" "T ` V  W"
  shows   "FGModuleHom G smult V smult'' (S  T)"
proof (rule FGModuleHom.intro)
  from assms(2) show "RModuleHom FG smult V smult'' (S  T)"
    using FGModuleHom.axioms(2)[OF assms(1)] RModHom_composite_left[of W]
    by    fast
qed (rule GroupG, unfold_locales)

lemma restriction_to_subgroup_is_hom :
  fixes   H  :: "'g set"
  assumes subgrp: "Group.Subgroup G H"
  shows   "FGModuleHom H smult V smult' T"
proof (rule FGModule.FGModuleHomI_fromaxioms)
  have "FGModule G smult V" ..
  with assms show "FGModule H (⋅) V"
    using FGModule.restriction_to_subgroup_is_module by fast
  from supp show "supp T  V" by fast
  from assms
    show  "r m.  r  (Group.group_ring H); m  V   T (r  m) = r  T m"
    using FG_map ActingGroup.Subgroup_imp_Subring by fast
qed (rule hom)

lemma FGModuleHom_restrict0_GSubspace :
  assumes "GSubspace U"
  shows   "FGModuleHom G smult U smult' (T  U)"
proof (rule FGModuleHom.intro)
  from assms show "RModuleHom FG (⋅) U (⋆) (T  U)"
    using RModuleHom_restrict0_submodule by fast
qed (unfold_locales)

lemma FGModuleHom_fscalar_mul :
  "FGModuleHom G smult V smult' (λv. a ♯⋆ T v)"
proof
  have vsphom: "VectorSpaceHom fsmult V fsmult' (λv. a ♯⋆ T v)"
    using VectorSpaceHom.VectorSpaceHom_scalar_mul[OF VectorSpaceHom]
    by    fast
  thus "v v'. v  V  v'  V  a ♯⋆ T (v + v') = a ♯⋆ T v + a ♯⋆ T v'"
    using VectorSpaceHom.additive[of fsmult V] by auto
  from vsphom show "supp (λv. a ♯⋆ T v)  V"
    using VectorSpaceHom.supp by fast
next
  fix r v assume rv: "r  FG" "v  V"
  thus "a ♯⋆ T (r  v) = r  a ♯⋆ T v"
    using FG_map FGModule.fsmult_smult_comm[OF FGModule_Im] 
    by    auto
qed

end (* context FGModuleHom *)

lemma GSubspace_eigenspace :
  fixes   e     :: "'f::field"
  and     E     :: "'v::ab_group_add set"
  and     smult :: "('f::field, 'g::group_add) aezfun  'v  'v" (infixr "" 70)
  assumes FGModHom: "FGModuleHom G smult V smult T"
  defines E       : "E  {v  V. T v = aezfun_scalar_mult.fsmult smult e v}"
  shows   "FGModule.GSubspace G smult V E"
proof-
  have "FGModule.GSubspace G smult V {v  V. T v = (e δδ 0)  v}"
    using FGModuleHom.axioms(2)[OF FGModHom]
  proof (rule RSubmodule_eigenspace)
    show "e δδ 0  FGModule.FG G"
      using FGModuleHom.FG_fdd0_closed[OF FGModHom] by fast
    show "s v. s  FGModule.FG G  v  V  s  (e δδ 0)  v = (e δδ 0)  s  v"
      using FGModuleHom.fsmult_smult_domain_comm[OF FGModHom]
            aezfun_scalar_mult.fsmultD[of smult]
      by    simp
  qed
  with E show ?thesis using aezfun_scalar_mult.fsmultD[of smult] by simp
qed

subsubsection ‹Basic facts about endomorphisms›

lemma RModuleEnd_over_group_ring_is_FGModuleEnd :
  fixes   G     :: "'g::group_add set"
  and     smult :: "('f::field, 'g) aezfun  'v::ab_group_add  'v"
  assumes G : "Group G" and endo: "RModuleEnd (Group.group_ring G) smult V T"
  shows   "FGModuleEnd G smult V T"
proof (rule FGModuleEnd.intro, rule FGModuleHom.intro, rule G)
  from endo show "RModuleHom (Group.group_ring G) smult V smult T"
    using RModuleEnd.axioms(1) by fast
  from endo show "FGModuleEnd_axioms V T"
    using RModuleEnd.endomorph by unfold_locales
qed

lemma (in FGModule) VecEnd_GMap_is_FGModuleEnd :
  assumes endo : "VectorSpaceEnd fsmult V T"
  and     G_map: "g v. g  G  v  V  T (g *⋅ v) = g *⋅ (T v)"
  shows   "FGModuleEnd G smult V T"
proof (rule FGModuleEnd.intro, rule VecHom_GMap_is_FGModuleHom)
  from endo show "VectorSpaceHom (♯⋅) V (♯⋅) T"
    using VectorSpaceEnd.axioms(1) by fast
  from endo show "T ` V  V" using VectorSpaceEnd.endomorph by fast
  from endo show "FGModuleEnd_axioms V T"
    using VectorSpaceEnd.endomorph by unfold_locales
qed (unfold_locales, rule G_map)

lemma (in FGModule) GEnd_inner_dirsum_el_decomp_nth :
  " Uset Us. GSubspace U; add_independentS Us; n < length Us 
         FGModuleEnd G smult  (UUs. U) (Usn)"
  using GroupG RModuleEnd_inner_dirsum_el_decomp_nth
        RModuleEnd_over_group_ring_is_FGModuleEnd
  by    fast

context FGModuleEnd
begin

lemma RModuleEnd : "RModuleEnd ActingGroup.group_ring smult V T"
  using endomorph by unfold_locales

lemma VectorSpaceEnd : "VectorSpaceEnd fsmult V T"
  by  (
        rule VectorSpaceEnd.intro, rule VectorSpaceHom, unfold_locales,
        rule endomorph
      )

lemmas proj_decomp                     = RModuleEnd.proj_decomp[OF RModuleEnd]
lemmas GSubspace_Ker                   = GSubspace_Ker
lemmas FGModuleHom_restrict0_GSubspace = FGModuleHom_restrict0_GSubspace

end (* context FGModuleEnd *)

subsubsection ‹Basic facts about isomorphisms›

context FGModuleIso
begin

lemmas VectorSpaceHom = VectorSpaceHom

abbreviation "invT  (the_inv_into V T)  W"

lemma RModuleIso : "RModuleIso FG smult V smult' T W"
proof (rule RModuleIso.intro)
  show "RModuleHom FG (⋅) V (⋆) T"
    using FGModuleIso_axioms FGModuleIso.axioms(1) FGModuleHom.axioms(2)
    by    fast
qed (unfold_locales, rule bijective)

lemmas ImG = RModuleIso.ImG[OF RModuleIso]

lemma FGModuleIso_restrict0_GSubspace :
  assumes "GSubspace U"
  shows   "FGModuleIso G smult U smult' (T  U) (T ` U)"
proof (rule FGModuleIso.intro)
  from assms show "FGModuleHom G (⋅) U (⋆) (T  U)"
    using FGModuleHom_restrict0_GSubspace by fast
  show "FGModuleIso_axioms U (T  U) (T ` U)"
  proof
    from assms bijective have "bij_betw T U (T ` U)"
      using subset_inj_on unfolding bij_betw_def by auto
    thus "bij_betw (T  U) U (T ` U)" unfolding bij_betw_def inj_on_def by auto
  qed
qed

lemma inv : "FGModuleIso G smult' W smult invT V"
proof (rule FGModuleIso.intro, rule FGModuleHom.intro)
  show "RModuleHom FG (⋆) W (⋅) invT"
    using RModuleIso.inv[OF RModuleIso] RModuleIso.axioms(1) by fast
  show "FGModuleIso_axioms W invT V" 
    using RModuleIso.inv[OF RModuleIso] RModuleIso.bijective by unfold_locales
qed (unfold_locales)

lemma FGModIso_composite_left :
  assumes "FGModuleIso G smult' W smult'' S X"
  shows   "FGModuleIso G smult V smult'' (S  T) X"
proof (rule FGModuleIso.intro)
  from assms show "FGModuleHom G (⋅) V smult'' (S  T)"
    using FGModuleIso.axioms(1) ImG FGModHom_composite_left by fast
  show "FGModuleIso_axioms V (S  T) X"
    using bijective FGModuleIso.bijective[OF assms] bij_betw_trans by unfold_locales
qed

lemma isomorphic_sym : "FGModule.isomorphic G smult' W smult V"
  using inv by fast

lemma isomorphic_trans :
  "FGModule.isomorphic G smult' W smult'' X
         FGModule.isomorphic G smult V smult'' X"
  using FGModIso_composite_left by fast

lemma isomorphic_to_zero_left : "V = 0  W = 0"
  using bijective bij_betw_imp_surj_on im_zero by fastforce

lemma isomorphic_to_zero_right : "W = 0  V = 0"
  using isomorphic_sym FGModuleIso.isomorphic_to_zero_left by fast

lemma isomorphic_to_irr_right' :
  assumes "U. FGModule.GSubspace G smult' W U  U = 0  U = W"
  shows   "U. GSubspace U  U = 0  U = V"
proof-
  fix U assume U: "GSubspace U"
  have "U  V  U = 0"
  proof-
    assume UV: "U  V"
    from U bijective have "T ` U = T ` V  U = V"
      using bij_betw_imp_inj_on[of T V W] inj_onD[of T V] by fast
    with UV bijective have "T ` U  W" using bij_betw_imp_surj_on by fast
    moreover from U have "FGModule.GSubspace G smult' W (T ` U)"
      using ImG im_submodule by fast
    ultimately show "U = 0" 
      using assms U FGModuleIso_restrict0_GSubspace
            FGModuleIso.isomorphic_to_zero_right
      by    fast
  qed
  thus "U = 0  U = V" by fast
qed

end (* context FGModuleIso *)

context FGModule
begin

lemma isomorphic_sym :
  "isomorphic smult' W  FGModule.isomorphic G smult' W smult V"
  using FGModuleIso.inv by fast

lemma isomorphic_trans : 
  "isomorphic smult' W  FGModule.isomorphic G smult' W smult'' X
         isomorphic smult'' X"
  using FGModuleIso.FGModIso_composite_left by fast

lemma isomorphic_to_zero_left : "V = 0  isomorphic smult' W  W = 0"
  using FGModuleIso.isomorphic_to_zero_left by fast

lemma isomorphic_to_zero_right : "isomorphic smult' 0  V = 0"
  using FGModuleIso.isomorphic_to_zero_right by fast

lemma FGModIso_idhom : "FGModuleIso G smult V smult (idV) V"
  using FGModHom_idhom
proof (rule FGModuleIso.intro)
  show "FGModuleIso_axioms V (idV) V"
    using bij_betw_id bij_betw_restrict0 by unfold_locales fast
qed

lemma isomorphic_refl : "isomorphic smult V" using FGModIso_idhom by fast

end (* context FGModule *)

subsubsection ‹Hom-sets›

definition FGModuleHomSet ::
  "'g::group_add set  (('f::field,'g) aezfun  'v::ab_group_add  'v)  'v set
         (('f,'g) aezfun  'w::ab_group_add  'w)  'w set
         ('v  'w) set"
  where "FGModuleHomSet G fgsmult V fgsmult' W
               {T. FGModuleHom G fgsmult V fgsmult' T}  {T. T ` V  W}"

lemma FGModuleHomSetI :
  "FGModuleHom G fgsmult V fgsmult' T  T ` V  W
         T  FGModuleHomSet G fgsmult V fgsmult' W"
  unfolding FGModuleHomSet_def by fast

lemma FGModuleHomSetD_FGModuleHom :
  "T  FGModuleHomSet G fgsmult V fgsmult' W
         FGModuleHom G fgsmult V fgsmult' T"
  unfolding FGModuleHomSet_def by fast

lemma FGModuleHomSetD_Im :
  "T  FGModuleHomSet G fgsmult V fgsmult' W  T ` V  W"
  unfolding FGModuleHomSet_def by fast

context FGModule
begin

lemma FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet :
  fixes   smult'  :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult' :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     Gmult'  :: "'g  'w  'w" (infixr "*⋆" 70)
  defines fsmult'  : "fsmult'  aezfun_scalar_mult.fsmult smult'"
  and     Gmult'   : "Gmult'  aezfun_scalar_mult.Gmult smult'"
  assumes FGModW   : "FGModule G smult' W"
  shows   "FGModuleHomSet G smult V smult' W
                = (VectorSpaceHomSet fsmult V fsmult' W)
                   {T. gG. vV. T (g *⋅ v) = g *⋆ (T v)}"
proof
  from fsmult' Gmult'
    show  "FGModuleHomSet G smult V smult' W
                 (VectorSpaceHomSet fsmult V fsmult' W)
                   {T. gG. vV. T (g *⋅ v) = g *⋆ T v}"
    using FGModuleHomSetD_FGModuleHom[of _ G smult V smult']
          FGModuleHom.VectorSpaceHom[of G smult V smult'] 
          FGModuleHomSetD_Im[of _ G smult V smult']
          VectorSpaceHomSetI[of fsmult V fsmult']
          FGModuleHom.G_map[of G smult V smult']
    by    auto
  show "FGModuleHomSet G smult V smult' W
               (VectorSpaceHomSet fsmult V fsmult' W)
                 {T. gG. vV. T (g *⋅ v) = g *⋆ T v}"
  proof
    fix T
    assume T: "T  (VectorSpaceHomSet fsmult V fsmult' W)
                     {T. gG. vV. T (g *⋅ v) = g *⋆ T v}"
    show "T  FGModuleHomSet G smult V smult' W"
    proof (rule FGModuleHomSetI, rule VecHom_GMap_is_FGModuleHom)
      from T fsmult'
        show  "VectorSpaceHom (♯⋅) V (aezfun_scalar_mult.fsmult smult') T"
        using VectorSpaceHomSetD_VectorSpaceHom
        by    fast
      from T show "T ` V  W" using VectorSpaceHomSetD_Im by fast
      from T Gmult' 
        show  "g v. g  G  v  V
                     T (g *⋅ v) = aezfun_scalar_mult.Gmult (⋆) g (T v)" 
        by    fast
      from T show "T ` V  W" using VectorSpaceHomSetD_Im by fast
    qed (rule FGModW)
  qed
qed

lemma Group_FGModuleHomSet :
  fixes   smult'  :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult' :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     Gmult'  :: "'g  'w  'w" (infixr "*⋆" 70)
  defines fsmult'  : "fsmult'  aezfun_scalar_mult.fsmult smult'"
  and     Gmult'   : "Gmult'  aezfun_scalar_mult.Gmult smult'"
  assumes FGModW   : "FGModule G smult' W"
  shows   "Group (FGModuleHomSet G smult V smult' W)"
proof
  from FGModW show "FGModuleHomSet G (⋅) V smult' W  {}"
    using FGModule.smult_zero trivial_FGModuleHom[of smult'] FGModule.zero_closed
          FGModuleHomSetI
    by    fastforce
next
  fix S T
  assume S: "S  FGModuleHomSet G (⋅) V smult' W"
    and  T: "T  FGModuleHomSet G (⋅) V smult' W"
  with assms
    have  ST: "S  (VectorSpaceHomSet fsmult V fsmult' W)
                     {T. gG. vV. T (g *⋅ v) = g *⋆ T v}"
              "T  (VectorSpaceHomSet fsmult V fsmult' W)
                     {T. gG. vV. T (g *⋅ v) = g *⋆ T v}"
    using FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet
    by    auto
  with fsmult' have "S - T  VectorSpaceHomSet fsmult V fsmult' W"
    using FGModule.fVectorSpace[OF FGModW]
          VectorSpace.Group_VectorSpaceHomSet[OF fVectorSpace] Group.diff_closed
    by    fast
  moreover have "g v. gG  vV  (S-T) (g *⋅ v) = g *⋆ ((S-T) v)"
  proof-
    fix g v assume "g  G" "v  V"
    moreover with ST have "S v  W" "T v  W" "- T v  W"
      using VectorSpaceHomSetD_Im[of S fsmult V fsmult']
            VectorSpaceHomSetD_Im[of T fsmult V fsmult']
            FGModule.neg_closed[OF FGModW]
      by    auto
    ultimately show "(S-T) (g *⋅ v) = g *⋆ ((S-T) v)"
      using ST Gmult' FGModule.neg_Gmult[OF FGModW]
            FGModule.Gmult_distrib_left[OF FGModW, of g "S v" "- T v"]
      by    auto
  qed
  ultimately show "S - T  FGModuleHomSet G (⋅) V smult' W"
    using fsmult' Gmult'
          FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet[OF FGModW]
    by    fast
qed

lemma Subspace_FGModuleHomSet :
  fixes   smult'     :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult'    :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     Gmult'     :: "'g  'w  'w" (infixr "*⋆" 70)
  and     hom_fsmult :: "'f  ('v  'w)  ('v  'w)" (infixr "♯⋆⋅" 70)
  defines fsmult'     : "fsmult'  aezfun_scalar_mult.fsmult smult'"
  and     Gmult'      : "Gmult'  aezfun_scalar_mult.Gmult smult'"
  defines hom_fsmult  : "hom_fsmult  λa T v. a ♯⋆ T v"
  assumes FGModW      : "FGModule G smult' W"
  shows   "VectorSpace.Subspace hom_fsmult
                (VectorSpaceHomSet fsmult V fsmult' W)
                  (FGModuleHomSet G smult V smult' W)"
proof (rule VectorSpace.SubspaceI)
  from hom_fsmult fsmult'
    show  "VectorSpace (♯⋆⋅) (VectorSpaceHomSet (♯⋅) V (♯⋆) W)"
    using FGModule.fVectorSpace[OF FGModW]
          VectorSpace.VectorSpace_VectorSpaceHomSet[OF fVectorSpace]
    by    fast
  from fsmult' Gmult' FGModW
    show  "Group (FGModuleHomSet G (⋅) V (⋆) W)
                 FGModuleHomSet G (⋅) V (⋆) W
                   VectorSpaceHomSet (♯⋅) V (♯⋆) W"
    using Group_FGModuleHomSet FGModuleHomSet_is_Gmaps_in_VectorSpaceHomSet
    by    fast
next
  fix a T assume T: "T  FGModuleHomSet G (⋅) V (⋆) W"
  from hom_fsmult fsmult' have "FGModuleHom G smult V smult' (a ♯⋆⋅ T)"
    using FGModuleHomSetD_FGModuleHom[OF T]
          FGModuleHomSetD_Im[OF T] 
          FGModuleHom.FGModuleHom_fscalar_mul
    by    simp
  moreover from hom_fsmult fsmult' have "(a ♯⋆⋅ T) ` V  W"
    using FGModuleHomSetD_Im[OF T] FGModule.fsmult_closed[OF FGModW]
    by    auto
  ultimately show "a ♯⋆⋅ T  FGModuleHomSet G (⋅) V (⋆) W"
    using FGModuleHomSetI by fastforce
qed

lemma VectorSpace_FGModuleHomSet :
  fixes   smult'     :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and     fsmult'    :: "'f  'w  'w" (infixr "♯⋆" 70)
  and     hom_fsmult :: "'f  ('v  'w)  ('v  'w)" (infixr "♯⋆⋅" 70)
  defines "fsmult'  aezfun_scalar_mult.fsmult smult'"
  defines "hom_fsmult  λa T v. a ♯⋆ T v"
  assumes "FGModule G smult' W"
  shows   "VectorSpace hom_fsmult (FGModuleHomSet G smult V smult' W)"
  using   assms Subspace_FGModuleHomSet Module.intro VectorSpace.intro
  by      fast

end (* context FGModule *)

subsection ‹Induced modules›

subsubsection ‹Additive function spaces›

definition addfunset ::
  "'a::monoid_add set  'm::monoid_add set  ('a  'm) set"
  where "addfunset A M  {f. supp f  A  range f  M
               (xA. yA. f (x+y) = f x + f y) }"

lemma addfunsetI :
  " supp f  A; range f  M; xA. yA. f (x+y) = f x + f y 
         f  addfunset A M"
  unfolding addfunset_def by fast

lemma addfunsetD_supp : "f  addfunset A M  supp  f  A"
  unfolding addfunset_def by fast

lemma addfunsetD_range : "f  addfunset A M  range f  M"
  unfolding addfunset_def by fast

lemma addfunsetD_range' : "f  addfunset A M  f x  M"
  using addfunsetD_range by fast

lemma addfunsetD_add :
  " f  addfunset A M; xA; yA   f (x+y) = f x + f y"
  unfolding addfunset_def by fast

lemma addfunset0 : "addfunset A (0::'m::monoid_add set) = 0"
proof
  show "addfunset A 0  0" using addfunsetD_range' by fastforce
  have "(0::'a'm)  addfunset A 0"
    using supp_zerofun_subset_any by (rule addfunsetI) auto
  thus "addfunset A (0::'m::monoid_add set)  0" by simp
qed

lemma Group_addfunset :
  fixes   M::"'g::ab_group_add set"
  assumes "Group M"
  shows   "Group (addfunset R M)"
proof
  from assms show "addfunset R M  {}"
    using addfunsetI[of 0 R M] supp_zerofun_subset_any Group.zero_closed
    by    fastforce
next
  fix g h assume gh: "g  addfunset R M" "h  addfunset R M"
  show "g - h  addfunset R M"
  proof (rule addfunsetI)
    from gh show "supp (g - h)  R"
      using addfunsetD_supp supp_diff_subset_union_supp by fast
    from gh show "range (g - h)  M"
      using addfunsetD_range Group.diff_closed [OF assms]
        by (simp add: addfunsetD_range' image_subsetI)
    show "xR. yR. (g - h) (x + y) = (g - h) x + (g - h) y"
      using addfunsetD_add[OF gh(1)] addfunsetD_add[OF gh(2)] by simp
  qed
qed

subsubsection ‹Spaces of functions which transform under scalar multiplication by
                 almost-everywhere-zero functions›

context aezfun_scalar_mult
begin

definition smultfunset :: "'g set  ('r,'g) aezfun set  (('r,'g) aezfun  'v) set"
  where "smultfunset G FH  {f. (a::'r. gG. xFH.
              f ( a δδ g * x ) = (a δδ g)  (f x))}"

lemma smultfunsetD :
  "f  smultfunset G FH; gG; xFH   f ( a δδ g * x ) = (a δδ g)  (f x)"
  unfolding smultfunset_def by fast

lemma smultfunsetI : 
  "a::'r. gG. xFH. f ( a δδ g * x ) = (a δδ g)  (f x)
         f  smultfunset G FH"
  unfolding smultfunset_def by fast

end (* context aezfun_scalar_mult *)

subsubsection ‹General induced spaces of functions on a group ring›

context aezfun_scalar_mult
begin

definition indspace ::
  "'g set  ('r,'g) aezfun set  'v set  (('r,'g) aezfun  'v) set"
  where "indspace G FH V = addfunset FH V  smultfunset G FH"

lemma indspaceD :
  "f  indspace G FH V  f  addfunset FH V  smultfunset G FH"
  using indspace_def by fast

lemma indspaceD_supp : "f  indspace G FH V  supp  f  FH"
  using indspace_def addfunsetD_supp by fast

lemma indspaceD_supp' : "f  indspace G FH V  x  FH  f x = 0"
  using indspaceD_supp suppI_contra by fast

lemma indspaceD_range : "f  indspace G FH V  range f  V"
  using indspace_def addfunsetD_range by fast

lemma indspaceD_range': "f  indspace G FH V  f x  V"
  using indspaceD_range by fast

lemma indspaceD_add :
  " f  indspace G FH V; xFH; yFH   f (x+y) = f x + f y"
  using indspace_def addfunsetD_add by auto

lemma indspaceD_transform : 
  "f  indspace G FH V; gG; xFH   f ( a δδ g * x ) = (a δδ g)  (f x)"
  using indspace_def smultfunsetD by auto

lemma indspaceI :
  "f  addfunset FH V  f  smultfunset G FH  f  indspace G FH V"
  using indspace_def by fast

lemma indspaceI' :
  " supp f  FH; range f  V; xFH. yFH. f (x+y) = f x + f y;
                a::'r. gG. xFH. f ( a δδ g * x ) = (a δδ g)  (f x) 
                   f  indspace G FH V"
  using smultfunsetI addfunsetI[of f] indspaceI by simp

lemma mono_indspace : "mono (indspace G FH)"
proof (rule monoI)
  fix U V :: "'v set" assume U_V: "U  V"
  show "indspace G FH U  indspace G FH V"
  proof
    fix f assume f: "f  indspace G FH U"
    show "f  indspace G FH V" using indspaceD_supp[OF f]
    proof (rule indspaceI')
      from f U_V show "range f  V" using indspaceD_range[of f G FH] by auto
      from f show "xFH. yFH. f (x+y) = f x + f y"
        using indspaceD_add by auto
      from f show "a::'r. gG. xFH. f ( a δδ g * x ) = (a δδ g)  (f x)" 
        using indspaceD_transform by auto
    qed
  qed
qed

end (* context aezfun_scalar_mult *)

context FGModule
begin

lemma zero_transforms : "0  smultfunset G FH"
  using smultfunsetI FG_fddg_closed smult_zero by simp

lemma indspace0 : "indspace G FH 0 = 0"
  using zero_transforms addfunset0 indspace_def by auto

lemma Group_indspace :
  assumes "Ring1 FH"
  shows   "Group (indspace G FH V)"
proof
  from zero_closed have "0  V" by simp
  with mono_indspace [of G FH]
  have "indspace G FH 0  indspace G FH V"
    by (auto dest!: monoD [of _ 0 V])
  then show "indspace G FH V  {}"
    using indspace0 [of FH] by auto
next
  fix f1 f2 assume ff: "f1  indspace G FH V" "f2  indspace G FH V"
  hence "f1 - f2  addfunset FH V"
    using assms indspaceD indspaceD Group Group_addfunset Group.diff_closed
    by    fast
  moreover from ff have "f1 - f2  smultfunset G FH"
    using indspaceD_transform FG_fddg_closed indspaceD_range' smult_distrib_left_diff
          smultfunsetI
    by    simp
  ultimately show "f1 - f2  indspace G FH V" using indspaceI by fast
qed

end (* context FGModule *)

subsubsection ‹The right regular action›

context Ring1
begin

definition rightreg_scalar_mult :: 
  "'r::ring_1  ('r  'm::ab_group_add)  ('r  'm)" (infixr "¤" 70)
  where "rightreg_scalar_mult r f = (λx. if x  R then f (x*r) else 0)"

lemma rightreg_scalar_multD1 : "x  R  (r ¤ f) x = f (x*r)"
  unfolding rightreg_scalar_mult_def by simp

lemma rightreg_scalar_multD2 : "x  R  (r ¤ f) x = 0"
  unfolding rightreg_scalar_mult_def by simp

lemma rrsmult_supp : "supp (r ¤ f)  R"
  using rightreg_scalar_multD2 suppD_contra by force

lemma rrsmult_range : "range (r ¤ f)  {0}  range f"
proof (rule image_subsetI)
  fix x show "(r ¤ f) x  {0}  range f"
    using rightreg_scalar_multD1[of x r f] image_eqI
          rightreg_scalar_multD2[of x r f]
    by    (cases "x  R") auto
qed

lemma rrsmult_distrib_left : "r ¤ (f + g) = r ¤ f + r ¤ g"
proof
  fix x show "(r ¤ (f + g)) x = (r ¤ f + r ¤ g) x"
    unfolding rightreg_scalar_mult_def by (cases "x  R") auto
qed

lemma rrsmult_distrib_right :
  assumes "x y. x  R  y  R  f (x+y) = f x + f y" "r  R" "s  R"
  shows   "(r + s) ¤ f = r ¤ f + s ¤ f"
proof
  fix x show "((r + s) ¤ f) x = (r ¤ f + s ¤ f) x"
    using     assms mult_closed
    unfolding rightreg_scalar_mult_def
    by        (cases "x  R") (auto simp add: distrib_left)
qed

lemma RModule_addfunset :
  fixes   M::"'g::ab_group_add set"
  assumes "Group M"
  shows   "RModule R rightreg_scalar_mult (addfunset R M)"
proof (rule RModuleI)

  from assms show "Group (addfunset R M)" using Group_addfunset by fast

  show "RModule_axioms R (¤) (addfunset R M)"
  proof
    fix r f assume r: "r  R" and f: "f  addfunset R M"
    show "r ¤ f  addfunset R M"
    proof (rule addfunsetI)
      show "supp (r ¤ f)  R"
        using rightreg_scalar_multD2 suppD_contra by force
      show "range (r ¤ f)  M"
        using     addfunsetD_range[OF f] Group.zero_closed[OF assms]
        unfolding rightreg_scalar_mult_def
        by        fastforce
      from r show "xR. yR. (r ¤ f) (x + y) = (r ¤ f) x + (r ¤ f) y"
        using     mult_closed add_closed addfunsetD_add[OF f]
        unfolding rightreg_scalar_mult_def
        by        (simp add: distrib_right)
    qed
  next
    show "r f g. r ¤ (f + g) = r ¤ f + r ¤ g" using rrsmult_distrib_left by fast
  next
    fix r s f assume "r  R" "s  R" "f  addfunset R M"
    thus "(r + s) ¤ f = r ¤ f + s ¤ f"
      using addfunsetD_add[of f] rrsmult_distrib_right[of f] by simp
  next
    fix r s f assume r: "r  R" and s: "s  R" and f: "f  addfunset R M"
    show "r ¤ s ¤ f = (r * s) ¤ f"
    proof
      fix x from r show "(r ¤ s ¤ f) x = ((r * s) ¤ f) x"
        using mult_closed unfolding rightreg_scalar_mult_def
        by    (cases "x  R") (auto simp add: mult.assoc)
    qed
  next
    fix f assume f: "f  addfunset R M"
    show "1 ¤ f = f"
    proof
      fix x show "(1 ¤ f) x = f x"
        unfolding rightreg_scalar_mult_def 
        using     addfunsetD_supp[OF f] suppI_contra[of x f]
                  contra_subsetD[of "supp f"]
        by        (cases "x  R") auto
    qed
  qed

qed (unfold_locales)

end (* context Ring1 *)

subsubsection ‹Locale and basic facts›

text ‹
  In the following locale, @{term G} is a subgroup of @{term H}, @{term V} is a module over the
  group ring for @{term G}, and the induced space @{term indV} will be shown to be a module over the
  group ring for @{term H} under the right regular scalar multiplication @{term rrsmult}.
›

locale InducedFHModule = Supgroup?: Group H
+ BaseFGMod?    : FGModule G smult V
+ induced_smult?: aezfun_scalar_mult rrsmult
  for   H       :: "'g::group_add set"
  and   G       :: "'g set"
  and   FG      :: "('f::field, 'g) aezfun set"
  and   smult   :: "('f, 'g) aezfun  'v::ab_group_add  'v" (infixl "" 70)
  and   V       :: "'v set"
  and   rrsmult :: "('f,'g) aezfun  (('f,'g) aezfun  'v)  (('f,'g) aezfun  'v)"
                                                                                    (infixl "¤" 70)
+ fixes FH      :: "('f, 'g) aezfun set"
  and   indV    :: "(('f, 'g) aezfun  'v) set"
  defines FH      : "FH  Supgroup.group_ring"
  and     indV    : "indV  BaseFGMod.indspace G FH V"
  assumes rrsmult : "rrsmult = Ring1.rightreg_scalar_mult FH"
  and     Subgroup: "Supgroup.Subgroup G"  (* G is a subgroup of H *)
begin

abbreviation indfsmult ::
  "'f  (('f, 'g) aezfun  'v)  (('f, 'g) aezfun  'v)" (infixl "¤¤" 70)
  where "indfsmult  induced_smult.fsmult"
abbreviation indflincomb ::
  "'f list  (('f, 'g) aezfun  'v) list  (('f, 'g) aezfun  'v)" (infixl "∙¤¤" 70)
  where "indflincomb  induced_smult.flincomb"
abbreviation Hmult ::
  "'g  (('f, 'g) aezfun  'v)  (('f, 'g) aezfun  'v)" (infixl "" 70)
  where "Hmult  induced_smult.Gmult"

lemma Ring1_FH : "Ring1 FH" using FH Supgroup.Ring1_RG by fast

lemma FG_subring_FH : "Ring1.Subring1 FH BaseFGMod.FG"
  using FH Supgroup.Subgroup_imp_Subring[OF Subgroup] by fast

lemma rrsmultD1 : "x  FH  (r ¤ f) x = f (x*r)"
  using Ring1.rightreg_scalar_multD1[OF Ring1_FH] rrsmult by simp

lemma rrsmultD2 : "x  FH  (r ¤ f) x = 0"
  using Ring1.rightreg_scalar_multD2[OF Ring1_FH] rrsmult by fast

lemma rrsmult_supp : "supp (r ¤ f)  FH"
  using Ring1.rrsmult_supp[OF Ring1_FH] rrsmult by auto

lemma rrsmult_range : "range (r ¤ f)  {0}  range f"
  using Ring1.rrsmult_range[OF Ring1_FH] rrsmult by auto

lemma FHModule_addfunset : "FGModule H rrsmult (addfunset FH V)"
proof (rule FGModule.intro)
  from FH rrsmult show "RModule Supgroup.group_ring (¤) (addfunset FH V)"
    using Group Supgroup.Ring1_RG Ring1.RModule_addfunset by fast
qed (unfold_locales)

lemma FHSubmodule_indspace :
  "FGModule.FGSubmodule H rrsmult (addfunset FH V) indV"
proof (rule FGModule.FGSubmoduleI[of H], rule FHModule_addfunset, rule conjI)
  from Ring1_FH indV show "Group indV" using Group_indspace by fast
  from indV show "indV  addfunset FH V"
    using BaseFGMod.indspaceD by fast
next
  fix r f assume rf: "r  (Supgroup.group_ring :: ('f,'g) aezfun set)" "f  indV"
  from rf(2) indV have rf2': "f  BaseFGMod.indspace G FH V" by fast
  show "r ¤ f  indV"
    unfolding indV
  proof (rule BaseFGMod.indspaceI', rule rrsmult_supp)
    show "range (r ¤ f)  V"
      using rrsmult_range BaseFGMod.indspaceD_range[OF rf2'] zero_closed
      by    force
    from FH rf(1) rf2'
      show  "xFH. yFH. (r ¤ f) (x + y) = (r ¤ f) x + (r ¤ f) y"
      using Ring1.add_closed[OF Ring1_FH] rrsmultD1[of _ r f]
            Ring1.mult_closed[OF Ring1_FH] BaseFGMod.indspaceD_add
      by    (simp add: distrib_right)
    {
      fix a g x assume gx: "gG" "xFH"
      with FH have "a δδ g * x  FH"
        using FG_fddg_closed FG_subring_FH Ring1.mult_closed[OF Ring1_FH]
        by    fast
      with FH rf(1) gx(2) have "(r ¤ f) (a δδ g * x) = a δδ g  ((r ¤ f) x)"
        using rrsmultD1[of _ r f] Ring1.mult_closed[OF Ring1_FH] 
              BaseFGMod.indspaceD_transform[OF rf2' gx(1)]
        by    (simp add: mult.assoc)
    }
    thus "a. gG. xFH. (r ¤ f) (a δδ g * x) = a δδ g  (r ¤ f) x" by fast
  qed
qed

lemma FHModule_indspace : "FGModule H rrsmult indV"
proof (rule FGModule.intro)
  show "RModule Supgroup.group_ring (¤) indV" using FHSubmodule_indspace by fast
qed (unfold_locales)

lemmas fVectorSpace_indspace = FGModule.fVectorSpace[OF FHModule_indspace]
lemmas restriction_is_FGModule
              = FGModule.restriction_to_subgroup_is_module[OF FHModule_indspace]

definition induced_vector :: "'v  (('f, 'g) aezfun  'v)"
  where "induced_vector v  (if v  V
              then (λy. if y  FH then (FG_proj y)  v else 0) else 0)"

lemma induced_vector_apply1 :
  "v  V  x  FH  induced_vector v x = (FG_proj x)  v"
  using induced_vector_def by simp

lemma induced_vector_apply2 : "v  V  x  FH  induced_vector v x = 0"
  using induced_vector_def by simp

lemma induced_vector_indV :
  assumes v: "v  V"
  shows   "induced_vector v  indV"
  unfolding indV 
proof (rule BaseFGMod.indspaceI')

  from assms show "supp (induced_vector v)  FH"
    using induced_vector_def supp_restrict0[of FH "λy. (FG_proj y)  v"] by simp

  show "range (induced_vector v)  V"
  proof (rule image_subsetI)
    fix y
    from v show "(induced_vector v) y  V"
      using     induced_vector_def zero_closed aezfun_setspan_proj_in_setspan[of G y]
                smult_closed ActingGroup.group_ringD
      by        auto
  qed

  {
    fix x y assume xy: "x  FH" "y  FH"
    with v have "(induced_vector v) (x + y)
                      = (induced_vector v) x + (induced_vector v) y"
      using Ring1_FH Ring1.add_closed aezfun_setspan_proj_add[of G x y] FG_proj_in_FG
            smult_distrib_left induced_vector_def
      by    auto
  }
  thus "xFH. yFH. induced_vector v (x + y)
              = induced_vector v x + induced_vector v y"
    by fast

  {
    fix a g x assume g: "g  G" and x: "x  FH"
    with v FH
      have  "(induced_vector v) (a δδ g * x) = a δδ g  (induced_vector v) x"
      using FG_subring_FH FG_fddg_closed Ring1_FH
            Ring1.mult_closed[of FH "a δδ g"] FG_proj_mult_leftdelta[of g a]
            FG_fddg_closed FG_proj_in_FG smult_assoc induced_vector_def
      by    fastforce
  }
  thus "a. gG. xFH. induced_vector v (a δδ g * x)
              = a δδ g  induced_vector v x"
    by fast

qed

lemma induced_vector_additive :
  "v  V  v'  V
         induced_vector (v+v') = induced_vector v + induced_vector v'"
  using add_closed induced_vector_def FG_proj_in_FG smult_distrib_left by auto

lemma hom_induced_vector : "FGModuleHom G smult V rrsmult induced_vector"
proof

  show "v v'. v  V  v'  V
               induced_vector (v + v') = induced_vector v + induced_vector v'"
    using induced_vector_additive by fast

  have "induced_vector = (λv. if vV then λy. if y  FH
              then (FG_proj y)  v else 0 else 0)"
    using induced_vector_def by fast
  thus "supp induced_vector  V" using supp_restrict0[of V] by fastforce

  show "x v. x  BaseFGMod.FG  v  V
               induced_vector (x  v) = x ¤ induced_vector v"
  proof-
    fix x v assume xv: "x  BaseFGMod.FG" "v  V"
    show "induced_vector (x  v) = x ¤ induced_vector v"
    proof
      fix a
      from xv FH show "induced_vector (x  v) a = (x ¤ induced_vector v) a"
        using smult_closed induced_vector_def FG_proj_in_FG smult_assoc rrsmultD1
              FG_subring_FH Ring1.mult_closed[OF Ring1_FH] induced_vector_apply1
              FG_proj_mult_right[of x] smult_closed induced_vector_apply2 rrsmultD2
        by    auto
    qed
  qed

qed

lemma indspace_sum_list_fddh: 
  " fhs  []; set (map snd fhs)  H; f  indV 
         f ((a,h)fhs. a δδ h) = ((a,h)fhs. f (a δδ h))"
proof (induct fhs rule: list_nonempty_induct)
  case (single fh) show ?case 
    using split_beta[of "λa h. a δδ h" fh] split_beta[of "λa h. f (a δδ h)" fh] by simp
next
  case (cons fh fhs)
  hence prevcase: "snd fh  H" "set (map snd fhs)  H" "f  indV"
                  "f ((a,h)fhs. a δδ h) = ((a,h)fhs. f (a δδ h))"
    by auto
  have "f ((a,h)fh#fhs. a δδ h)
              = f ((fst fh) δδ (snd fh) + (ahfhs. case_prod (λa h. a δδ h) ah))"
    using split_beta[of "λa h. a δδ h" fh] by simp
  moreover from prevcase(1) FH have "(fst fh) δδ (snd fh)  FH"
    using Supgroup.RG_aezdeltafun_closed by fast
  moreover from prevcase(2) FH
    have  "(ahfhs. case_prod (λa h. a δδ h) ah)  FH"
    using Supgroup.RG_aezdeltafun_closed
          Ring1.sum_list_closed[OF Ring1_FH, of "λah. case_prod (λa h. a δδ h) ah" fhs]
    by    fastforce
  ultimately have "f ((a,h)fh#fhs. a δδ h)
                              = f ((fst fh) δδ (snd fh)) + f ((a,h)fhs. a δδ h)"
    using indV prevcase(3) BaseFGMod.indspaceD_add by simp
  with prevcase(4) show ?case using split_beta[of "λa h. f (a δδ h)" fh] by simp
qed

lemma induced_fsmult_conv_fsmult_1ddh :
  "f  indV  h  H  (r ¤¤ f) (1 δδ h) = r ♯⋅ (f (1 δδ h))"
  using FH indV induced_smult.fsmultD Supgroup.RG_aezdeltafun_closed[of h "1::'f"]
        rrsmultD1 aezdeltafun_decomp'[of r h]
        aezdeltafun_decomp[of r h] Supgroup.RG_aezdeltafun_closed[of h "1::'f"]
        Group.zero_closed[OF GroupG]
        BaseFGMod.indspaceD_transform[of f G FH V 0 "(1::'f) δδ h" r]
        BaseFGMod.fsmultD
  by    simp

lemma indspace_el_eq_on_1ddh_imp_eq_on_rddh :
  assumes "HmodG  H" "H = (hHmodG. G + {h})" "f  indV" "f'  indV" 
          "hHmodG. f (1 δδ h) = f' (1 δδ h)" "h  H"
  shows   "f (r δδ h) = f' (r δδ h)"
proof-
  from assms(2,6) obtain h' where h': "h'  HmodG" "h  G + {h'}" by fast
  from h'(2) obtain g where g: "g  G" "h = g + h'"
    using set_plus_def[of G] by auto
  from g(2) have "r δδ h = r δδ 0 * (1 δδ (g+h'))"
    using aezdeltafun_decomp by simp
  moreover have "(1::'f) δδ (g+h') = 1 δδ g * (1 δδ h')"
    using times_aezdeltafun_aezdeltafun[of "1::'f", THEN sym] by simp
  ultimately have "r δδ h = r δδ g * (1 δδ h')"
    using aezdeltafun_decomp[of r g]
    by    (simp add: algebra_simps)
  with indV FH assms(1,3,4) g(1) h'(1)
    have  "f (r δδ h) = r δδ g  f (1 δδ h')" "f' (r δδ h) = r δδ g  f' (1 δδ h')"
    using Supgroup.RG_aezdeltafun_closed[of h' 1]
          BaseFGMod.indspaceD_transform[of f G FH V g "1 δδ h'" r]
          BaseFGMod.indspaceD_transform[of f' G FH V g "1 δδ h'" r]
    by    auto
  thus "f (r δδ h) = f' (r δδ h)" using h'(1) assms(5) by simp
qed

lemma indspace_el_eq :
  assumes "HmodG  H" "H = (hHmodG. G + {h})" "f  indV" "f'  indV" 
          "hHmodG. f (1 δδ h) = f' (1 δδ h)"
  shows   "f = f'"
proof
  fix x show "f x = f' x"
  proof (cases "x = 0" "x  FH" rule: conjcases)
    case BothTrue 
    hence "x = 0 δδ 0" using zero_aezfun_transfer by simp
    with assms show ?thesis
      using indspace_el_eq_on_1ddh_imp_eq_on_rddh[of HmodG f f'] Supgroup.zero_closed
        by auto
  next
    case OneTrue with FH show ?thesis using Supgroup.RG_zero_closed by fast
  next
    case OtherTrue 
    with FH obtain rhs
      where rhs: "set (map snd rhs)  H" "x = ((r,h)rhs. r δδ h)"
      using Supgroup.RG_el_decomp_aezdeltafun
      by    fast
    from OtherTrue rhs(2) have rhs_nnil: "rhs  []" by auto
    with assms(3,4) rhs
      have  "f x = ((r,h)rhs. f (r δδ h))" "f' x = ((r,h)rhs. f' (r δδ h))"
      using indspace_sum_list_fddh
      by    auto
    moreover from rhs(1) assms have "(r,h)  set rhs. f (r δδ h) = f' (r δδ h)"
      using indspace_el_eq_on_1ddh_imp_eq_on_rddh[of HmodG f f'] by fastforce
    ultimately show ?thesis
      using sum_list_prod_cong[of rhs "λr h. f (r δδ h)"] by simp
  next
    case BothFalse
    with indV assms(3,4) show ?thesis
      using BaseFGMod.indspaceD_supp'[of f] BaseFGMod.indspaceD_supp'[of f']
      by    simp
  qed
qed

lemma indspace_el_eq' :
  assumes "set hs  H" "H = (hset hs. G + {h})" "f  indV" "f'  indV"
          "i<length hs. f (1 δδ (hs!i)) = f' (1 δδ (hs!i))"
  shows   "f = f'"
  using assms(1-4)
proof (rule indspace_el_eq[of "set hs"])
  have "h. hset hs  f (1 δδ h) = f' (1 δδ h)"
  proof-
    fix h assume "h  set hs"
    from this obtain i where "i < length hs" "h = hs!i"
      using in_set_conv_nth[of h] by fast
    with assms(5) show "f (1 δδ h) = f' (1 δδ h)" by simp
  qed
  thus "hset hs. f (1 δδ h) = f' (1 δδ h)" by fast
qed

end (* context InducedFHModule *)




section ‹Representations of Finite Groups›

subsection ‹Locale and basic facts›

text ‹
  Define a group representation to be a module over the group ring that is finite-dimensional as
  a vector space. The only restriction on the characteristic of the field is that it does not
  divide the order of the group. Also, we don't explicitly assume that the group is finite;
  instead, the good_char› assumption implies that the cardinality of G is not zero, which
  implies G is finite. (See lemma good_card_imp_finite›.)
›

locale FinGroupRepresentation = FGModule G smult V
  for G     :: "'g::group_add set"
  and smult :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixl "" 70)
  and V     :: "'v set"
+
  assumes good_char: "of_nat (card G)  (0::'f)"
  and     findim   : "fscalar_mult.findim fsmult V"

lemma (in Group) trivial_FinGroupRep :
  fixes   smult     :: "('f::field, 'g) aezfun  'v::ab_group_add  'v"
  assumes good_char  : "of_nat (card G)  (0::'f)"
  and     smult_zero : "agroup_ring. smult a (0::'v) = 0"
  shows   "FinGroupRepresentation G smult (0::'v set)"
proof (rule FinGroupRepresentation.intro)
  from smult_zero show "FGModule G smult (0::'v set)"
    using trivial_FGModule by fast

  have "fscalar_mult.findim (aezfun_scalar_mult.fsmult smult) 0"
    by auto (metis R_scalar_mult.RSpan.simps(1) aezfun_scalar_mult.R_scalar_mult empty_set empty_subsetI set_zero)

  with good_char show "FinGroupRepresentation_axioms G smult 0" by unfold_locales
qed

context FinGroupRepresentation
begin

abbreviation ordG :: 'f where "ordG  of_nat (card G)"
abbreviation "GRepHom  FGModuleHom G smult V"
abbreviation "GRepIso  FGModuleIso G smult V"
abbreviation "GRepEnd  FGModuleEnd G smult V"

lemmas zero_closed              = zero_closed
lemmas Group                    = Group
lemmas GSubmodule_GSpan_single  = RSubmodule_RSpan_single
lemmas GSpan_single_nonzero     = RSpan_single_nonzero

lemma finiteG: "finite G"
  using good_char good_card_imp_finite by fast

lemma FinDimVectorSpace: "FinDimVectorSpace fsmult V"
  using findim fVectorSpace VectorSpace.FinDimVectorSpaceI by fast

lemma GSubspace_is_FinGroupRep :
  assumes "GSubspace U"
  shows   "FinGroupRepresentation G smult U"
proof (
  rule FinGroupRepresentation.intro, rule GSubspace_is_FGModule[OF assms], unfold_locales
)
  from assms show "fscalar_mult.findim fsmult U"
    using FinDimVectorSpace GSubspace_is_Subspace FinDimVectorSpace.Subspace_is_findim
    by    fast
qed (rule good_char)

lemma isomorphic_imp_GRep :
  assumes "isomorphic smult' W"
  shows   "FinGroupRepresentation G smult' W"
proof (rule FinGroupRepresentation.intro)
  from assms show "FGModule G smult' W"
    using FGModuleIso.ImG FGModuleHom.FGModule_Im[OF FGModuleIso.axioms(1)]
    by    fast
  from assms have "fscalar_mult.findim (aezfun_scalar_mult.fsmult smult') W"
    using FGModuleIso.ImG findim FGModuleIso.VectorSpaceHom
          VectorSpaceHom.findim_domain_findim_image
    by    fastforce
  with good_char show "FinGroupRepresentation_axioms G smult' W" by unfold_locales
qed

end (* context FinGroupRepresentation *)


subsection ‹Irreducible representations›

locale IrrFinGroupRepresentation = FinGroupRepresentation
+ assumes irr: "GSubspace U  U = 0  U = V"
begin

lemmas AbGroup = AbGroup

lemma zero_isomorphic_to_FG_zero :
  assumes "V = 0"
  shows   "isomorphic (*) (0::('b,'a) aezfun set)"
proof
  show "GRepIso (*) 0 0"
  proof (rule FGModuleIso.intro)
    show "GRepHom (*) 0" using trivial_FGModuleHom[of "(*)"] by simp
    show "FGModuleIso_axioms V 0 0"
    proof
      from assms show "bij_betw 0 V 0" unfolding bij_betw_def inj_on_def by simp
    qed
  qed
qed

lemma eq_GSpan_single : "v  V  v  0  V = GSpan [v]"
  using irr RSubmodule_RSpan_single RSpan_single_nonzero by fast

end (* context IrrFinGroupRepresentation *)

lemma (in Group) trivial_IrrFinGroupRepI :
  fixes   smult :: "('f::field, 'g) aezfun  'v::ab_group_add  'v"
  assumes "of_nat (card G)  (0::'f)"
  and     "agroup_ring. smult a (0::'v) = 0"
  shows   "IrrFinGroupRepresentation G smult (0::'v set)"
proof (rule IrrFinGroupRepresentation.intro)
  from assms show "FinGroupRepresentation G smult 0"
    using trivial_FinGroupRep by fast
  show "IrrFinGroupRepresentation_axioms G smult 0"
    using RModule.zero_closed by unfold_locales auto
qed

lemma (in Group) trivial_IrrFinGroupRepresentation_in_FG :
  "of_nat (card G)  (0::'f::field)
         IrrFinGroupRepresentation G (*) (0::('f,'g) aezfun set)"
  using trivial_IrrFinGroupRepI[of "(*)"] by simp

context FinGroupRepresentation
begin

lemma IrrFinGroupRep_trivialGSubspace :
  "IrrFinGroupRepresentation G smult (0::'v set)"
proof-
  have "ordG  (0::'f)" using good_char by fast
  moreover have "aFG. a  0 = 0" using smult_zero by simp
  ultimately show ?thesis
    using ActingGroup.trivial_IrrFinGroupRepI[of smult] by fast
qed

lemma IrrI :
  assumes "U. FGModule.GSubspace G smult V U  U = 0  U = V"
  shows   "IrrFinGroupRepresentation G smult V"
  using assms IrrFinGroupRepresentation.intro by unfold_locales

lemma notIrr :
  "¬ IrrFinGroupRepresentation G smult V
         U. GSubspace U  U  0  U  V"
  using IrrI by fast

end (* context FinGroupRepresentation *)


subsection ‹Maschke's theorem›

subsubsection ‹Averaged projection onto a G-subspace›

context FinGroupRepresentation
begin

lemma avg_proj_eq_id_on_right :
  assumes "VectorSpace fsmult W" "add_independentS [W,V]" "v  V"
  defines P : "P  ([W,V]1)"
  defines CP: "CP  (λg. Gmult (- g)  P  Gmult g)"
  defines T : "T  fsmult (1/ordG)  (gG. CP g)"
  shows   "T v = v"
proof-
  from P assms(2,3) have "g. g  G  P (g *⋅ v) = g *⋅ v"
    using Gmult_closed VectorSpace.AbGroup[OF assms(1)] AbGroup 
          AbGroup_inner_dirsum_el_decomp_nth_id_on_nth[of "[W,V]"]
    by    simp
  with CP assms(3) have "g. g  G  CP g v = v"
    using Gmult_neg_left by simp
  with assms(3) good_char T show "T v = v"
    using finiteG sum_fun_apply[of G CP] sum_fsmult_distrib[of v G "λx. 1"]
          fsmult_assoc[of _ ordG v]
    by    simp
qed

lemma avg_proj_onto_right :
  assumes "VectorSpace fsmult W" "GSubspace U" "add_independentS [W,U]"
          "V = W  U"
  defines P : "P  ([W,U]1)"
  defines CP: "CP  (λg. Gmult (- g)  P  Gmult g)"
  defines T : "T  fsmult (1/ordG)  (gG. CP g)"
  shows   "T ` V = U"
proof
  from assms(2) have U: "FGModule G smult U"
    using GSubspace_is_FGModule by fast
  show "T ` V  U"
  proof (rule image_subsetI)
    fix v assume v: "v  V"
    with assms(1,3,4) P U have "g. g  G  P (g *⋅ v)  U"
      using Gmult_closed VectorSpace.AbGroup FGModule.AbGroup
            AbGroup_inner_dirsum_el_decomp_nth_onto_nth[of "[W,U]" 1]
      by    fastforce
    with U CP have "g. g  G  CP g v  U"
      using FGModule.Gmult_closed GroupG Group.neg_closed by fastforce
    with assms(2) U T show "T v  U"
      using finiteG FGModule.sum_closed[of G smult U G "λg. CP g v"]
            sum_fun_apply[of G CP] FGModule.fsmult_closed[of G smult U]
      by    fastforce
  qed
  show "T ` V  U"
  proof
    fix u assume u: "u  U"
    with u T CP P assms(1,2,3) have "T u = u"
      using GSubspace_is_FinGroupRep FinGroupRepresentation.avg_proj_eq_id_on_right
      by    fast
    from this[THEN sym] assms(1-4) u show "u  T ` V"
      using Module.AbGroup RModule.AbGroup AbGroup_subset_inner_dirsum
      by    fast
  qed
qed

lemma FGModuleEnd_avg_proj_right :
  assumes "fSubspace W" "GSubspace U" "add_independentS [W,U]" "V = W  U"
  defines P : "P  ([W,U]1)"
  defines CP: "CP  (λg. Gmult (- g)  P  Gmult g)"
  defines T : "T  (fsmult (1/ordG)  (gG. CP g))V"
  shows   "FGModuleEnd G smult V T"
proof (rule VecEnd_GMap_is_FGModuleEnd)

  from T have T_apply: "v. vV  T v = (1/ordG) ♯⋅ (gG. CP g v)"
    using finiteG sum_fun_apply[of G CP] by simp

  from assms(1-4) P have Pgv: "g v. g  G  v  V  P ( g *⋅ v )  V"
    using Gmult_closed VectorSpace_fSubspace VectorSpace.AbGroup[of fsmult W]
          RModule.AbGroup[of FG smult U]
          GroupEnd_inner_dirsum_el_decomp_nth[of "[W,U]" 1]
          GroupEnd.endomorph[of V]
    by force

  have im_CP_V: "v. v  V  (λg. CP g v) ` G  V"
  proof-
    fix v assume "v  V" thus "(λg. CP g v) ` G  V"
      using CP Pgv[of _ v] ActingGroup.neg_closed Gmult_closed finiteG by auto
  qed

  have sumCP_V: "v. v  V  (gG. CP g v)  V"
    using finiteG im_CP_V sum_closed by force

  show "VectorSpaceEnd (♯⋅) V T"
  proof (
    rule VectorSpaceEndI, rule VectorSpace.VectorSpaceHomI, rule fVectorSpace
  )

    show "GroupHom V T"
    proof
      fix v v' assume vv': "v  V" "v'  V"
      with T_apply have "T (v + v') = (1/ordG) ♯⋅ (gG. CP g (v + v'))"
        using add_closed by fast
      moreover have "g. g  G  CP g (v + v') = CP g v + CP g v'"
      proof-
        fix g assume g: "g  G"
        with CP P vv' assms(1-4)
          have  "CP g (v + v') = (- g) *⋅ ( P ( g *⋅ v ) + P ( g *⋅ v' ) )"
          using Gmult_distrib_left Gmult_closed VectorSpace_fSubspace
                VectorSpace.AbGroup[of fsmult W] RModule.AbGroup[of FG smult U]
                GroupEnd_inner_dirsum_el_decomp_nth[of "[W,U]" 1]
                GroupEnd.hom[of V P]
          by    simp
        with g vv' have "CP g (v + v')
                              = (- g) *⋅ P ( g *⋅ v ) + (- g) *⋅ P ( g *⋅ v' )"
          using Pgv ActingGroup.neg_closed Gmult_distrib_left by simp
        thus "CP g (v + v') = CP g v + CP g v'" using CP by simp
      qed
      ultimately show "T (v + v') = T v + T v'"
        using vv' sumCP_V[of v] sumCP_V[of v'] sum.distrib[of "λg. CP g v"]
              T_apply
        by    simp
    next
      from T show "supp T  V" using supp_restrict0 by fast
    qed

    show "a v. v  V  T (a ♯⋅ v) = a ♯⋅ T v"
    proof-
      fix a::'f and v assume v: "v  V"
      with T_apply have "T (a ♯⋅ v) = (1/ordG) ♯⋅ (gG. CP g (a ♯⋅ v))"
        using fsmult_closed by fast
      moreover have "g. g  G  CP g (a ♯⋅ v) = a ♯⋅ CP g v"
      proof-
        fix g assume "g  G"
        with assms(1-4) CP P v show "CP g (a ♯⋅ v) = a ♯⋅ CP g v"
          using fsmult_Gmult_comm GSubspace_is_Subspace Gmult_closed fVectorSpace
                VectorSpace.VectorSpaceEnd_inner_dirsum_el_decomp_nth[of fsmult]
                VectorSpaceEnd.f_map[of fsmult "(N[W, U]. N)" P a "g *⋅ v"]
                ActingGroup.neg_closed Pgv
          by    simp
      qed
      ultimately show "T (a ♯⋅ v) = a ♯⋅ T v"
        using v im_CP_V sumCP_V T_apply finiteG
              fsmult_sum_distrib[of a G "λg. CP g v"]
              fsmult_assoc[of "1/ordG" a "(gG. CP g v)"]
        by    simp
    qed

    show "T ` V  V" using sumCP_V fsmult_closed T_apply image_subsetI by auto

  qed

  show "g v. g  G  v  V  T (g *⋅ v) = g *⋅ T v"
  proof-
    fix g v assume g: "g  G" and v: "v  V"
    with T_apply have "T (g *⋅ v) = (1/ordG) ♯⋅ (hG. CP h (g *⋅ v))"
      using Gmult_closed by fast
    with g have "T (g *⋅ v) = (1/ordG) ♯⋅ (hG. CP (h + - g) (g *⋅ v))"
      using GroupG Group.neg_closed
            Group.right_translate_sum[of G "- g" "λh. CP h (g *⋅ v)"]
      by    fastforce
    moreover from CP
      have  "h. h  G  CP (h + - g) (g *⋅ v) = g *⋅ CP h v"
      using g v Gmult_closed[of g v] ActingGroup.neg_closed
            Gmult_assoc[of _ "- g" "g *⋅ v", THEN sym]
            Gmult_neg_left minus_add[of _ "- g"] Pgv Gmult_assoc
      by    simp
    ultimately show "T (g *⋅ v) = g *⋅ T v"
      using g v GmultD finiteG FG_fddg_closed im_CP_V sumCP_V
            smult_sum_distrib[of "1 δδ g" G]
            fsmult_Gmult_comm[of g "hG. (CP h v)"] T_apply
      by    simp
  qed

qed

lemma avg_proj_is_proj_right :
  assumes "VectorSpace fsmult W" "GSubspace U" "add_independentS [W,U]"
          "V = W  U" "v  V"
  defines P : "P  ([W,U]1)"
  defines CP: "CP  (λg. Gmult (- g)  P  Gmult g)"
  defines T : "T  fsmult (1/ordG)  (gG. CP g)"
  shows   "T (T v) = T v"
  using   assms avg_proj_onto_right GSubspace_is_FinGroupRep
          FinGroupRepresentation.avg_proj_eq_id_on_right
  by      fast

end (* context FinGroupRepresentation *)

subsubsection ‹The theorem›

context FinGroupRepresentation
begin

theorem Maschke :
  assumes "GSubspace U"
  shows   "W. GSubspace W  V = W  U"
proof (cases "V = 0")
  case True
  moreover from assms True have "U = 0" using RModule.zero_closed by auto
  ultimately have "V = 0 + U" using set_plus_def by fastforce
  moreover have "add_independentS [0,U]" by simp
  ultimately have "V = 0  U" using inner_dirsum_doubleI by fast
  moreover have "GSubspace 0" using trivial_RSubmodule zero_closed by auto
  ultimately show "W. GSubspace W  V = W  U" by fast
next
  case False
  from assms obtain W'
    where W': "VectorSpace.Subspace fsmult V W'  V = W'  U"
    using GSubspace_is_Subspace FinDimVectorSpace FinDimVectorSpace.semisimple
    by    force
  hence vsp_W': "VectorSpace fsmult W'" and dirsum: "V = W'  U"
    using VectorSpace.SubspaceD1[OF fVectorSpace] by auto
  from False dirsum have indS: "add_independentS [W',U]"
    using inner_dirsumD2 by fastforce
  define P where "P  = ([W',U]1)"
  define CP where "CP = (λg. Gmult (- g)  P  Gmult g)"
  define S where "S = fsmult (1/ordG)  (gG. CP g)"
  define W where "W = GroupHom.Ker V (SV)"
  from assms W' indS S_def CP_def P_def have endo: "GRepEnd (SV)"
    using FGModuleEnd_avg_proj_right by fast
  moreover from S_def CP_def P_def have "v. v  V  (SV) ((SV) v) = (SV) v"
      using endo FGModuleEnd.endomorph
            avg_proj_is_proj_right[OF vsp_W' assms indS dirsum]
      by    fastforce
  moreover have "(SV) ` V = U"
  proof-
    from assms indS P_def CP_def S_def dirsum vsp_W' have "S ` V = U"
      using avg_proj_onto_right by fast
    moreover have "(SV) ` V = S ` V" by auto
    ultimately show ?thesis by fast
  qed
  ultimately have "V = W  U" "GSubspace W"
    using W_def FGModuleEnd.proj_decomp[of G smult V "SV"]
          FGModuleEnd.GSubspace_Ker
    by    auto
  thus ?thesis by fast
qed

corollary Maschke_proper :
  assumes "GSubspace U" "U  0" "U  V"
  shows   "W. GSubspace W  W  0  W  V  V = W  U"
proof-
  from assms(1) obtain W where W: "GSubspace W" "V = W  U"
    using Maschke by fast
  from assms(3) W(2) have "W  0" using inner_dirsum_double_left0 by fast
  moreover from assms(1,2) W have "W  V"
    using Subgroup_RSubmodule Group.nonempty
          inner_dirsum_double_leftfull_imp_right0[of W U]
    by    fastforce
  ultimately show ?thesis using W by fast
qed

end (* context FinGroupRepresentation *)

subsubsection ‹Consequence: complete reducibility›

lemma (in FinGroupRepresentation) notIrr_decompose :
  "¬ IrrFinGroupRepresentation G smult V
         U W. GSubspace U  U  0  U  V  GSubspace W  W  0
           W  V  V = U  W"
  using notIrr Maschke_proper by blast

text ‹
  In the following decomposition lemma, we do not need to explicitly include the condition that all
  @{term U} in @{term "set Us"} are subsets of @{term V}. (See lemma AbGroup_subset_inner_dirsum›.)
›

lemma FinGroupRepresentation_reducible' :
  fixes n::nat
  shows "V. FinGroupRepresentation G fgsmult V
               n = FGModule.fdim fgsmult V
                 (Us. Ball (set Us) (IrrFinGroupRepresentation G fgsmult)
                   (0  set Us)  V = (UUs. U) )"
proof (induct n rule: full_nat_induct)
  fix n V
  define GRep IGRep GSubspace GSpan fdim
    where "GRep = FinGroupRepresentation G fgsmult"
      and "IGRep = IrrFinGroupRepresentation G fgsmult"
      and "GSubspace = FGModule.GSubspace G fgsmult V"
      and "GSpan = FGModule.GSpan G fgsmult"
      and "fdim = FGModule.fdim fgsmult"
  assume "m. Suc m  n  (x. GRep x  m = fdim x  ( Us.
              Ball (set Us) IGRep  (0  set Us)  x = (UUs. U)) )"
  hence prev_case:
    "m. m < n  (W. GRep W  m = fdim W  ( Us.
            Ball (set Us) IGRep  (0  set Us)  W = (UUs. U)))"
    using Suc_le_eq by auto
  show "GRep V  n = fdim V  ( Us.
          Ball (set Us) IGRep  (0  set Us)  V = (UUs. U) )"
  proof-
    assume V: "GRep V  n = fdim V"
    show "(Us. Ball (set Us) IGRep  (0  set Us)  V = (UUs. U))"
    proof (cases "IGRep V" "V = 0" rule: conjcases)
      case BothTrue
      moreover have "Ball (set []) IGRep" "Uset []. U  0" by auto
      ultimately show ?thesis using inner_dirsum_Nil by fast
    next
      case OneTrue
      with V GRep_def obtain v where v: "v  V" "v  0" 
        using FinGroupRepresentation.Group[of G fgsmult] Group.obtain_nonzero
        by    auto
      from v(1) V GRep_def GSpan_def GSubspace_def have GSub: "GSubspace (GSpan [v])"
        using FinGroupRepresentation.GSubmodule_GSpan_single by fast
      moreover from v V GRep_def GSpan_def have nzero: "GSpan [v]  0"
        using FinGroupRepresentation.GSpan_single_nonzero by fast
      ultimately have "V = GSpan [v]"
        using OneTrue GSpan_def GSubspace_def IGRep_def IrrFinGroupRepresentation.irr
        by    fast
      with OneTrue
        have  "Ball (set [GSpan [v]]) IGRep" "0  set [GSpan [v]]"
              "V = (U[GSpan [v]]. U)"
        using nzero GSub inner_dirsum_singleD
        by    auto
      thus ?thesis by fast
    next
      case OtherTrue with V GRep_def IGRep_def show ?thesis
        using FinGroupRepresentation.IrrFinGroupRep_trivialGSubspace by fast
    next
      case BothFalse
      with V GRep_def IGRep_def GSubspace_def obtain U W
        where U: "GSubspace U" "U  0" "U  V"
        and   W: "GSubspace W" "W  0" "W  V"
        and   Vdecompose: "V = U  W"
        using FinGroupRepresentation.notIrr_decompose[of G fgsmult V]
        by    auto
      from U(1,3) W(1,3) V GRep_def GSubspace_def fdim_def
        have  "fdim U < fdim V" "fdim W < fdim V"
        using FinGroupRepresentation.axioms(1)
              FGModule.GSubspace_is_Subspace[of G fgsmult V U]
              FGModule.GSubspace_is_Subspace[of G fgsmult V W]
              FinGroupRepresentation.FinDimVectorSpace[of G fgsmult V]
              FinDimVectorSpace.Subspace_dim_lt[
                of "aezfun_scalar_mult.fsmult fgsmult" V U
              ]
              FinDimVectorSpace.Subspace_dim_lt[
                of "aezfun_scalar_mult.fsmult fgsmult" V W
              ]
        by    auto
      from this U(1) W(1) V GSubspace_def obtain Us Ws
        where "Ball (set Us) IGRep  (0  set Us)  U = (XUs. X)"
        and   "Ball (set Ws) IGRep  (0  set Ws)  W = (XWs. X)"
        using prev_case[of "fdim U"] prev_case[of "fdim W"] GRep_def
              FinGroupRepresentation.GSubspace_is_FinGroupRep[
                of G fgsmult V U
              ]
              FinGroupRepresentation.GSubspace_is_FinGroupRep[
                of G fgsmult V W
              ]
        by    fastforce
      hence Us: "Ball (set Us) IGRep" "0  set Us" "U = (XUs. X)"
        and Ws: "Ball (set Ws) IGRep" "0  set Ws" "W = (XWs. X)"
        by  auto
      from Us(1) Ws(1) have "Ball (set (Us@Ws)) IGRep" by auto
      moreover from Us(2) Ws(2) have "0  set (Us@Ws)" by auto
      moreover have "V = (X(Us@Ws). X)"
      proof-
        from U(2) Us(3) W(2) Ws(3)
          have  indUs: "add_independentS Us"
          and   indWs: "add_independentS Ws"
          using inner_dirsumD2
          by    auto
        moreover from IGRep_def Us(1) have "Ball (set Us) ((∈) 0)"
          using IrrFinGroupRepresentation.axioms(1)[of G fgsmult]
                FinGroupRepresentation.zero_closed[of G fgsmult]
          by    fast
        moreover from Us(3) Ws(3) BothFalse Vdecompose indUs indWs
          have "add_independentS [(XUs. X),(XWs. X)]"
          using inner_dirsumD2[of "[U,W]"] inner_dirsumD[of Us]
                inner_dirsumD[of Ws]
          by    auto
        ultimately have "add_independentS (Us@Ws)"
          by (metis add_independentS_double_sum_conv_append) 
        moreover from W(1) Ws(3) indWs have "0  (XWs. X)"
          using inner_dirsumD GSubspace_def RModule.zero_closed by fast
        ultimately show ?thesis
          using Vdecompose Us(3) Ws(3) inner_dirsum_append by fast
      qed
      ultimately show ?thesis by fast
    qed
  qed
qed

theorem (in FinGroupRepresentation) reducible :
  "Us. (Uset Us. IrrFinGroupRepresentation G smult U)  (0  set Us) 
         V = (UUs. U)"
  using FinGroupRepresentation_axioms FinGroupRepresentation_reducible' by fast

subsubsection ‹Consequence: decomposition relative to a homomomorphism›

lemma (in FinGroupRepresentation) GRepHom_decomp :
  fixes   T   :: "'v  'w::ab_group_add"
  defines KerT : "KerT  (ker T  V)"
  assumes hom  : "GRepHom smult' T" and nonzero: "V  0"
  shows   "U. GSubspace U  V = U  KerT
                 FGModule.isomorphic G smult U smult' (T ` V)"
proof-
  from KerT have KerT': "GSubspace KerT"
    using FGModuleHom.GSubspace_Ker[OF hom] by fast
  from this obtain U where U: "GSubspace U" "V = U  KerT"
    using Maschke[of KerT] by fast
  from nonzero U(2) have indep: "add_independentS [U,KerT]"
    using inner_dirsumD2 by fastforce
  have "FGModuleIso G smult U smult' (T  U) (T ` V)"
  proof (rule FGModuleIso.intro)
    from U(1) show "FGModuleHom G (⋅) U smult' (T  U)"
      using FGModuleHom.FGModuleHom_restrict0_GSubspace[OF hom] by fast
    show "FGModuleIso_axioms U (T  U) (T ` V)"
      unfolding FGModuleIso_axioms_def bij_betw_def
    proof (rule conjI, rule inj_onI)
      show "(T  U) ` U = T ` V"
      proof
        from U(1) show "(T  U) ` U  T ` V" by auto
        show "(T  U) ` U  T ` V"
        proof (rule image_subsetI)
          fix v assume "v  V"
          with U(2) obtain u k where uk: "u  U" "k  KerT" "v = u + k"
            using inner_dirsum_doubleD[OF indep] set_plus_def[of U KerT] by fast
          with KerT U(1) have "T v = (T  U) u"
            using kerD FGModuleHom.additive[OF hom] by force
          with uk(1) show "T v  (T  U) ` U" by fast
        qed
      qed
    next
      fix x y assume xy: "x  U" "y  U" "(T  U) x = (T  U) y"
      with U(1) KerT have "x - y  U  KerT"
        using FGModuleHom.eq_im_imp_diff_in_Ker[OF hom]
              GSubspace_is_FGModule FGModule.diff_closed[of G smult U x y]
        by    auto
      moreover from U(1) have "AbGroup U" using RModule.AbGroup by fast
      moreover from KerT' have "AbGroup KerT"
        using RModule.AbGroup by fast
      ultimately show "x = y" 
        using indep AbGroup_inner_dirsum_pairwise_int0_double[of U KerT]
        by    force
    qed
  qed
  with U show ?thesis by fast
qed


subsection ‹Schur's lemma›

lemma (in IrrFinGroupRepresentation) Schur_Ker :
  "GRepHom smult' T  T ` V  0  inj_on T V"
  using irr FGModuleHom.GSubspace_Ker[of G smult V smult' T] 
        FGModuleHom.Ker_Im_iff[of G smult V smult' T]
        FGModuleHom.Ker0_imp_inj_on[of G smult V smult' T]
  by    auto

lemma (in FinGroupRepresentation) Schur_Im :
  assumes "IrrFinGroupRepresentation G smult' W" "GRepHom smult' T"
          "T ` V  W"
          "T ` V  0"
  shows   "T ` V = W"
proof-
  have "FGModule.GSubspace G smult' W (T ` V)"
  proof
    from assms(2) show "RModule FG smult' (T ` V)"
      using FGModuleHom.axioms(2)[of G]
            RModuleHom.RModule_Im[of FG smult V smult' T]
      by    fast
    from assms(3) show "T ` V  W" by fast
  qed
  with assms(1,4) show ?thesis using IrrFinGroupRepresentation.irr by fast
qed

theorem (in IrrFinGroupRepresentation) Schur1 :
  assumes   "IrrFinGroupRepresentation G smult' W" 
            "GRepHom smult' T" "T ` V  W" "T ` V  0"
  shows     "GRepIso smult' T W"
proof (rule FGModuleIso.intro, rule assms(2), unfold_locales)
  show "bij_betw T V W"
    using     IrrFinGroupRepresentation_axioms assms
              IrrFinGroupRepresentation.axioms(1)[of G]
              FinGroupRepresentation.Schur_Im[of G]
              IrrFinGroupRepresentation.Schur_Ker[of G smult V smult' T]
    unfolding bij_betw_def
    by        fast
qed

theorem (in IrrFinGroupRepresentation) Schur2 :
  assumes GRep      : "GRepEnd T"
  and     fdim       : "fdim > 0"
  and     alg_closed: "p::'b poly. degree p > 0  c. poly p c = 0"
  shows   "c. v  V. T v = c ♯⋅ v"
proof-
  from fdim alg_closed obtain e u where eu: "u  V" "u  0" "T u = e ♯⋅ u"
    using FGModuleEnd.VectorSpaceEnd[OF GRep]
          FinDimVectorSpace.endomorph_has_eigenvector[
            OF FinDimVectorSpace, of T
          ]
    by    fast
  define U where "U = {v  V. T v = e ♯⋅ v}"
  moreover from eu U_def have "U  0" by auto
  ultimately have "v  V. T v = e ♯⋅ v"
    using GRep irr FGModuleEnd.axioms(1)[of G smult V T]
          GSubspace_eigenspace[of G smult]
    by    fast
  thus ?thesis by fast
qed


subsection ‹The group ring as a representation space›

subsubsection ‹The group ring is a representation space›

lemma (in Group) FGModule_FG :
  defines FG: "FG  group_ring :: ('f::field, 'g) aezfun set"
  shows   "FGModule G (*) FG"
proof (rule FGModule.intro, rule Group_axioms, rule RModuleI)
  show 1: "Ring1 group_ring" using Ring1_RG by fast
  from 1 FG show "Group FG" using Ring1.axioms(1) by fast
  from 1 FG show "RModule_axioms group_ring (*) FG"
    using Ring1.mult_closed
    by    unfold_locales (auto simp add: algebra_simps)
qed

theorem (in Group) FinGroupRepresentation_FG :
  defines FG: "FG  group_ring :: ('f::field, 'g) aezfun set"
  assumes good_char: "of_nat (card G)  (0::'f)"
  shows   "FinGroupRepresentation G (*) FG"
proof (rule FinGroupRepresentation.intro)
  from FG show "FGModule G (*) FG" using FGModule_FG by fast
  show "FinGroupRepresentation_axioms G (*) FG"
  proof
    from FG good_char obtain gs
      where gs: "set gs = G"
                "f FG. bs. length bs = length gs
                       f = ((b,g)zip bs gs. (b δδ 0) * (1 δδ g))"
      using good_card_imp_finite FinGroupI FinGroup.group_ring_spanning_set
      by    fast
    define xs where "xs = map ((δδ) (1::'f)) gs"
    with FG gs(1) have 1: "set xs  FG" using RG_aezdeltafun_closed by auto
    moreover have "aezfun_scalar_mult.fSpan (*) xs = FG"
    proof
      from 1 FG show "aezfun_scalar_mult.fSpan (*) xs  FG"
        using FGModule_FG FGModule.fSpan_closed by fast
      show "aezfun_scalar_mult.fSpan (*) xs  FG"
      proof
        fix x assume "x  FG"
        from this gs(2) obtain bs
          where bs: "length bs = length gs"
                    "x = ((b,g)zip bs gs. (b δδ 0) * (1 δδ g))"
          by    fast
        from bs(2) xs_def have "x = ((b,a)zip bs xs. (b δδ 0) * a)"
          using sum_list_prod_map2[THEN sym] by fast
        with bs(1) xs_def show "x  aezfun_scalar_mult.fSpan (*) xs"
          using aezfun_scalar_mult.fsmultD[of "(*)", THEN sym]
                sum_list_prod_cong[
                  of "zip bs xs" "λb a. (b δδ 0) * a"
                     "λb a. aezfun_scalar_mult.fsmult (*) b a"
                ]
                scalar_mult.lincomb_def[of "aezfun_scalar_mult.fsmult (*)" bs xs]
                scalar_mult.SpanD_lincomb[of "aezfun_scalar_mult.fsmult (*)"]
          by    force
      qed
    qed
    ultimately show "xs. set xs  FG  aezfun_scalar_mult.fSpan (*) xs = FG"
      by fast
  qed (rule good_char)
qed

lemma (in FinGroupRepresentation) FinGroupRepresentation_FG :
  "FinGroupRepresentation G (*) FG"
  using good_char ActingGroup.FinGroupRepresentation_FG by fast

lemma (in Group) FG_reducible :
  assumes "of_nat (card G)  (0::'f::field)"
  shows   "Us::('f,'g) aezfun set list.
                (Uset Us. IrrFinGroupRepresentation G (*) U)  0  set Us
                   group_ring = (UUs. U)"
  using   assms FinGroupRepresentation_FG FinGroupRepresentation.reducible
  by      fast

subsubsection ‹Irreducible representations are constituents of the group ring›

lemma (in FGModuleIso) isomorphic_to_irr_right :
  assumes "IrrFinGroupRepresentation G smult' W"
  shows   "IrrFinGroupRepresentation G smult V"
proof (rule FinGroupRepresentation.IrrI)
  from assms show "FinGroupRepresentation G (⋅) V"
    using IrrFinGroupRepresentation.axioms(1) isomorphic_sym
          FinGroupRepresentation.isomorphic_imp_GRep
    by    fast
  from assms show "U. GSubspace U  U = 0  U = V"
    using IrrFinGroupRepresentation.irr isomorphic_to_irr_right' by fast
qed

lemma (in FinGroupRepresentation) IrrGSubspace_iso_constituent :
  assumes nonzero : "V  0"
  and     subsp   : "W  V" "W  0" "IrrFinGroupRepresentation G smult W"
  and     V_decomp: "Uset Us. IrrFinGroupRepresentation G smult U"
                    "0  set Us" "V = (UUs. U)"
  shows   "Uset Us. FGModule.isomorphic G smult W smult U"
proof-
  from V_decomp(1) have abGrp: "Uset Us. AbGroup U"
    using IrrFinGroupRepresentation.AbGroup by fast
  from nonzero V_decomp(3) have indep: "add_independentS Us"
    using inner_dirsumD2 by fast
  with V_decomp (3) have "Uset Us. U  V"
    using abGrp AbGroup_subset_inner_dirsum by fast
  with subsp(1,3) V_decomp(1)
    have  GSubspaces: "GSubspace W" "U set Us. GSubspace U"
    using IrrFinGroupRepresentation.axioms(1)[of G smult]
          FinGroupRepresentation.axioms(1)[of G smult] GSubspaceI
    by    auto
  have "i. i < length Us  (Usi) ` W  0
               FGModuleIso G smult W smult ( (Usi)  W ) (Us!i)"
  proof-
    fix i assume i: "i < length Us" "(Usi) ` W  0"
    from i(1) V_decomp(3) have "GRepEnd (Usi)"
      using GSubspaces(2) indep GEnd_inner_dirsum_el_decomp_nth by fast
    hence "FGModuleHom G smult W smult ( (Usi)  W )"
      using GSubspaces(1) FGModuleEnd.FGModuleHom_restrict0_GSubspace
      by    fast
    moreover have "( (Usi)  W ) ` W  Us!i"
    proof-
      from V_decomp(3) i(1) subsp(1,3) have "(Usi) ` W  Us!i"
        using indep abGrp AbGroup_inner_dirsum_el_decomp_nth_onto_nth by fast
      thus ?thesis by auto
    qed
    moreover from i(1) V_decomp(1)
      have "IrrFinGroupRepresentation G smult (Us!i)"
      by   simp
    ultimately show "FGModuleIso G smult W smult ( (Usi)  W ) (Us!i)"
      using i(2)
            IrrFinGroupRepresentation.Schur1[
              OF subsp(3), of smult "Us!i" "(Usi)  W "
            ]
      by    auto
  qed
  moreover from nonzero V_decomp(3)
    have  "i<length Us. (Usi) ` W = 0  W = 0"
    using inner_dirsum_Nil abGrp subsp(1) indep
          AbGroup_inner_dirsum_subset_proj_eq_0[of Us W]
    by    fastforce
  ultimately have "i<length Us.  FGModuleIso G smult W smult
                        ( (Usi)  W ) (Us!i)"
    using subsp(2) by auto
  thus ?thesis using set_conv_nth[of Us] by auto
qed

theorem (in IrrFinGroupRepresentation) iso_FG_constituent :
  assumes nonzero  : "V  0"
  and     FG_decomp: "Uset Us. IrrFinGroupRepresentation G (*) U"
                     "0  set Us" "FG = (UUs. U)"
  shows   "Uset Us. isomorphic (*) U"
proof-
  from nonzero obtain v where v: "v  V" "v  0" using nonempty by auto
  define T where "T = (λx. x  v)FG"
  have "FGModuleHom G (*) FG smult T"
  proof (rule FGModule.FGModuleHomI_fromaxioms)
    show "FGModule G (*) FG"
      using ActingGroup.FGModule_FG by fast
    from T_def v(1) show "v v'. v  FG  v'  FG  T (v + v') = T v + T v'"
      using Ring1.add_closed[OF Ring1] smult_distrib_right by auto
    from T_def show "supp T  FG" using supp_restrict0 by fast
    from T_def v(1) show "r m. r  FG  m  FG  T (r * m) = r  T m"
      using ActingGroup.RG_mult_closed by auto
  qed
  then obtain W
    where W: "FGModule.GSubspace G (*) FG W" "FG = W  (ker T  FG)"
             "FGModule.isomorphic G (*) W smult (T ` FG)"
    using FG_n0
          FinGroupRepresentation.GRepHom_decomp[
            OF FinGroupRepresentation_FG
          ]
    by    fast
  from T_def v have "T ` FG = V" using eq_GSpan_single RSpan_single by auto
  with W(3) have W': "FGModule.isomorphic G (*) W smult V" by fast
  with W(1) nonzero have "W  0"
    using FGModule.GSubspace_is_FGModule[OF ActingGroup.FGModule_FG]
          FGModule.isomorphic_to_zero_left
    by    fastforce
  moreover from W' have "IrrFinGroupRepresentation G (*) W"
    using IrrFinGroupRepresentation_axioms FGModuleIso.isomorphic_to_irr_right
    by    fast
  ultimately have "Uset Us. FGModule.isomorphic G (*) W (*) U"
    using FG_decomp W(1) good_char FG_n0
          FinGroupRepresentation.IrrGSubspace_iso_constituent[
            OF ActingGroup.FinGroupRepresentation_FG, of W
          ]
    by    simp
  with W(1) W' show ?thesis
    using FGModule.GSubspace_is_FGModule[OF ActingGroup.FGModule_FG]
          FGModule.isomorphic_sym[of G "(*)" W smult] isomorphic_trans
    by    fast
qed


subsection ‹Isomorphism classes of irreducible representations›

text ‹
  We have already demonstrated that the relation FGModule.isomorphic› is reflexive
  (lemma FGModule.isomorphic_refl›), symmetric (lemma FGModule.isomorphic_sym›),
  and transitive (lemma FGModule.isomorphic_trans›). In this section, we provide a finite
  set of representatives for the resulting isomorphism classes of irreducible representations.
›

context Group
begin

primrec remisodups :: "('f::field,'g) aezfun set list  ('f,'g) aezfun set list" where
  "remisodups [] = []"
| "remisodups (U # Us) = (if
        (Wset Us. FGModule.isomorphic G (*) U (*) W)
          then remisodups Us else U # remisodups Us)"

lemma set_remisodups : "set (remisodups Us)  set Us"
  by (induct Us) auto

lemma isodistinct_remisodups :
  " Uset Us. FGModule G (*) U; V  set (remisodups Us);
        W  set (remisodups Us); V  W 
           ¬ (FGModule.isomorphic G (*) V (*) W)"
proof (induct Us arbitrary: V W)
  case (Cons U Us)
  show ?case
  proof (cases "Xset Us. FGModule.isomorphic G (*) U (*) X")
    case True with Cons show ?thesis by simp
  next
    case False show ?thesis
    proof (cases "V=U" "W=U" rule: conjcases)
      case BothTrue with Cons(5) show ?thesis by fast
    next
      case OneTrue with False Cons(4,5) show ?thesis
        using set_remisodups by auto
    next
      case OtherTrue with False Cons(2,3) show ?thesis
        using set_remisodups FGModule.isomorphic_sym[of G "(*)" V "(*)" W]
        by    fastforce
    next
      case BothFalse with Cons False show ?thesis by simp
    qed
  qed
qed simp

definition "FG_constituents  SOME Us.
                  (Uset Us. IrrFinGroupRepresentation G (*) U)
                     0  set Us  group_ring = (UUs. U)"

lemma FG_constituents_irr :
  "of_nat (card G)  (0::'f::field)
         Uset (FG_constituents::('f,'g) aezfun set list). 
          IrrFinGroupRepresentation G (*) U"
  using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast

lemma FG_consitutents_n0:
  "of_nat (card G)  (0::'f::field)
         0  set (FG_constituents::('f,'g) aezfun set list)"
  using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast

lemma FG_constituents_constituents :
  "of_nat (card G)  (0::'f::field)
         (group_ring::('f,'g) aezfun set) = (UFG_constituents. U)"
  using someI_ex[OF FG_reducible] unfolding FG_constituents_def by fast

definition "GIrrRep_repset  0  set (remisodups FG_constituents)"

lemma finite_GIrrRep_repset : "finite GIrrRep_repset"
  unfolding GIrrRep_repset_def by simp

lemma all_irr_GIrrRep_repset :
  assumes "of_nat (card G)  (0::'f::field)"
  shows "U(GIrrRep_repset::('f,'g) aezfun set set).
              IrrFinGroupRepresentation G (*) U"
proof
  fix U :: "('f,'g) aezfun set" assume "U  GIrrRep_repset"
  with assms show "IrrFinGroupRepresentation G (*) U"
    using trivial_IrrFinGroupRepresentation_in_FG GIrrRep_repset_def
          set_remisodups FG_constituents_irr
    by    (cases "U = 0") auto
qed

lemma isodistinct_GIrrRep_repset :
  defines "GIRRS  GIrrRep_repset :: ('f::field,'g) aezfun set set"
  assumes "of_nat (card G)  (0::'f)" "V  GIRRS" "W  GIRRS" "V  W"
  shows   "¬ (FGModule.isomorphic G (*) V (*) W)"
proof (cases "V = 0" "W = 0" rule: conjcases)
  case BothTrue with assms(5) show ?thesis by fast
next
  case OneTrue with assms(1,2,4,5) show ?thesis
    using GIrrRep_repset_def set_remisodups FG_consitutents_n0
          trivial_FGModule[of "(*)"] FGModule.isomorphic_to_zero_left[of G "(*)"]
    by    fastforce
next
  case OtherTrue
  moreover with assms(1,3) have "V  set FG_constituents"
    using GIrrRep_repset_def set_remisodups by auto
  ultimately show ?thesis
    using assms(2) FG_consitutents_n0 FG_constituents_irr
          IrrFinGroupRepresentation.axioms(1)
          FinGroupRepresentation.axioms(1)
          FGModule.isomorphic_to_zero_right[of G "(*)" V "(*)"]
    by    fastforce
next
  case BothFalse
  with assms(1,3,4) have "V  set (remisodups FG_constituents)"
                         "W  set (remisodups FG_constituents)"
    using GIrrRep_repset_def by auto
  with assms(2,5) show ?thesis
    using FG_constituents_irr IrrFinGroupRepresentation.axioms(1)
          FinGroupRepresentation.axioms(1) isodistinct_remisodups
    by    fastforce
qed

end (* context Group *)

lemma (in FGModule) iso_in_list_imp_iso_in_remisodups :
  "Uset Us. isomorphic (*) U
         Uset (ActingGroup.remisodups Us). isomorphic (*) U"
proof (induct Us)
  case (Cons U Us)
  from Cons(2) obtain W where W: "W  set (U#Us)" "isomorphic (*) W"
    by fast
  show ?case
  proof (
    cases "W = U" "Xset Us. FGModule.isomorphic G (*) U (*) X"
    rule: conjcases
  )
    case BothTrue with W(2) Cons(1) show ?thesis
      using isomorphic_trans[of "(*)" W] by force
  next
    case OneTrue with W(2) show ?thesis by simp
  next
    case OtherTrue with Cons(1) W show ?thesis by auto
  next
    case BothFalse with Cons(1) W show ?thesis by auto
  qed
qed simp

lemma (in IrrFinGroupRepresentation) iso_to_GIrrRep_rep :
  "UActingGroup.GIrrRep_repset. isomorphic (*) U"
  using zero_isomorphic_to_FG_zero ActingGroup.GIrrRep_repset_def
        good_char ActingGroup.FG_constituents_irr
        ActingGroup.FG_consitutents_n0 ActingGroup.FG_constituents_constituents
        iso_FG_constituent iso_in_list_imp_iso_in_remisodups
        ActingGroup.GIrrRep_repset_def
  by    (cases "V = 0") auto

theorem (in Group) iso_class_reps :
  defines "GIRRS  GIrrRep_repset :: ('f::field,'g) aezfun set set"
  assumes "of_nat (card G)  (0::'f)"
  shows "finite GIRRS"
        "UGIRRS. IrrFinGroupRepresentation G (*) U"
        "U W.  U  GIRRS; W  GIRRS; U  W 
               ¬ (FGModule.isomorphic G (*) U (*) W)"
        "fgsmult V. IrrFinGroupRepresentation G fgsmult V
               UGIRRS. FGModule.isomorphic G fgsmult V (*) U"
  using assms finite_GIrrRep_repset all_irr_GIrrRep_repset
        isodistinct_GIrrRep_repset IrrFinGroupRepresentation.iso_to_GIrrRep_rep
  by    auto


subsection ‹Induced representations›

subsubsection ‹Locale and basic facts›

locale InducedFinGroupRepresentation = Supgroup?: Group H
+ BaseRep?: FinGroupRepresentation G smult V
+ induced_smult?: aezfun_scalar_mult rrsmult
  for   H       :: "'g::group_add set"
  and   G       :: "'g set"
  and   smult   :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixl "" 70)
  and   V       :: "'v set"
  and   rrsmult :: "('f,'g) aezfun  (('f,'g) aezfun 'v)
                           (('f,'g) aezfun 'v)" (infixl "¤" 70)
+ fixes FH      :: "('f, 'g) aezfun set"
  and   indV    :: "(('f, 'g) aezfun  'v) set"
  defines FH            : "FH  Supgroup.group_ring"
  and     indV          : "indV  BaseRep.indspace G FH V"
  assumes rrsmult       : "rrsmult = Ring1.rightreg_scalar_mult FH"
  and     good_ordSupgrp: "of_nat (card H)  (0::'f)"  (* this implies H is finite *)
  and     Subgroup      : "Supgroup.Subgroup G"  (* G is a subgroup of H *)

sublocale InducedFinGroupRepresentation < InducedFHModule 
  using FH indV rrsmult Subgroup by unfold_locales fast

context InducedFinGroupRepresentation
begin

abbreviation ordH :: 'f where "ordH  of_nat (card H)"
abbreviation "is_Vfbasis  fbasis_for V"
abbreviation "GRepHomSet  FGModuleHomSet G smult V"
abbreviation "HRepHom     FGModuleHom H rrsmult indV"
abbreviation "HRepHomSet  FGModuleHomSet H rrsmult indV"

lemma finiteSupgroup: "finite H"
  using good_ordSupgrp good_card_imp_finite by fast

lemma FinGroupSupgroup : "FinGroup H"
  using finiteSupgroup Supgroup.FinGroupI by fast

lemmas fVectorSpace          = fVectorSpace
lemmas FinDimVectorSpace     = FinDimVectorSpace
lemmas ex_rcoset_replist_hd0
              = FinGroup.ex_rcoset_replist_hd0[OF FinGroupSupgroup Subgroup]

end (* context InducedFinGroupRepresentation *)

subsubsection ‹A basis for the induced space›

context InducedFinGroupRepresentation
begin

abbreviation "negHorbit_list  induced_smult.negGorbit_list"

lemmas ex_rcoset_replist
              = FinGroup.ex_rcoset_replist[OF FinGroupSupgroup Subgroup]
lemmas length_negHorbit_list         = induced_smult.length_negGorbit_list
lemmas length_negHorbit_list_sublist = induced_smult.length_negGorbit_list_sublist
lemmas negHorbit_list_indV           = FGModule.negGorbit_list_V[OF FHModule_indspace]

lemma flincomb_Horbit_induced_veclist_reduce :
  fixes   vs         :: "'v list"
  and     hs         :: "'g list"
  defines hfvss       : "hfvss  negHorbit_list hs induced_vector vs"
  assumes vs          : "set vs  V" and i: "i < length hs"
  and     scalars     : "list_all2 (λrs ms. length rs = length ms) css hfvss"
  and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
  shows   "((concat css) ∙¤¤ (concat hfvss)) (1 δδ (hs!i)) = (css!i) ∙♯⋅ vs"
proof-
  have mostly_zero:
    "k j. k < length hs  j < length hs 
           ((css!j) ∙¤¤ (hfvss!j)) (1 δδ hs!k)
            = (if j = k then (css!k) ∙♯⋅ vs else 0)"
  proof-
    fix k j assume k: "k < length hs" and j: "j < length hs"
    hence hsk_H: "hs!k  H" and hsj_H: "hs!j  H"
      using Supgroup.is_rcoset_replistD_set[OF rcoset_reps] by auto
    define LHS where "LHS = ((css!j) ∙¤¤ (hfvss!j)) (1 δδ hs!k)"
    with hfvss
      have "LHS = ((r,m)zip (css!j) (hfvss!j). (r ¤¤ m) (1 δδ hs!k))"
      using length_negHorbit_list scalar_mult.lincomb_def[of induced_smult.fsmult]
            sum_list_prod_fun_apply
      by    simp
    moreover have "(r,m)  set (zip (css!j) (hfvss!j)).
                        (induced_smult.fsmult r m) (1 δδ hs!k) = r ♯⋅ m (1 δδ hs!k)"
    proof (rule prod_ballI)
      fix r m assume "(r,m)  set (zip (css!j) (hfvss!j))"
      with k j vs hfvss
        show "(induced_smult.fsmult r m) (1 δδ hs!k) = r ♯⋅ m (1 δδ hs!k)"
        using Supgroup.is_rcoset_replistD_set[OF rcoset_reps] set_zip_rightD
              set_concat length_negHorbit_list[of hs induced_vector vs]
              nth_mem[of j hfvss] hsk_H induced_fsmult_conv_fsmult_1ddh[of m "hs!k" r]
              induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
        by    force
    qed
    ultimately have
      "LHS = ((r,v)zip (css!j) vs.
            r ♯⋅ (induced_vector v) (1 δδ hs!k * (1 δδ - hs!j)))"
      using FH j hfvss induced_smult.negGorbit_list_def[of hs induced_vector vs]
            sum_list_prod_cong[of _ "λr m. (induced_smult.fsmult r m) (1 δδ hs!k)"]
            sum_list_prod_map2[of
              "λr m. r ♯⋅ m (1 δδ hs!k)" _ "Hmult (- hs!j)" "map induced_vector vs"
            ]
            sum_list_prod_map2[of "λr v. r ♯⋅ (Hmult (-hs!j) v) (1 δδ hs!k)"]
            induced_smult.GmultD hsk_H
            Supgroup.RG_aezdeltafun_closed[of "hs!k" "1::'f"]
            rrsmultD1[of "1 δδ (hs!k)"]
      by    force
    moreover have "(1::'f) δδ hs!k * (1 δδ - hs!j) = 1 δδ (hs!k - hs!j)"
      using times_aezdeltafun_aezdeltafun[of "1::'f" "hs!k" 1 "-(hs!j)"]
      by (simp add: algebra_simps)
    ultimately have "LHS = ((r,v)zip (css!j) vs.
                          r ♯⋅ (induced_vector v) (1 δδ (hs!k - hs!j)))"
      using sum_list_prod_map2 by simp
    moreover from FH vs
      have "(r,v)  set (zip (css!j) vs). r ♯⋅ (induced_vector v) (1 δδ (hs!k - hs!j))
                  = r ♯⋅ (FG_proj (1 δδ (hs!k - hs!j))  v)"
      using set_zip_rightD induced_vector_def hsk_H hsj_H Supgroup.diff_closed
            Supgroup.RG_aezdeltafun_closed[of _ "1::'f"]
      by    fastforce
    ultimately have calc: "LHS = ((r,v)zip (css!j) vs.
                                r ♯⋅ (FG_proj (1 δδ (hs!k - hs!j))  v) )"
      using sum_list_prod_cong by force
    show "LHS = (if j = k then (css!k) ∙♯⋅ vs else 0)"
    proof (cases "j = k")
      case True
      with calc have "LHS = ((r,v)zip (css!k) vs. r ♯⋅ 1 ♯⋅ v)"
        using Group.zero_closed[OF GroupG]
              aezfun_setspan_proj_aezdeltafun[of G "1::'f"]
              BaseRep.fsmult_def
        by    simp
      moreover from vs have "(r,v)  set (zip (css!k) vs). r ♯⋅ 1 ♯⋅ v = r ♯⋅ v"
        using set_zip_rightD BaseRep.fsmult_assoc by fastforce
      ultimately show ?thesis
        using True sum_list_prod_cong[of _ "λr v. r ♯⋅ 1 ♯⋅ v"]
              scalar_mult.lincomb_def[of BaseRep.fsmult]
        by    simp
    next
      case False
      with k j calc have "LHS = ((r,v)zip (css!j) vs. r ♯⋅ (0  v))"
        using Supgroup.is_rcoset_replist_imp_nrelated_nth[OF Subgroup rcoset_reps]
              aezfun_setspan_proj_aezdeltafun[of G "1::'f"]
        by    simp
      moreover from vs have "(r,v)  set (zip (css!j) vs). r ♯⋅ (0  v) = 0"
        using set_zip_rightD BaseRep.zero_smult by fastforce
      ultimately have "LHS = ((r,v)zip (css!j) vs. (0::'v))"
        using sum_list_prod_cong[of _ "λr v. r ♯⋅ (0  v)"] by simp
      hence "LHS = (rvzip (css!j) vs. case_prod (λr v. (0::'v)) rv)" by fastforce
      with False show ?thesis by simp
    qed
  qed

  define terms LHS
    where "terms = map (λa. case_prod (λcs hfvs. (cs ∙¤¤ hfvs) (1 δδ hs!i)) a) (zip css hfvss)"
      and "LHS = ((concat css) ∙¤¤ (concat hfvss)) (1 δδ (hs!i))"
  hence "LHS = sum_list terms"
    using scalars
          VectorSpace.lincomb_concat[OF fVectorSpace_indspace, of css hfvss]
          sum_list_prod_fun_apply
    by    simp
  hence "LHS = (j{0..<length terms}. terms!j)"
    using sum_list_sum_nth[of terms] by simp
  moreover from terms_def
    have "j{0..<length terms}. terms!j = ((css!j) ∙¤¤ (hfvss!j)) (1 δδ hs!i)"
    by   simp
  ultimately show "LHS = (css!i) ∙♯⋅ vs"
    using terms_def sum.cong scalars list_all2_lengthD[of _ css hfvss] hfvss 
          length_negHorbit_list[of hs induced_vector vs] i mostly_zero
          sum_single_nonzero[
            of "{0..<length hs}" "λi j. ((css!j) ∙¤¤ (hfvss!j)) (1 δδ (hs!i))"
               "λi. (css!i) ∙♯⋅ vs"
          ]
    by    simp

qed

lemma indspace_fspanning_set :
  fixes   vs         :: "'v list"
  and     hs         :: "'g list"
  defines hfvss       : "hfvss  negHorbit_list hs induced_vector vs"
  assumes base_spset  : "set vs  V" "V = BaseRep.fSpan vs"
  and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
  shows   "indV = induced_smult.fSpan (concat hfvss)"
proof (rule VectorSpace.SpanI[OF fVectorSpace_indspace])
  from base_spset(1) hfvss show "set (concat hfvss)  indV"
    using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
          induced_vector_indV negHorbit_list_indV
    by    fast
  show "indV  R_scalar_mult.RSpan UNIV (aezfun_scalar_mult.fsmult (¤))
              (concat hfvss)"
  proof

    fix f assume f: "f  indV"
    hence "h  set hs. f (1 δδ h)  V"
      using indV BaseRep.indspaceD_range by fast
    with base_spset(2)
      have  coeffs_exist: "h  set hs. ahs. length ahs = length vs
                                 f (1 δδ h) = ahs ∙♯⋅ vs"
      using BaseRep.in_fSpan_obtain_same_length_coeffs
      by    fast
    define f_coeffs
      where "f_coeffs h = (SOME ahs. length ahs = length vs  f (1 δδ h) = ahs ∙♯⋅ vs)" for h
    define ahss where "ahss = map f_coeffs hs"
    hence len_ahss: "length ahss = length hs" by simp
    with hfvss have len_zip_ahss_hfvss: "length (zip ahss hfvss) = length hs"
      using length_negHorbit_list[of hs induced_vector vs] by simp
    have len_ahss_el: "ahsset ahss. length ahs = length vs"
    proof
      fix ahs assume "ahs  set ahss"
      from this ahss_def obtain h where h: "h  set hs" "ahs = f_coeffs h"
        using set_map by auto
      from h(1) have "ahs. length ahs = length vs  f (1 δδ h) = ahs ∙♯⋅ vs"
        using coeffs_exist by fast
      with h(2) show "length ahs = length vs"
        unfolding f_coeffs_def
        using someI_ex[of "λahs. length ahs = length vs  f (1 δδ h) = ahs ∙♯⋅ vs"]
        by    fast
    qed
    have "(ahs,hfvs)set (zip ahss hfvss). length ahs = length hfvs"
    proof
      fix x assume x: "x  set (zip ahss hfvss)"
      show "case x of (ahs, hfvs)  length ahs = length hfvs"
      proof
        fix ahs hfvs assume "x = (ahs,hfvs)"
        with x hfvss have "length ahs = length vs" "length hfvs = length vs"
          using set_zip_leftD[of ahs hfvs] len_ahss_el set_zip_rightD[of ahs hfvs]
                length_negHorbit_list_sublist[of _ hs induced_vector]
          by    auto
        thus "length ahs = length hfvs" by simp
      qed
    qed
    with hfvss have list_all2_len_ahss_hfvss:
      "list_all2 (λrs ms. length rs = length ms) ahss hfvss"
      using len_ahss length_negHorbit_list[of hs induced_vector vs]
            list_all2I[of ahss hfvss]
      by    auto

    define f' where "f' = (concat ahss) ∙¤¤ (concat hfvss)"
    have "f = f'"
      using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
            Supgroup.group_eq_subgrp_rcoset_un[OF Subgroup rcoset_reps]
            f
    proof (rule indspace_el_eq'[of hs])
      from f'_def hfvss base_spset(1) show "f'  indV"
        using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
              induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
              FGModule.flincomb_closed[OF FHModule_indspace]
        by    fast
      have "i. i<length hs  f (1 δδ (hs!i)) = f' (1 δδ (hs!i))"
      proof-
        fix i assume i: "i < length hs"
        with f_coeffs_def have "f (1 δδ (hs!i)) = (f_coeffs (hs!i)) ∙♯⋅ vs"
          using coeffs_exist
                someI_ex[of "λahs. length ahs = length vs  f (1 δδ hs!i) = ahs ∙♯⋅ vs"]
          by    auto
        moreover from i hfvss f'_def base_spset(1) rcoset_reps ahss_def
          have  "f' (1 δδ (hs!i)) = (f_coeffs (hs!i)) ∙♯⋅ vs"
          using list_all2_len_ahss_hfvss flincomb_Horbit_induced_veclist_reduce
          by    simp
        ultimately show "f (1 δδ (hs!i)) = f' (1 δδ (hs!i))" by simp
      qed
      thus "i<length hs. f (1 δδ (hs!i)) = f' (1 δδ (hs!i))" by fast
    qed
    with f'_def hfvss base_spset(1) show "f  induced_smult.fSpan (concat hfvss)"
      using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
            induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
            VectorSpace.SpanI_lincomb_arb_len_coeffs[OF fVectorSpace_indspace]
      by    fast
  
  qed
qed

lemma indspace_basis :
  fixes   vs         :: "'v list"
  and     hs         :: "'g list"
  defines hfvss       : "hfvss  negHorbit_list hs induced_vector vs"
  assumes base_spset  : "BaseRep.fbasis_for V vs"
  and     rcoset_reps : "Supgroup.is_rcoset_replist G hs"
  shows   "fscalar_mult.basis_for induced_smult.fsmult indV (concat hfvss)"
proof-
  from assms
    have  1: "set (concat hfvss)  indV"
      and    "indV = induced_smult.fSpan (concat hfvss)"
    using Supgroup.is_rcoset_replistD_set[OF rcoset_reps]
          induced_vector_indV negHorbit_list_indV[of hs induced_vector vs]
          indspace_fspanning_set[of vs hs]
    by    auto
  moreover have "induced_smult.f_lin_independent (concat hfvss)"
  proof (
    rule VectorSpace.lin_independentI_concat_all_scalars[OF fVectorSpace_indspace],
    rule 1
  )
    fix rss
    assume rss: "list_all2 (λxs ys. length xs = length ys) rss hfvss"
                "(concat rss) ∙¤¤ (concat hfvss) = 0"
    from rss(1) have len_rss_hfvsss: "length rss = length hfvss"
      using list_all2_lengthD by fast
    with hfvss have len_rss_hs: "length rss = length hs"
      using length_negHorbit_list by fastforce
    show "rsset rss. set rs  0"
    proof
      fix rs assume "rs  set rss"
      from this obtain i where i: "i < length rss" "rs = rss!i"
        using in_set_conv_nth[of rs] by fast
      with hfvss rss(1) have "length rs = length vs"
        using list_all2_nthD len_rss_hfvsss in_set_conv_nth[of _ hfvss]
              length_negHorbit_list_sublist
        by    fastforce
      moreover from hfvss rss i base_spset(1) rcoset_reps have "rs ∙♯⋅ vs = 0"
        using len_rss_hs flincomb_Horbit_induced_veclist_reduce by force
      ultimately show "set rs  0"
        using base_spset flin_independentD_all_scalars by force
    qed
  qed
  ultimately show ?thesis by fast
qed

lemma induced_vector_decomp :
  fixes   vs         :: "'v list"
  and     hs         :: "'g list"
  and     cs         :: "'f list"
  defines hfvss       : "hfvss  negHorbit_list (0#hs) induced_vector vs"
  and     extrazeros  : "extrazeros  replicate ((length hs)*(length vs)) 0"
  assumes base_spset  : "BaseRep.fbasis_for V vs"
  and     rcoset_reps : "Supgroup.is_rcoset_replist G (0#hs)"
  and     cs          : "length cs = length vs"
  and     v           : "v = cs ∙♯⋅ vs"
  shows   "induced_vector v = (cs@extrazeros) ∙¤¤ (concat hfvss)"
proof-
  from hfvss base_spset
    have  "hfvss = (map induced_vector vs) # (negHorbit_list hs induced_vector vs)"
    using induced_vector_indV
          FGModule.negGorbit_list_Cons0[OF FHModule_indspace]
    by    fastforce
  with cs extrazeros base_spset rcoset_reps v
    show  "induced_vector v = (cs@extrazeros) ∙¤¤ (concat hfvss)"
    using scalar_mult.lincomb_append[of cs _ induced_smult.fsmult]
          Supgroup.is_rcoset_replistD_set induced_vector_indV
          negHorbit_list_indV[of hs induced_vector vs]
          VectorSpace.lincomb_replicate0_left[OF fVectorSpace_indspace]
          FGModuleHom.VectorSpaceHom[OF hom_induced_vector]
          VectorSpaceHom.distrib_lincomb
    by    fastforce
qed

end (* context InducedFinGroupRepresentation *)

subsubsection ‹The induced space is a representation space›

context InducedFinGroupRepresentation
begin

lemma indspace_findim :
  "fscalar_mult.findim induced_smult.fsmult indV"
proof-
  from BaseRep.findim obtain vs where vs: "set vs  V" "V = BaseRep.fSpan vs"
    by fast
  obtain hs where hs: "Supgroup.is_rcoset_replist G hs"
    using ex_rcoset_replist by fast
  define hfvss where "hfvss = negHorbit_list hs induced_vector vs"
  with vs hs
    have  "set (concat hfvss)  indV" "indV = induced_smult.fSpan (concat hfvss)"
    using Supgroup.is_rcoset_replistD_set[OF hs] induced_vector_indV
          negHorbit_list_indV[of hs induced_vector vs] indspace_fspanning_set
    by    auto
  thus ?thesis by fast
qed

theorem FinGroupRepresentation_indspace :
  "FinGroupRepresentation H rrsmult indV"
  using FHModule_indspace
proof (rule FinGroupRepresentation.intro)
  from good_ordSupgrp show "FinGroupRepresentation_axioms H (¤) indV" 
    using indspace_findim by unfold_locales fast
qed

end (* context InducedFinGroupRepresentation *)


subsection ‹Frobenius reciprocity›

subsubsection ‹Locale and basic facts›

text ‹There are a number of defined objects and lemmas concerning those objects leading up to the
        theorem of Frobenius reciprocity, so we create a locale to contain it all.›

locale FrobeniusReciprocity
= GRep?: InducedFinGroupRepresentation H G smult V rrsmult
+ HRep?: FinGroupRepresentation H smult' W
  for H       :: "'g::group_add set"
  and G       :: "'g set"
  and smult   :: "('f::field, 'g) aezfun  'v::ab_group_add  'v" (infixl "" 70)
  and V       :: "'v set"
  and rrsmult :: "('f,'g) aezfun  (('f,'g) aezfun  'v)
                         (('f,'g) aezfun  'v)" (infixl "¤" 70)
  and smult'  :: "('f, 'g) aezfun  'w::ab_group_add  'w" (infixr "" 70)
  and W       :: "'w set"
begin

abbreviation fsmult'   :: "'f  'w  'w"           (infixr "♯⋆" 70)
  where "fsmult'  HRep.fsmult"
abbreviation flincomb' :: "'f list  'w list  'w" (infixr "∙♯⋆" 70) 
  where "flincomb'  HRep.flincomb"
abbreviation Hmult'    :: "'g  'w  'w"           (infixr "*⋆" 70)
  where "Hmult'  HRep.Gmult"

definition Tsmult1 :: 
  "'f  ((('f, 'g) aezfun  'v)'w)  ((('f, 'g) aezfun  'v)'w)" (infixr "⋆¤" 70)
  where "Tsmult1  λa T. λf. a ♯⋆ (T f)"

definition Tsmult2 :: "'f  ('v'w)  ('v'w)" (infixr "⋆⋅" 70) 
  where "Tsmult2  λa T. λv. a ♯⋆ (T v)"

lemma FHModuleW : "FGModule H (⋆) W" ..

lemma FGModuleW: "FGModule G smult' W"
 using FHModuleW Subgroup HRep.restriction_to_subgroup_is_module
 by    fast

text ‹
  In order to build an inverse for the required isomorphism of Hom-sets, we will need a basis for
  the induced @{term H}-space.
›

definition Vfbasis :: "'v list" where "Vfbasis  (SOME vs. is_Vfbasis vs)"

lemma Vfbasis : "is_Vfbasis Vfbasis"
  using Vfbasis_def FinDimVectorSpace.basis_ex[OF GRep.FinDimVectorSpace] someI_ex
  by    simp

lemma Vfbasis_V : "set Vfbasis  V"
  using Vfbasis by fast

definition nonzero_H_rcoset_reps :: "'g list"
  where "nonzero_H_rcoset_reps  (SOME hs. Group.is_rcoset_replist H G (0#hs))"

definition H_rcoset_reps :: "'g list" where "H_rcoset_reps  0 # nonzero_H_rcoset_reps"

lemma H_rcoset_reps : "Group.is_rcoset_replist H G H_rcoset_reps"
  using H_rcoset_reps_def nonzero_H_rcoset_reps_def GRep.ex_rcoset_replist_hd0 someI_ex
  by    simp

lemma H_rcoset_reps_H : "set H_rcoset_reps  H"
  using H_rcoset_reps Group.is_rcoset_replistD_set[OF HRep.GroupG] by fast

lemma nonzero_H_rcoset_reps_H : "set nonzero_H_rcoset_reps  H"
  using H_rcoset_reps_H H_rcoset_reps_def by simp

abbreviation negHorbit_homVfbasis :: "('v  'w)  'w list list"
  where "negHorbit_homVfbasis T  HRep.negGorbit_list H_rcoset_reps T Vfbasis"

lemma negHorbit_Hom_indVfbasis_W :
  "T ` V  W  set (concat (negHorbit_homVfbasis T))  W"
  using H_rcoset_reps_H Vfbasis_V
        HRep.negGorbit_list_V[of H_rcoset_reps T Vfbasis]
  by    fast

lemma negHorbit_HomSet_indVfbasis_W :  
  "T  GRepHomSet smult' W  set (concat (negHorbit_homVfbasis T))  W"
  using FGModuleHomSetD_Im negHorbit_Hom_indVfbasis_W by fast

definition indVfbasis :: "(('f, 'g) aezfun  'v) list list"
  where "indVfbasis  GRep.negHorbit_list H_rcoset_reps induced_vector Vfbasis"

lemma indVfbasis :
  "fscalar_mult.basis_for induced_smult.fsmult indV (concat indVfbasis)"
  using Vfbasis H_rcoset_reps indVfbasis_def indspace_basis[of Vfbasis H_rcoset_reps]
  by    auto

lemma indVfbasis_indV : "hfvs  set indVfbasis  set hfvs  indV"
  using indVfbasis by auto

end (* context FrobeniusReciprocity *)

subsubsection ‹The required isomorphism of Hom-sets›

context FrobeniusReciprocity
begin

text ‹The following function will demonstrate the required isomorphism of Hom-sets (as vector
        spaces).›

definition φ :: "((('f, 'g) aezfun  'v)  'w)  ('v  'w)"
  where "φ  restrict0 (λT. T  GRep.induced_vector) (HRepHomSet smult' W)"

lemma φ_im : "φ ` HRepHomSet (⋆) W  GRepHomSet (⋆) W"
proof (rule image_subsetI)

  fix T assume T: "T  HRepHomSet (⋆) W"
  show "φ T  GRepHomSet (⋆) W"
  proof (rule FGModuleHomSetI)

    from T have "FGModuleHom G rrsmult indV smult' T"
      using FGModuleHomSetD_FGModuleHom GRep.Subgroup
            FGModuleHom.restriction_to_subgroup_is_hom
      by    fast
    thus "BaseRep.GRepHom (⋆) (φ T)"
      using T φ_def GRep.hom_induced_vector GRep.induced_vector_indV
            FGModuleHom.FGModHom_composite_left
      by    fastforce

      show "φ T ` V  W"
        using T φ_def GRep.induced_vector_indV FGModuleHomSetD_Im by fastforce

  qed

qed

end (* context FrobeniusReciprocity *)

subsubsection ‹The inverse map of Hom-sets›

text ‹In this section we build an inverse for the required isomorphism, @{term "φ"}.›

context FrobeniusReciprocity
begin

definition ψ_condition :: "('v  'w)  ((('f, 'g) aezfun  'v)  'w)  bool"
  where "ψ_condition T S
               VectorSpaceHom induced_smult.fsmult indV fsmult' S 
                 map (map S) indVfbasis = negHorbit_homVfbasis T"

lemma inverse_im_exists' :
  assumes "T  GRepHomSet (⋆) W"
  shows   "∃! S. VectorSpaceHom induced_smult.fsmult indV fsmult' S
                 map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
proof (
  rule VectorSpace.basis_im_defines_hom, rule fVectorSpace_indspace,
  rule HRep.fVectorSpace, rule indVfbasis
)
  from  assms show "set (concat (negHorbit_homVfbasis T))  W"
    using negHorbit_HomSet_indVfbasis_W by fast
  show  "length (concat (negHorbit_homVfbasis T)) = length (concat indVfbasis)"
    using length_concat_negGorbit_list indVfbasis_def
          induced_smult.length_concat_negGorbit_list[of H_rcoset_reps induced_vector]
    by    simp
qed

lemma inverse_im_exists :
  assumes "T  GRepHomSet (⋆) W"
  shows   "∃! S. ψ_condition T S"
proof-
  have " S. ψ_condition T S"
  proof-
    from assms obtain S
      where S: "VectorSpaceHom induced_smult.fsmult indV fsmult' S" 
               "map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
      using inverse_im_exists'
      by    fast
    from S(2) have "concat (map (map S) indVfbasis)
                          = concat (negHorbit_homVfbasis T)"
      using map_concat[of S] by simp
    moreover have "list_all2 (λxs ys. length xs = length ys)
                        (map (map S) indVfbasis) (negHorbit_homVfbasis T)"
    proof (rule iffD2[OF list_all2_iff], rule conjI)
      show "length (map (map S) indVfbasis) = length (negHorbit_homVfbasis T)"
        using indVfbasis_def induced_smult.length_negGorbit_list
              HRep.length_negGorbit_list[of H_rcoset_reps T]
        by    auto
      show "(xs,ys)set (zip (map (map S) indVfbasis)
                  (negHorbit_homVfbasis T)). length xs = length ys"
      proof (rule prod_ballI)
        fix xs ys
        assume xsys: "(xs,ys)  set (zip (map (map S) indVfbasis)
                            (negHorbit_homVfbasis T))"
        from this obtain zs where zs: "zs  set indVfbasis" "xs = map S zs"
          using set_zip_leftD by fastforce
        with xsys show "length xs = length ys"
          using indVfbasis_def set_zip_rightD[of xs ys]
                HRep.length_negGorbit_list_sublist[of ys H_rcoset_reps T Vfbasis]
                induced_smult.length_negGorbit_list_sublist
          by    simp
      qed
    qed
    ultimately have "map (map S) indVfbasis = negHorbit_homVfbasis T"
      using concat_eq[of "map (map S) indVfbasis"] by fast
    with S(1) show ?thesis using ψ_condition_def by fast
  qed
  moreover have "S U. ψ_condition T S  ψ_condition T U  S = U"
  proof-
    fix S U assume "ψ_condition T S" "ψ_condition T U"
    hence "VectorSpaceHom induced_smult.fsmult indV fsmult' S"
          "map S (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
          "VectorSpaceHom induced_smult.fsmult indV fsmult' U"
          "map U (concat indVfbasis) = concat (negHorbit_homVfbasis T)"
      using ψ_condition_def map_concat[of S] map_concat[of U] by auto
    with assms show "S = U" using inverse_im_exists' by fast
  qed
  ultimately show ?thesis by fast
qed

definition ψ :: "('v  'w)  ((('f, 'g) aezfun  'v)  'w)"
  where "ψ  restrict0 (λT. THE S. ψ_condition T S) (GRepHomSet (⋆) W)"

lemma ψD : "T  GRepHomSet (⋆) W  ψ_condition T (ψ T)"
  using ψ_def inverse_im_exists[of T] theI'[of "λS. ψ_condition T S"] by simp

lemma ψD_VectorSpaceHom :
  "T  GRepHomSet (⋆) W
         VectorSpaceHom induced_smult.fsmult indV fsmult' (ψ T)"
  using ψD ψ_condition_def by fast

lemma ψD_im :
  "T  GRepHomSet (⋆) W  map (map (ψ T)) indVfbasis
        = aezfun_scalar_mult.negGorbit_list (⋆) H_rcoset_reps T Vfbasis"
  using ψD ψ_condition_def by fast

lemma ψD_im_single :
  assumes "T  GRepHomSet (⋆) W" "h  set H_rcoset_reps" "v  set Vfbasis"
  shows   "ψ T ((- h)  (induced_vector v)) = (-h) *⋆ (T v)"
proof-
  from assms(2,3) obtain i j
    where i: "i < length H_rcoset_reps" "h = H_rcoset_reps!i"
    and   j: "j < length Vfbasis" "v = Vfbasis!j"
    using set_conv_nth[of H_rcoset_reps] set_conv_nth[of Vfbasis] by auto
  moreover
    hence "map (map (ψ T)) indVfbasis !i !j = ψ T ((-h)  (induced_vector v))"
    using indVfbasis_def
          aezfun_scalar_mult.length_negGorbit_list[
            of rrsmult H_rcoset_reps induced_vector
          ]
          aezfun_scalar_mult.negGorbit_list_nth[
            of i H_rcoset_reps rrsmult induced_vector
          ]
    by    auto
  ultimately show ?thesis
    using assms(1) HRep.negGorbit_list_nth[of i H_rcoset_reps T] ψD_im by simp
qed

lemma ψT_W :
  assumes "T  GRepHomSet (⋆) W"
  shows   "ψ T ` indV  W"
proof (rule image_subsetI)
  from assms have T: "VectorSpaceHom induced_smult.fsmult indV fsmult' (ψ T)"
    using ψD_VectorSpaceHom by fast
  fix f assume "f  indV"
  from this obtain cs 
    where cs:"length cs = length (concat indVfbasis)" "f = cs ∙¤¤ (concat indVfbasis)"
    using indVfbasis scalar_mult.in_Span_obtain_same_length_coeffs
    by    fast
  from cs(1) obtain css
    where css: "cs = concat css" "list_all2 (λxs ys. length xs = length ys) css indVfbasis"
    using match_concat
    by    fast
  from assms cs(2) css
    have "ψ T f = ψ T ((cs,hfvs)zip css indVfbasis. cs ∙¤¤ hfvs)"
    using VectorSpace.lincomb_concat[OF fVectorSpace_indspace] by simp
  also have " = ((cs,hfvs)zip css indVfbasis. ψ T  (cs ∙¤¤ hfvs))"
    using set_zip_rightD[of _ _ css indVfbasis] indVfbasis_indV
          VectorSpace.lincomb_closed[OF GRep.fVectorSpace_indspace]
          VectorSpaceHom.im_sum_list_prod[OF T]
    by    force
  finally have "ψ T f = ((cs,ψThfvs)zip css (map (map (ψ T)) indVfbasis).
                      cs ∙♯⋆ ψThfvs)"
    using set_zip_rightD[of _ _ css indVfbasis] indVfbasis_indV
          VectorSpaceHom.distrib_lincomb[OF T] 
          sum_list_prod_cong[of
            "zip css indVfbasis" "λcs hfvs. ψ T (cs ∙¤¤ hfvs)" 
            "λcs hfvs. cs ∙♯⋆ (map (ψ T) hfvs)"
          ]
          sum_list_prod_map2[of "λcs ψThfvs. cs ∙♯⋆ ψThfvs" css "map (ψ T)"]
    by    fastforce
  moreover from css(2)
    have "list_all2 (λxs ys. length xs = length ys) css (map (map (ψ T)) indVfbasis)"
    using list_all2_iff[of _ css indVfbasis] set_zip_map2
          list_all2_iff[of _ css "map (map (ψ T)) indVfbasis"]
    by    force
  ultimately have "ψ T f = (concat css) ∙♯⋆ (concat (negHorbit_homVfbasis T))"
    using HRep.flincomb_concat map_concat[of "ψ T"] ψD_im[OF assms]
    by    simp
  thus "ψ T f  W"
    using assms negHorbit_HomSet_indVfbasis_W HRep.flincomb_closed by simp
qed

lemma ψT_Hmap_on_indVfbasis :
  assumes "T  GRepHomSet (⋆) W"
  shows   "x f. x  H  f  set (concat indVfbasis)
                 ψ T (x  f) = x *⋆ (ψ T f)"
proof-
  fix x f assume x: "x  H" and f: "f  set (concat indVfbasis)"
  from f obtain i where i: "i < length indVfbasis" "f  set (indVfbasis!i)"
    using set_concat set_conv_nth[of indVfbasis] by auto
  from i(1) have i': "i < length H_rcoset_reps"
    using indVfbasis_def
          aezfun_scalar_mult.length_negGorbit_list[
            of rrsmult H_rcoset_reps induced_vector
          ]
    by    simp
  define hi where "hi = H_rcoset_reps!i"
  with i' have hi_H: "hi  H" using set_conv_nth H_rcoset_reps_H by fast
  from hi_def i(2) have "f  set (map (Hmult (-hi)  induced_vector) Vfbasis)"
    using indVfbasis_def i'
          aezfun_scalar_mult.negGorbit_list_nth[
            of i H_rcoset_reps rrsmult induced_vector
          ]
    by    simp
  from this obtain v where v: "v  set Vfbasis" "f = (-hi)  (induced_vector v)"
    by auto
  from v(1) have v_V: "v  V" and Tv_W: "T v  W"
    using Vfbasis_V FGModuleHomSetD_Im[OF assms] by auto
  from x have "hi - x  H" using hi_H Supgroup.diff_closed by fast
  from this obtain j
    where j: "j < length H_rcoset_reps" "hi - x  G + {H_rcoset_reps!j}"
    using set_conv_nth[of H_rcoset_reps] H_rcoset_reps
          Group.group_eq_subgrp_rcoset_un[OF HRep.GroupG Subgroup H_rcoset_reps]
    by    force
  from j(1) have j': "j < length indVfbasis"
    using indVfbasis_def
          aezfun_scalar_mult.length_negGorbit_list[
            of rrsmult H_rcoset_reps induced_vector
          ]
    by    simp
  define hj where "hj = H_rcoset_reps!j"
  with j(1) have hj_H: "hj  H" using set_conv_nth H_rcoset_reps_H by fast
  from hj_def j(2) obtain g where g: "g  G" "hi - x = g + hj"
    unfolding set_plus_def by fast
  from g(2) have x_hi: "x - hi = - hj + - g"
    using minus_diff_eq[of hi x] minus_add[of g] by simp
  from g(1) have "-g *⋅ v  V"
    using v_V ActingGroup.neg_closed BaseRep.Gmult_closed by fast
  from this obtain cs
    where cs: "length cs = length Vfbasis" "-g *⋅ v = cs ∙♯⋅ Vfbasis"
    using Vfbasis
          VectorSpace.in_Span_obtain_same_length_coeffs[OF GRep.fVectorSpace]
    by    fast

  from v(2) x have "ψ T (x  f) = ψ T ((x-hi)  (induced_vector v))"
    using hi_H Supgroup.neg_closed v_V induced_vector_indV
          FGModule.Gmult_assoc[OF GRep.FHModule_indspace]
    by    (simp add: algebra_simps)
  also from g(1) have " = ψ T ((-hj)  (induced_vector (-g *⋅ v)))"
    using x_hi hj_H Subgroup Supgroup.neg_closed v_V induced_vector_indV
          FGModule.Gmult_assoc[OF GRep.FHModule_indspace]
          ActingGroup.neg_closed
          FGModuleHom.G_map[OF hom_induced_vector]
    by    auto
  also from cs(2) hj_def j(1) have " = ψ T (cs ∙¤¤ (indVfbasis!j))"
    using hj_H Vfbasis_V FGModuleHom.distrib_flincomb[OF hom_induced_vector]
          indVfbasis_def Supgroup.neg_closed[of hj] induced_vector_indV
          FGModule.Gmult_flincomb_comm[
            OF GRep.FHModule_indspace,
            of "-hj" "map induced_vector Vfbasis"
          ]
          aezfun_scalar_mult.negGorbit_list_nth[
            of j H_rcoset_reps rrsmult induced_vector
          ]
    by    fastforce
  also have " = cs ∙♯⋆ ((map (map (ψ T)) indVfbasis)!j)"
    using ψD_VectorSpaceHom[OF assms] indVfbasis_indV j' set_conv_nth
          VectorSpaceHom.distrib_lincomb[of induced_smult.fsmult indV fsmult']
    by    simp
  also from j(1) hj_def have " = (- hj) *⋆ cs ∙♯⋆ (map T Vfbasis)"
    using ψD_im[OF assms]
          aezfun_scalar_mult.negGorbit_list_nth[of j H_rcoset_reps smult' T] hj_H
          Group.neg_closed[OF HRep.GroupG]
          Vfbasis_V FGModuleHomSetD_Im[OF assms]
          HRep.Gmult_flincomb_comm[of "- hj" "map T Vfbasis"]
    by    fastforce
  also from cs(2) g(1) have " = (- hj) *⋆ (-g) *⋆ (T v)"
    using v_V FGModuleHomSetD_FGModuleHom[OF assms] Vfbasis_V
          FGModuleHom.distrib_flincomb[of G smult V smult']
          ActingGroup.neg_closed
          FGModuleHom.G_map[of G smult V smult' T "-g" v]
    by    auto
  also from g(1) v(1) have " = (x - hi) *⋆ (T v)"
    using FGModuleHomSetD_FGModuleHom[OF assms] Vfbasis_V Supgroup.neg_closed
          hj_H Subgroup FGModuleHomSetD_Im[OF assms]
          HRep.Gmult_assoc[of "-hj" "-g" "T v"] x_hi
    by    auto
  also from x(1) have " = x *⋆ (- hi) *⋆ (T v)"
    using hi_H Supgroup.neg_closed Tv_W HRep.Gmult_assoc
    by    (simp add: algebra_simps)
  finally show "ψ T (x  f) = x *⋆ (ψ T f)"
    using assms(1) v hi_def i' set_conv_nth[of H_rcoset_reps] ψD_im_single by fastforce
qed

lemma ψT_hom :
  assumes "T  GRepHomSet (⋆) W"
  shows   "HRepHom (⋆) (ψ T)"
  using indVfbasis ψD_VectorSpaceHom[OF assms] FHModuleW
proof (
  rule FGModule.VecHom_GMap_on_fbasis_is_FGModuleHom[
    OF GRep.FHModule_indspace
  ]
)
  show "ψ T ` indV  W" using indVfbasis ψT_W[OF assms] by fast
  show "g v. g  H  v  set (concat indVfbasis)
               ψ T (g  v) = g *⋆ ψ T v"
    using ψT_Hmap_on_indVfbasis[OF assms] by fast
qed

lemma ψ_im : "ψ ` GRepHomSet (⋆) W  HRepHomSet (⋆) W"
  using ψT_W ψT_hom FGModuleHomSetI by fastforce

end (* context FrobeniusReciprocity *)

subsubsection ‹Demonstration of bijectivity›

text ‹Now we demonstrate that @{term "φ"} is bijective via the inverse @{term "ψ"}.›

context FrobeniusReciprocity
begin

lemma φψ :
  assumes "T  GRepHomSet smult' W"
  shows   "(φ  ψ) T = T"
proof
  fix v show "(φ  ψ) T v = T v"
  proof (cases "v  V")
    case True
    from this obtain cs where cs: "length cs = length Vfbasis" "v = cs ∙♯⋅ Vfbasis"
      using Vfbasis
            VectorSpace.in_Span_obtain_same_length_coeffs[OF GRep.fVectorSpace]
      by    fast
    define extrazeros
      where "extrazeros = replicate ((length nonzero_H_rcoset_reps)*(length Vfbasis)) (0::'f)"
    with cs have "GRep.induced_vector v = (cs@extrazeros) ∙¤¤ (concat indVfbasis)"
      using     H_rcoset_reps induced_vector_decomp[OF Vfbasis]
      unfolding H_rcoset_reps_def indVfbasis_def
      by        auto
    with assms
      have  "(φ  ψ) T v = (cs@extrazeros) ∙♯⋆ (map (ψ T) (concat indVfbasis))"
      using ψ_im φ_def indVfbasis
            VectorSpaceHom.distrib_lincomb[OF ψD_VectorSpaceHom]
      by    auto
    also have " = (cs@extrazeros) ∙♯⋆ (map T Vfbasis
                    @ concat (HRep.negGorbit_list nonzero_H_rcoset_reps T Vfbasis))"
      using map_concat[of "ψ T"] ψD_im[OF assms] H_rcoset_reps_def
            FGModuleHomSetD_Im[OF assms] Vfbasis_V HRep.negGorbit_list_Cons0
      by    fastforce
    also from cs(1)
      have  " = cs ∙♯⋆ (map T Vfbasis) + extrazeros
                  ∙♯⋆ (concat (HRep.negGorbit_list nonzero_H_rcoset_reps T Vfbasis))"
      using scalar_mult.lincomb_append[of cs _ fsmult']
      by    simp
    also have " = cs ∙♯⋆ (map T Vfbasis)"
      using nonzero_H_rcoset_reps_H Vfbasis FGModuleHomSetD_Im[OF assms]
            HRep.negGorbit_list_V
            VectorSpace.lincomb_replicate0_left[OF HRep.fVectorSpace]
      unfolding extrazeros_def
      by    force
    also from cs(2) have " = T v"
      using FGModuleHomSetD_FGModuleHom[OF assms]
            FGModuleHom.VectorSpaceHom Vfbasis
            VectorSpaceHom.distrib_lincomb[of "aezfun_scalar_mult.fsmult smult"]
      by    fastforce
    finally show ?thesis by fast
  next
    case False
    with assms show ?thesis
      using ψ_im φ_def GRep.induced_vector_def ψD_VectorSpaceHom
            VectorSpaceHom.im_zero
            FGModuleHomSetD_FGModuleHom[of T G smult V]
            FGModuleHom.supp suppI_contra
      by    fastforce
  qed
qed

lemma φ_inverse_im : "φ ` HRepHomSet (⋆) W  GRepHomSet (⋆) W"
  using φψ ψ_im by force

lemma bij_φ : "bij_betw φ (HRepHomSet (⋆) W) (GRepHomSet (⋆) W)"
  unfolding bij_betw_def
proof

  have " S T.  S  HRepHomSet (⋆) W; T  HRepHomSet (⋆) W;
            φ S = φ T   S = T"
  proof (rule VectorSpaceHom.same_image_on_spanset_imp_same_hom)
    fix S T
    assume ST: "S  HRepHomSet (⋆) W" "T  HRepHomSet (⋆) W" "φ S = φ T"
    from ST(1,2) have ST': "HRepHom smult' S" "HRepHom smult' T"
      using FGModuleHomSetD_FGModuleHom[of _ H rrsmult] by auto

    from ST'
      show  "VectorSpaceHom induced_smult.fsmult indV fsmult' S"
            "VectorSpaceHom induced_smult.fsmult indV fsmult' T"
      using FGModuleHom.VectorSpaceHom[of H rrsmult indV smult']
      by    auto

    show "indV = induced_smult.fSpan (concat indVfbasis)"
         "set (concat indVfbasis)  indV"
      using indVfbasis by auto

    show "fset (concat indVfbasis). S f = T f"
    proof
      fix f assume "f  set (concat indVfbasis)"
      from this obtain hfvs where hfvs: "hfvs  set indVfbasis" "f  set hfvs"
        using set_concat by fast
      from hfvs(1) obtain h
        where h: "h  set H_rcoset_reps"
                 "hfvs = map (Hmult (-h)  induced_vector) Vfbasis"
        using indVfbasis_def
              induced_smult.negGorbit_list_def[of H_rcoset_reps induced_vector]
        by    auto
      from hfvs(2) h(2) obtain v
        where v: "v  set Vfbasis" "f = (-h)  (induced_vector v)"
        by    auto
      from v h(1) ST(1) have "S f = (-h) *⋆ (φ S v)"
        using ST'(1) H_rcoset_reps_H Group.neg_closed[OF HRep.GroupG]
              GRep.induced_vector_indV Vfbasis_V φ_def FGModuleHom.G_map
        by    fastforce
      moreover from v h(1) ST(2) have "T f = (-h) *⋆ (φ T v)"
        using ST'(2) H_rcoset_reps_H Group.neg_closed[OF HRep.GroupG] GRep.induced_vector_indV
              Vfbasis_V φ_def FGModuleHom.G_map
        by    fastforce
      ultimately show "S f = T f" using ST(3) by simp

    qed
  qed
  thus "inj_on φ (HRepHomSet (⋆) W)" unfolding inj_on_def by fast

  show "φ ` HRepHomSet (⋆) W = GRepHomSet (⋆) W"
    using φ_im φ_inverse_im by fast

qed

end (* context FrobeniusReciprocity *)

subsubsection ‹The theorem›

text ‹
  Finally we demonstrate that @{term "φ"} is an isomorphism of vector spaces between the two
  hom-sets, leading to Frobenius reciprocity.
›

context FrobeniusReciprocity
begin

lemma VectorSpaceIso_φ :
  "VectorSpaceIso Tsmult1 (HRepHomSet (⋆) W) Tsmult2 φ
        (GRepHomSet (⋆) W)"
proof (rule VectorSpaceIso.intro, rule VectorSpace.VectorSpaceHomI_fromaxioms)

  from Tsmult1_def show "VectorSpace Tsmult1 (HRepHomSet (⋆) W)"
    using FHModule_indspace FHModuleW
          FGModule.VectorSpace_FGModuleHomSet
    by    simp

  from φ_def show "supp φ  HRepHomSet (⋆) W"
    using suppD_contra[of φ] by fastforce

  have "bij_betw φ (HRepHomSet (⋆) W) (GRepHomSet (⋆) W)"
    using bij_φ by fast
  thus "VectorSpaceIso_axioms (HRepHomSet (⋆) W) φ (GRepHomSet (⋆) W)"
    by unfold_locales

next    
  fix S T assume "S  HRepHomSet (⋆) W" "T  HRepHomSet (⋆) W"
  thus "φ (S + T) = φ S + φ T"
    using φ_def Group.add_closed
          FGModule.Group_FGModuleHomSet[OF FHModule_indspace FHModuleW]
    by    auto

next
  fix a T assume T: "T  HRepHomSet (⋆) W"
  moreover with Tsmult1_def have aT: "a ⋆¤ T  HRepHomSet (⋆) W"
    using FGModule.VectorSpace_FGModuleHomSet[
            OF FHModule_indspace FHModuleW
          ]
          VectorSpace.smult_closed
    by    simp
  ultimately show "φ (a ⋆¤ T) = a ⋆⋅ (φ T)"
    using φ_def Tsmult1_def Tsmult2_def by auto

qed

theorem FrobeniusReciprocity :
  "VectorSpace.isomorphic Tsmult1 (HRepHomSet smult' W) Tsmult2
        (GRepHomSet smult' W)"
  using VectorSpaceIso_φ by fast

end (* context FrobeniusReciprocity *)


end (* theory *)